switch formatter to ocp-indent

.ocp-indent

@@ -0,0 +1,12 @@
+base = 2
+type = 2
+in = 0
+with = 0
+match_clause = 2
+ppx_stritem_ext = 2
+max_indent = 4
+strict_with = never
+strict_else = always
+strict_comments = false
+align_ops = true
+align_params = always

format.sh

@@ -0,0 +1,3 @@
+#!/usr/bin/env sh
+
+git ls-tree HEAD -r --name-only | grep 'ml$' | xargs ocp-indent -i

lib/compile/bcc.ml

@@ -57,17 +57,11 @@ let compile modl =
        | Ast.Mul     -> emit (MUL (sp, rhs))
        | Ast.Div | Ast.Mod -> failwith "Bcc.compile_exp: TODO: div/mod"
        | Ast.Eql     -> emit (EQL (sp, rhs))
-        | Ast.Not_eql ->
+       | Ast.Not_eql -> emit (EQL (sp, rhs)); emit (NOT sp)
-            emit (EQL (sp, rhs));
-            emit (NOT sp)
        | Ast.Lst     -> emit (LST (sp, rhs))
-        | Ast.Lst_eql ->
+       | Ast.Lst_eql -> emit (LST (sp, rhs)); emit (NOT sp)
-            emit (LST (sp, rhs));
-            emit (NOT sp)
        | Ast.Grt     -> emit (GRT (sp, rhs))
-        | Ast.Grt_eql ->
+       | Ast.Grt_eql -> emit (LST (sp, rhs)); emit (NOT sp));
-            emit (LST (sp, rhs));
-            emit (NOT sp));
       Reg sp
     | Ast.If (cnd, e1, e2) ->
       let l1 = Code.make_basic_block [] in
@@ -85,6 +79,7 @@ let compile modl =
     | Ast.Obj body -> compile_obj env sp body
     | Ast.Scope body -> compile_scope env sp body
     | _ -> failwith "Bcc.compile_exp: TODO"
+
   and compile_block env sp items =
     let self = sp in
     let sp = sp + 1 in
