switch formatter to ocp-indent

This commit is contained in:
tali 2023-12-02 17:02:40 -05:00
parent d523c5c997
commit 333b8e7450
8 changed files with 204 additions and 176 deletions

12
.ocp-indent Normal file
View File

@ -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

3
format.sh Executable file
View File

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

View File

@ -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 ->
emit (EQL (sp, rhs));
emit (NOT sp)
| Ast.Not_eql -> emit (EQL (sp, rhs)); emit (NOT sp)
| Ast.Lst -> emit (LST (sp, rhs))
| Ast.Lst_eql ->
emit (LST (sp, rhs));
emit (NOT sp)
| Ast.Lst_eql -> emit (LST (sp, rhs)); emit (NOT sp)
| Ast.Grt -> emit (GRT (sp, rhs))
| Ast.Grt_eql ->
emit (LST (sp, rhs));
emit (NOT sp));
| Ast.Grt_eql -> 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

View File

@ -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

View File

@ -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 regs = Array.make frame_size Value.Nil in
let pc = Code.instructions prog.entrypoint in
{ regs; pc }
in
let fr = {
regs = Array.make frame_size Value.Nil;
pc = Code.instructions prog.entrypoint;
} in
let rec run_loop () =
match fr.pc with
| [] -> ()

View File

@ -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)
| _ -> invalid_arg "to_elem: non integer value"
if i >= 0 then
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 = Array.of_list mthds in
let mthds = List.map (fun (_, f) -> Native_function f) fns |> Array.of_list in
let vtable = { n_slots = 0; elems; mthds } in
Obj (vtable, [||])

View File

@ -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
| Spice_syntax.Parser.Error -> failf "syntax error"
| Spice_syntax.Lexer.Error msg -> failf "syntax error: %s" msg
try
Parser.modl Lexer.read lexbuf
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

View File

@ -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
ppf
"{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
Fmt.pf ppf "{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
(string_of_binop op)
pp_exp
e1
pp_exp
e2
pp_exp e1
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_val (name, rhs) -> Fmt.pf ppf "{\"val\":%S,\"rhs\":%a}" name pp_exp rhs
| Item_exp e ->
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
ppf
"{\"fun\":%S,\"params\":%a,\"body\":%a}"
Fmt.pf ppf "{\"fun\":%S,\"params\":%a,\"body\":%a}"
name
(pp_list Fmt.string)
params
pp_exp
body
(pp_list Fmt.string) params
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