reformat

.ocamlformat

@@ -1,2 +1,2 @@
 profile = default
-
+if-then-else = vertical

lib/backend/emit_c.ml

@@ -5,10 +5,14 @@ open KhasmUTF
 
 let mangler id =
   let asint = String.get_uint8 id 0 in
-  if asint >= 65 && asint < 65 + 26 then id
-  else if asint >= 97 && asint < 97 + 26 then id
-  else if asint >= 48 && asint < 48 + 10 then id
-  else "_" ^ string_of_int asint ^ "_"
+  if asint >= 65 && asint < 65 + 26 then
+    id
+  else if asint >= 97 && asint < 97 + 26 then
+    id
+  else if asint >= 48 && asint < 48 + 10 then
+    id
+  else
+    "_" ^ string_of_int asint ^ "_"
 
 let mangle_top nms id =
   let nm = List.assoc id nms in
@@ -30,7 +34,12 @@ let function_name name argnum =
       (List.mapi (fun i x -> x ^ "_" ^ string_of_int i)
       @@ n_of_i argnum "kha_obj * a")
   in
-  let args = if args = "" then "void" else args in
+  let args =
+    if args = "" then
+      "void"
+    else
+      args
+  in
   "extern kha_obj * " ^ name ^ "(" ^ args ^ ");\n" ^ "KHASM_ENTRY(" ^ name
   ^ ", " ^ string_of_int argnum ^ ", " ^ args ^ ") {\n"
 
@@ -63,7 +72,8 @@ and gen_new s =
   n'
 
 let rec emit_tuple tbl x =
-  if List.length x = 0 then gen_new "make_tuple(0)"
+  if List.length x = 0 then
+    gen_new "make_tuple(0)"
   else
     let codes = List.map (fun x -> codegen_func x tbl) x in
     gen_new
@@ -89,8 +99,10 @@ and add_to_emi s = emission := s :: !emission
 and codegen_func code tbl =
   match code with
   | Val v ->
-      if is_toplevel v tbl then gen_new (emit_ptr tbl v)
-      else gen_new (emit_ref (mangle v))
+      if is_toplevel v tbl then
+        gen_new (emit_ptr tbl v)
+      else
+        gen_new (emit_ref (mangle v))
   | Unboxed v -> gen_new (emit_unboxed v)
   | Tuple t -> emit_tuple tbl t
   | Call (e1, e2) -> emit_call tbl e1 e2
@@ -105,12 +117,16 @@ and codegen_func code tbl =
       let n1 = codegen_func c tbl in
       add_to_emi ("if (" ^ n1 ^ "->data.i) {\n");
       let t1 = codegen_func e1 tbl in
-      if t1 = "IFELSETEMP" then ()
-      else add_to_emi (";\n IFELSETEMP = ref(" ^ t1 ^ ");");
+      if t1 = "IFELSETEMP" then
+        ()
+      else
+        add_to_emi (";\n IFELSETEMP = ref(" ^ t1 ^ ");");
       add_to_emi "} else {";
       let t2 = codegen_func e2 tbl in
-      if t2 = "IFELSETEMP" then ()
-      else add_to_emi (";\n IFELSETEMP = ref(" ^ t2 ^ ");");
+      if t2 = "IFELSETEMP" then
+        ()
+      else
+        add_to_emi (";\n IFELSETEMP = ref(" ^ t2 ^ ");");
       add_to_emi "}\n";
       "IFELSETEMP"
 

lib/backend/native.ml

@@ -30,7 +30,11 @@ let prelude () =
 
 let flags =
   KhasmUTF.utf8_map