@@ -94,7 +89,8 @@ let compile modl =
     let env, n_slots =
       List.fold_left
         (fun (env, n) -> function
-          | Ast.Item_fun (_, _, _) | Ast.Item_exp _ -> env, n
+           | Ast.Item_fun (_, _, _) | Ast.Item_exp _ ->
+             env, n
            | Ast.Item_obj (name, _) | Ast.Item_val (name, _) ->
              let elem = Value.Field n in
              let env = Env.add name { self; elem } env in
@@ -107,9 +103,8 @@ let compile modl =
     (* compile methods *)
     let mthds = [||] in
 
-    let vtable = Value.{ n_slots; elems; mthds } in
-
     (* emit constructor, compile val fields, and get result of final expression *)
+    let vtable = Value.{ n_slots; elems; mthds } in
     emit (CON (self, vtable));
     let emit_set name rhs =
       let { elem; _ } = Env.find name env in
@@ -122,7 +117,8 @@ let compile modl =
       List.fold_left
         (fun _ -> function
            | Ast.Item_fun (_, _, _) -> failwith "Bcc: unsupported: methods"
-          | Ast.Item_exp exp -> Some (compile_exp env sp exp)
+           | Ast.Item_exp exp ->
+             Some (compile_exp env sp exp)
            | Ast.Item_obj (name, body) ->
              emit_set name (compile_obj env (sp + 1) body);
              None
@@ -133,6 +129,7 @@ let compile modl =
         items
     in
     self, final_exp
+
   and compile_obj env sp items =
     let self, _ = compile_block env sp items in
     Code.Reg self

lib/runtime/code.ml

@@ -39,11 +39,15 @@ and ins =
   | CBR of operand * basic_block * basic_block
   | RET
 
-let make_basic_block ins_list = { ins_builder = List.rev ins_list; ins_list }
+let make_basic_block ins_list = {
+  ins_builder = List.rev ins_list;
+  ins_list
+}
 
 let instructions bb =
   (* memoize computing "rev ins_builder" by storing result in ins_list *)
-  if bb.ins_list = [] then bb.ins_list <- List.rev bb.ins_builder;
+  if bb.ins_list = [] then
+    bb.ins_list <- List.rev bb.ins_builder;
   bb.ins_list
 
 let add_ins bb is =
@@ -55,7 +59,8 @@ let add_ins bb is =
 type program = { entrypoint : basic_block }
 type Value.mthd += Method of program
 
-let make_program entrypoint = { entrypoint }
+let make_program entrypoint =
+  { entrypoint }
 
 let frame_size prog =
   let visited = ref [] in

lib/runtime/interp.ml

@@ -1,6 +1,7 @@
 exception Runtime_error of string
 
-let runtime_error f = Fmt.kstr (fun s -> raise (Runtime_error s)) f
+let runtime_error f =
+  Fmt.kstr (fun s -> raise (Runtime_error s)) f
 
 module Op = struct
   let add v1 v2 =
@@ -41,9 +42,11 @@ module Op = struct
 
   let slt obj name =
     match obj with
-    | Value.Obj (vtable, _) -> (
+    | Value.Obj (vtable, _) ->
+      begin
         try Value.of_elem (Hashtbl.find vtable.elems name)
-        with Not_found -> runtime_error "no such element %S" name)
+        with Not_found -> runtime_error "no such element %S" name
+      end
     | _ -> runtime_error "get element of non-object"
 
   let get obj el =
@@ -114,11 +117,10 @@ and call mthd self args =
 and run prog self =
   let frame_size = 1 in
   let frame_size = max frame_size (Code.frame_size prog) in
-  let fr =
+  let fr = {
-    let regs = Array.make frame_size Value.Nil in
+    regs = Array.make frame_size Value.Nil;
-    let pc = Code.instructions prog.entrypoint in
+    pc = Code.instructions prog.entrypoint;
-    { regs; pc }
+  } in
-  in
   let rec run_loop () =
     match fr.pc with
     | [] -> ()

lib/runtime/value.ml

@@ -37,8 +37,12 @@ let of_elem e =
 let to_elem = function
   | Int idx ->
     let i = Int64.to_int idx in
-      if i >= 0 then Field i else Method (-succ i)
+    if i >= 0 then
-  | _ -> invalid_arg "to_elem: non integer value"
+      Field i
+    else
+      Method (-succ i)
+  | _ ->
+    invalid_arg "to_elem: non integer value"
 
 let rec pp ppf = function
   | Obj (vtable, slots) -> pp_obj ppf vtable slots
@@ -73,7 +77,6 @@ let call mthd _self args =
 let native_lib fns =
   let elems = Hashtbl.create (List.length fns * 4) in
   List.iteri (fun i (name, _) -> Hashtbl.add elems name (Method i)) fns;
-  let mthds = List.map (fun (_, f) -> Native_function f) fns in
+  let mthds = List.map (fun (_, f) -> Native_function f) fns |> Array.of_list in
-  let mthds = Array.of_list mthds in
   let vtable = { n_slots = 0; elems; mthds } in
   Obj (vtable, [||])

lib/spice.ml

@@ -4,19 +4,24 @@ module Value = Spice_runtime.Value
 
 exception Error of string
 
-let failf f = Fmt.kstr (fun s -> raise (Error s)) f
+let failf f =
+  Fmt.kstr (fun s -> raise (Error s)) f
 
 let parse input =
+  let open Spice_syntax in
   let lexbuf = Lexing.from_string input ~with_positions:true in
-  try Spice_syntax.Parser.modl Spice_syntax.Lexer.read lexbuf with
+  try
-  | Spice_syntax.Parser.Error -> failf "syntax error"
+    Parser.modl Lexer.read lexbuf
-  | Spice_syntax.Lexer.Error msg -> failf "syntax error: %s" msg
+  with
+  | Parser.Error -> failf "syntax error"
+  | Lexer.Error msg -> failf "syntax error: %s" msg
 
 let compile ast = Spice_compile.Bcc.compile ast
 
 let run prog =
-  try
   let open Spice_runtime in
+  try
     let stdlib = Value.native_lib Interp.stdlib in
     Interp.run prog stdlib
-  with Spice_runtime.Interp.Runtime_error msg -> failf "runtime error: %s" msg
+  with
+  | Interp.Runtime_error msg -> failf "runtime error: %s" msg

lib/syntax/ast.ml

@@ -82,34 +82,35 @@ let rec pp_exp ppf = function
   | Path (Ele (e, x)) -> Fmt.pf ppf "{\"ele\":%a,\"field\":%S}" pp_exp e x
   | Call (fn, args) -> Fmt.pf ppf "{\"call\":%a}" (pp_list pp_exp) (Path fn :: args)
   | If (ec, et, ee) ->
-      Fmt.pf ppf "{\"if\":%a,\"then\":%a,\"else\":%a}" pp_exp ec pp_exp et pp_exp ee
+    Fmt.pf ppf "{\"if\":%a,\"then\":%a,\"else\":%a}"
+      pp_exp ec
+      pp_exp et
+      pp_exp ee
   | Binop (op, e1, e2) ->
-      Fmt.pf
+    Fmt.pf ppf "{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
-        ppf
-        "{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
       (string_of_binop op)
-        pp_exp
+      pp_exp e1
-        e1
+      pp_exp e2
-        pp_exp
-        e2
   | Fun (params, body) ->
-      Fmt.pf ppf "{\"fun\":%a,\"body\":%a}" (pp_list Fmt.string) params pp_exp body
+    Fmt.pf ppf "{\"fun\":%a,\"body\":%a}"
+      (pp_list Fmt.string) params
+      pp_exp body
   | Obj body -> Fmt.pf ppf "{\"obj\":%a}" (pp_list pp_item) body
   | Scope body -> Fmt.pf ppf "{\"scope\":%a}" (pp_list pp_item) body
 
 and pp_item ppf = function
-  | Item_exp e -> Fmt.pf ppf "{\"exp\":%a}" pp_exp e
+  | Item_exp e ->
-  | Item_val (name, rhs) -> Fmt.pf ppf "{\"val\":%S,\"rhs\":%a}" name pp_exp rhs
+    Fmt.pf ppf "{\"exp\":%a}" pp_exp e
+  | Item_val (name, rhs) ->
+    Fmt.pf ppf "{\"val\":%S,\"rhs\":%a}" name pp_exp rhs
   | Item_fun (name, params, body) ->
-      Fmt.pf
+    Fmt.pf ppf "{\"fun\":%S,\"params\":%a,\"body\":%a}"
-        ppf
-        "{\"fun\":%S,\"params\":%a,\"body\":%a}"
       name
-        (pp_list Fmt.string)
+      (pp_list Fmt.string) params
-        params
+      pp_exp body
-        pp_exp
-        body
   | Item_obj (name, body) ->
-      Fmt.pf ppf "{\"obj\":%S,\"body\":%a}" name (pp_list pp_item) body
+    Fmt.pf ppf "{\"obj\":%S,\"body\":%a}"
+      name
+      (pp_list pp_item) body
 
 let pp_modl ppf m = pp_list pp_item ppf m.items