-    (fun x -> if x = "\n" then "" else x)
+    (fun x ->
+      if x = "\n" then
+        ""
+      else
+        x)
     {| -O0
         -Wall
         -Wextra

lib/frontend/ast.ml

@@ -86,26 +86,46 @@ and program = Program of toplevel list [@@deriving show { with_path = false }]
 (* The following two are basically just α-renaming *)
 let base_subs i b x y =
   match b with
-  | Ident (i', b') -> if b' = x then Base (i, Ident (i', y)) else Base (i, b)
+  | Ident (i', b') ->
+      if b' = x then
+        Base (i, Ident (i', y))
+      else
+        Base (i, b)
   | _ -> Base (i, b)
 
 let rec esubs expr x y =
   match expr with
   | Base (i, b) -> base_subs i b x y
   | FCall (i, f, x') -> FCall (i, esubs f x y, esubs x' x y)
   | LetIn (i, id, e1, e2) ->
-      if id <> x then LetIn (i, id, esubs e1 x y, esubs e2 x y) else expr
+      if id <> x then
+        LetIn (i, id, esubs e1 x y, esubs e2 x y)
+      else
+        expr
   | AnnotLet (i, id, ts, e1, e2) ->
-      if id <> x then AnnotLet (i, id, ts, esubs e1 x y, esubs e2 x y) else expr
+      if id <> x then
+        AnnotLet (i, id, ts, esubs e1 x y, esubs e2 x y)
+      else
+        expr
   | LetRecIn (i, ts, id, e1, e2) ->
-      if id <> x then LetRecIn (i, ts, id, esubs e1 x y, esubs e2 x y) else expr
+      if id <> x then
+        LetRecIn (i, ts, id, esubs e1 x y, esubs e2 x y)
+      else
+        expr
   | IfElse (i, c, e1, e2) -> IfElse (i, esubs c x y, esubs e1 x y, esubs e2 x y)
   | Join (info, e1, e2) -> Join (info, esubs e1 x y, esubs e2 x y)
-  | Lam (i, x', e) -> if x' <> x then Lam (i, x', esubs e x y) else expr
+  | Lam (i, x', e) ->
+      if x' <> x then
+        Lam (i, x', esubs e x y)
+      else
+        expr
   | TypeLam (i, t, e) -> TypeLam (i, t, esubs e x y)
   | TupAccess (i, e, i') -> TupAccess (i, esubs e x y, i')
   | AnnotLam (i, x', ts, e) ->
-      if x' <> x then AnnotLam (i, x', ts, esubs e x y) else expr
+      if x' <> x then
+        AnnotLam (i, x', ts, esubs e x y)
+      else
+        expr
   | ModAccess _ -> expr
   | Inst _ -> expr
 

lib/frontend/debug.ml

@@ -1,6 +1,11 @@
 let debug_s = ref ""
 let debug str = debug_s := !debug_s ^ "\n" ^ str
-let log_debug_stdout b = if b then print_endline !debug_s else ()
+
+let log_debug_stdout b =
+  if b then
+    print_endline !debug_s
+  else
+    ()
 
 let log_debug_destruct () =
   print_endline !debug_s;

lib/frontend/elim_modules.ml

@@ -22,8 +22,10 @@ type module_ctx = {
 [@@deriving show { with_path = false }]
 
 let rec open_if_valid id orig ctx =
-  if ctx.name = id then { ctx with is_open = true }
-  else open_deep_module_h ctx id orig
+  if ctx.name = id then
+    { ctx with is_open = true }
+  else
+    open_deep_module_h ctx id orig
 
 and open_deep_module_h ctx id orig =
   {
@@ -89,7 +91,8 @@ let rec get_parent_list ctx =
   | Some x -> get_parent_list !x ^ "." ^ ctx.name
 
 let rec get_mang ctx id =
-  if id = "main" then "main"
+  if id = "main" then
+    "main"
   else
     match List.assoc_opt id ctx.idents with
     | Some true -> id
@@ -148,8 +151,10 @@ let elim_ts ctx ts = ts
 let rec elim_base mctx lctx i k : kexpr =
   match k with
   | Ident (i', k) ->
-      if is_local lctx k then Base (i, Ident (i', k))
-      else Base (i, Ident (i', get_full_id_mod mctx [] k))
+      if is_local lctx k then
+        Base (i, Ident (i', k))
+      else
+        Base (i, Ident (i', get_full_id_mod mctx [] k))
   | Int _ | Float _ | Str _ -> Base (i, k)
   | Tuple l -> Base (i, Tuple (List.map (elim_expr mctx lctx) l))
   | True | False -> Base (i, k)
@@ -205,7 +210,8 @@ let rec elim_toplevel ctx t =
       let id' = get_mang ctx id_e in
       (add_ident ctx id_e, IntExtern (id_i, id', i, ts) :: [])
   | Bind (id, ids, nm) ->
-      if ids <> [] then todo "bind with module args"
+      if ids <> [] then
+        todo "bind with module args"
       else
         let id' = get_mang ctx id in
         let nm' = get_mang ctx nm in

lib/frontend/parser.ml

@@ -185,7 +185,10 @@ module ParserState = struct
 
   let expect state tok =
     let t = pop state in
-    if t = tok then () else error state t [ tok ]
+    if t = tok then
+      ()
+    else
+      error state t [ tok ]
 end
 
 open ParserState
@@ -343,10 +346,17 @@ and infix_bind_pow tok =
   let first = String.get tok 0 in
   let mab =
     if first = '*' then
-      try if String.get tok 1 = '*' then (16, 17) else (0, 0) with _ -> (0, 0)
-    else (0, 0)
+      try
+        if String.get tok 1 = '*' then
+          (16, 17)
+        else
+          (0, 0)
+      with _ -> (0, 0)
+    else
+      (0, 0)
   in
-  if mab <> (0, 0) then mab
+  if mab <> (0, 0) then
+    mab
   else
     match first with
     | ';' -> (1, 0)
@@ -506,7 +516,8 @@ and parse_expr_h state res prec =
         toss state;
         let next_prec = pr in
         parse_expr_h state (Join (mkinfo (), res, parse_expr state next_prec)) 0)
-      else res
+      else
+        res
   | Some s ->
       let pl, pr = infix_bind_pow s in
       if pl >= prec then (
@@ -518,7 +529,8 @@ and parse_expr_h state res prec =
                FCall (mkinfo (), Base (mkinfo (), Ident (mkinfo (), s)), res),
                parse_expr state next_prec ))
           0)
-      else res
+      else
+        res
 
 and parse_expr state prec =
   let lhs = parse_compound state in
@@ -644,4 +656,5 @@ and program token lexbuf file =
   if tmp = [] then (
     print_endline "EMPTY FILE";
     raise ParseError)
-  else Program tmp
+  else
+    Program tmp