iitalics
/
spice
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

129
lib/compile/bcc.ml
View File

@ -25,66 +25,61 @@ let compile modl =
match Env.find name env with match Env.find name env with
| exception Not_found -> Fmt.failwith "unbound: %S" name | exception Not_found -> Fmt.failwith "unbound: %S" name
| { self; elem } -> | { self; elem } ->
let idx = Code.cst (Value.of_elem elem) in let idx = Code.cst (Value.of_elem elem) in
emit_mov sp idx; emit_mov sp idx;
emit (GET (self, sp)); emit (GET (self, sp));
Reg sp) Reg sp)
| Ast.Path (Ele (obj, ele)) -> | Ast.Path (Ele (obj, ele)) ->
emit_mov (sp + 1) (compile_exp env sp obj); emit_mov (sp + 1) (compile_exp env sp obj);
emit (SLT (sp + 1, sp, ele)); emit (SLT (sp + 1, sp, ele));
emit (GET (sp + 1, sp)); emit (GET (sp + 1, sp));
Reg sp Reg sp
| Ast.Call (Var name, args) -> ( | Ast.Call (Var name, args) -> (
match Env.find name env with match Env.find name env with
| exception Not_found -> Fmt.failwith "unbound: %S" name | exception Not_found -> Fmt.failwith "unbound: %S" name
| { self; elem } -> | { self; elem } ->
List.iteri List.iteri
(fun i arg -> (fun i arg ->
let sp = sp + i + 1 in let sp = sp + i + 1 in
emit_mov sp (compile_exp env sp arg)) emit_mov sp (compile_exp env sp arg))
args; args;
let idx = Code.cst (Value.of_elem elem) in let idx = Code.cst (Value.of_elem elem) in
emit_mov sp idx; emit_mov sp idx;
emit (CLL (self, sp, List.length args)); emit (CLL (self, sp, List.length args));
Reg sp) Reg sp)
| Ast.Binop (op, lhs, rhs) -> | Ast.Binop (op, lhs, rhs) ->
let lhs = compile_exp env sp lhs in let lhs = compile_exp env sp lhs in
emit_mov sp lhs; emit_mov sp lhs;
let rhs = compile_exp env (sp + 1) rhs in let rhs = compile_exp env (sp + 1) rhs in
(match op with (match op with
| Ast.Add -> emit (ADD (sp, rhs)) | Ast.Add -> emit (ADD (sp, rhs))
| Ast.Sub -> emit (SUB (sp, rhs)) | Ast.Sub -> emit (SUB (sp, rhs))
| Ast.Mul -> emit (MUL (sp, rhs)) | Ast.Mul -> emit (MUL (sp, rhs))
| Ast.Div | Ast.Mod -> failwith "Bcc.compile_exp: TODO: div/mod" | Ast.Div | Ast.Mod -> failwith "Bcc.compile_exp: TODO: div/mod"
| Ast.Eql -> emit (EQL (sp, rhs)) | Ast.Eql -> emit (EQL (sp, rhs))
| Ast.Not_eql -> | Ast.Not_eql -> emit (EQL (sp, rhs)); emit (NOT sp)
emit (EQL (sp, rhs)); | Ast.Lst -> emit (LST (sp, rhs))
emit (NOT sp) | Ast.Lst_eql -> emit (LST (sp, rhs)); emit (NOT sp)
| Ast.Lst -> emit (LST (sp, rhs)) | Ast.Grt -> emit (GRT (sp, rhs))
| Ast.Lst_eql -> | Ast.Grt_eql -> emit (LST (sp, rhs)); emit (NOT sp));
emit (LST (sp, rhs)); Reg sp
emit (NOT sp)
| Ast.Grt -> emit (GRT (sp, rhs))
| Ast.Grt_eql ->
emit (LST (sp, rhs));
emit (NOT sp));
Reg sp
| Ast.If (cnd, e1, e2) -> | Ast.If (cnd, e1, e2) ->
let l1 = Code.make_basic_block [] in let l1 = Code.make_basic_block [] in
let l2 = Code.make_basic_block [] in let l2 = Code.make_basic_block [] in
let jp = Code.make_basic_block [] in let jp = Code.make_basic_block [] in
emit (CBR (compile_exp env sp cnd, l1, l2)); emit (CBR (compile_exp env sp cnd, l1, l2));
bb := l1; bb := l1;
emit_mov sp (compile_exp env sp e1); emit_mov sp (compile_exp env sp e1);
emit (JMP jp); emit (JMP jp);
bb := l2; bb := l2;
emit_mov sp (compile_exp env sp e2); emit_mov sp (compile_exp env sp e2);
emit (JMP jp); emit (JMP jp);
bb := jp; bb := jp;
Reg sp Reg sp
| Ast.Obj body -> compile_obj env sp body | Ast.Obj body -> compile_obj env sp body
| Ast.Scope body -> compile_scope env sp body | Ast.Scope body -> compile_scope env sp body
| _ -> failwith "Bcc.compile_exp: TODO" | _ -> failwith "Bcc.compile_exp: TODO"
and compile_block env sp items = and compile_block env sp items =
let self = sp in let self = sp in
let sp = sp + 1 in let sp = sp + 1 in
@ -94,12 +89,13 @@ let compile modl =
let env, n_slots = let env, n_slots =
List.fold_left List.fold_left
(fun (env, n) -> function (fun (env, n) -> function
| Ast.Item_fun (_, _, _) | Ast.Item_exp _ -> env, n | Ast.Item_fun (_, _, _) | Ast.Item_exp _ ->
| Ast.Item_obj (name, _) | Ast.Item_val (name, _) -> env, n
let elem = Value.Field n in | Ast.Item_obj (name, _) | Ast.Item_val (name, _) ->
let env = Env.add name { self; elem } env in let elem = Value.Field n in
Hashtbl.add elems name elem; let env = Env.add name { self; elem } env in
env, n + 1) Hashtbl.add elems name elem;
env, n + 1)
(env, 0) (env, 0)
items items
in in
@ -107,9 +103,8 @@ let compile modl =
(* compile methods *) (* compile methods *)
let mthds = [||] in let mthds = [||] in
let vtable = Value.{ n_slots; elems; mthds } in
(* emit constructor, compile val fields, and get result of final expression *) (* emit constructor, compile val fields, and get result of final expression *)
let vtable = Value.{ n_slots; elems; mthds } in
emit (CON (self, vtable)); emit (CON (self, vtable));
let emit_set name rhs = let emit_set name rhs =
let { elem; _ } = Env.find name env in let { elem; _ } = Env.find name env in
@ -121,18 +116,20 @@ let compile modl =
let final_exp = let final_exp =
List.fold_left List.fold_left
(fun _ -> function (fun _ -> function
| Ast.Item_fun (_, _, _) -> failwith "Bcc: unsupported: methods" | Ast.Item_fun (_, _, _) -> failwith "Bcc: unsupported: methods"
| Ast.Item_exp exp -> Some (compile_exp env sp exp) | Ast.Item_exp exp ->
| Ast.Item_obj (name, body) -> Some (compile_exp env sp exp)
emit_set name (compile_obj env (sp + 1) body); | Ast.Item_obj (name, body) ->
None emit_set name (compile_obj env (sp + 1) body);
| Ast.Item_val (name, rhs) -> None
emit_set name (compile_exp env (sp + 1) rhs); | Ast.Item_val (name, rhs) ->
None) emit_set name (compile_exp env (sp + 1) rhs);
None)
None None
items items
in in
self, final_exp self, final_exp
and compile_obj env sp items = and compile_obj env sp items =
let self, _ = compile_block env sp items in let self, _ = compile_block env sp items in
Code.Reg self Code.Reg self

79
lib/runtime/code.ml
View File

@ -17,8 +17,8 @@ let cst = function
type basic_block = { type basic_block = {
mutable ins_builder : ins list; mutable ins_builder : ins list;
mutable ins_list : ins list; mutable ins_list : ins list;
(* bc_pc : int *) (* bc_pc : int *)
(* bc_len : int *) (* bc_len : int *)
} }
and ins = and ins =
@ -39,11 +39,15 @@ and ins =
| CBR of operand * basic_block * basic_block | CBR of operand * basic_block * basic_block
| RET | 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 = let instructions bb =
(* memoize computing "rev ins_builder" by storing result in ins_list *) (* 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 bb.ins_list
let add_ins bb is = let add_ins bb is =
@ -55,7 +59,8 @@ let add_ins bb is =
type program = { entrypoint : basic_block } type program = { entrypoint : basic_block }
type Value.mthd += Method of program type Value.mthd += Method of program
let make_program entrypoint = { entrypoint } let make_program entrypoint =
{ entrypoint }
let frame_size prog = let frame_size prog =
let visited = ref [] in let visited = ref [] in
@ -78,22 +83,22 @@ let frame_size prog =
| GET (o, s) | SLT (o, s, _) -> reg (reg acc o) s | GET (o, s) | SLT (o, s, _) -> reg (reg acc o) s
| SET (o, s) -> reg (reg acc o) (s + 1) | SET (o, s) -> reg (reg acc o) (s + 1)
| CBR (v, b1, b2) -> | CBR (v, b1, b2) ->
enqueue b1; enqueue b1;
enqueue b2; enqueue b2;
op acc v op acc v
| CLL (o, m, k) -> reg (reg acc o) (m + k + 1) | CLL (o, m, k) -> reg (reg acc o) (m + k + 1)
| JMP b -> | JMP b ->
enqueue b; enqueue b;
acc acc
| RET -> acc | RET -> acc
in in
let rec loop acc = let rec loop acc =
match !work_list with match !work_list with
| [] -> acc | [] -> acc
| bb :: rest -> | bb :: rest ->
visited := bb :: !visited; visited := bb :: !visited;
work_list := rest; work_list := rest;
List.fold_left ins acc (instructions bb) |> loop List.fold_left ins acc (instructions bb) |> loop
in in
loop 1 loop 1
@ -113,10 +118,10 @@ let pp_vtable ppf vt =
let sep = ref "" in let sep = ref "" in
Hashtbl.iter Hashtbl.iter
(fun name -> function (fun name -> function
| Value.Method _ -> () | Value.Method _ -> ()
| Value.Field idx -> | Value.Field idx ->
Fmt.pf ppf "%s%s@%d" !sep name idx; Fmt.pf ppf "%s%s@%d" !sep name idx;
sep := ";") sep := ";")
vt.elems; vt.elems;
Fmt.pf ppf "}" Fmt.pf ppf "}"
@ -134,16 +139,16 @@ let pp_ins ~label ppf = function
| GET (o, s) -> Fmt.pf ppf "mov %a, %a[%a]" pp_reg s pp_reg o pp_reg s | GET (o, s) -> Fmt.pf ppf "mov %a, %a[%a]" pp_reg s pp_reg o pp_reg s
| SET (o, s) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg o pp_reg s pp_reg (s + 1) | SET (o, s) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg o pp_reg s pp_reg (s + 1)
| CLL (o, m, k) -> | CLL (o, m, k) ->
Fmt.pf ppf "cll %a, %a[%a](" pp_reg m pp_reg o pp_reg m; Fmt.pf ppf "cll %a, %a[%a](" pp_reg m pp_reg o pp_reg m;
for i = 1 to k do for i = 1 to k do
if i > 1 then Fmt.pf ppf ","; if i > 1 then Fmt.pf ppf ",";
Fmt.pf ppf "%a" pp_reg (m + i) Fmt.pf ppf "%a" pp_reg (m + i)
done; done;
Fmt.pf ppf ")" Fmt.pf ppf ")"
| CBR (v, b1, b2) -> | CBR (v, b1, b2) ->
let l1 = label b1 in let l1 = label b1 in
let l2 = label b2 in let l2 = label b2 in
Fmt.pf ppf "cbr %a, %s, %s" pp_operand v l1 l2 Fmt.pf ppf "cbr %a, %s, %s" pp_operand v l1 l2
| RET -> Fmt.pf ppf "ret" | RET -> Fmt.pf ppf "ret"
| JMP l -> Fmt.pf ppf "jmp %s" (label l) | JMP l -> Fmt.pf ppf "jmp %s" (label l)
@ -163,17 +168,17 @@ let pp_program ppf pr =
match !work_list with match !work_list with
| [] -> () | [] -> ()
| bb :: rest -> | bb :: rest ->
work_list := rest; work_list := rest;
if i > 0 then Fmt.pf ppf ","; if i > 0 then Fmt.pf ppf ",";
Fmt.pf ppf "%S:[" (label bb); Fmt.pf ppf "%S:[" (label bb);
List.iteri List.iteri
(fun i is -> (fun i is ->
if i > 0 then Fmt.pf ppf ","; if i > 0 then Fmt.pf ppf ",";
let str = Fmt.str "%a" (pp_ins ~label) is in let str = Fmt.str "%a" (pp_ins ~label) is in
Fmt.pf ppf "%S" str) Fmt.pf ppf "%S" str)
(instructions bb); (instructions bb);
Fmt.pf ppf "]"; Fmt.pf ppf "]";
loop (i + 1) loop (i + 1)
in in
Fmt.pf ppf "{"; Fmt.pf ppf "{";
loop 0; loop 0;

72
lib/runtime/interp.ml
View File

@ -1,6 +1,7 @@
exception Runtime_error of string 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 module Op = struct
let add v1 v2 = let add v1 v2 =
@ -41,9 +42,11 @@ module Op = struct
let slt obj name = let slt obj name =
match obj with match obj with
| Value.Obj (vtable, _) -> ( | Value.Obj (vtable, _) ->
begin
try Value.of_elem (Hashtbl.find vtable.elems name) 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" | _ -> runtime_error "get element of non-object"
let get obj el = let get obj el =
@ -66,8 +69,8 @@ module Op = struct
| Value.Obj (_, _), Field _ -> failwith "Interp.Op.get: TODO: fcf calls" | Value.Obj (_, _), Field _ -> failwith "Interp.Op.get: TODO: fcf calls"
| exception Invalid_argument _ -> runtime_error "invalid index" | exception Invalid_argument _ -> runtime_error "invalid index"
| _ -> | _ ->
(* TODO: create vtable from primitive types *) (* TODO: create vtable from primitive types *)
runtime_error "call field of non-object" runtime_error "call field of non-object"
end end
type frame = { type frame = {
@ -97,35 +100,34 @@ let rec exec fr = function
| Code.SET (o, e) -> Op.set fr.regs.(o) fr.regs.(e) fr.regs.(e + 1) | Code.SET (o, e) -> Op.set fr.regs.(o) fr.regs.(e) fr.regs.(e + 1)
| Code.RET -> fr.pc <- [] | Code.RET -> fr.pc <- []
| Code.CLL (o, m, k) -> | Code.CLL (o, m, k) ->
let self, mthd = Op.mthd fr.regs.(o) fr.regs.(m) in let self, mthd = Op.mthd fr.regs.(o) fr.regs.(m) in
let args = List.init k (fun i -> fr.regs.(m + i + 1)) in let args = List.init k (fun i -> fr.regs.(m + i + 1)) in
fr.regs.(m) <- call mthd self args fr.regs.(m) <- call mthd self args
| Code.JMP l -> fr.pc <- Code.instructions l | Code.JMP l -> fr.pc <- Code.instructions l
| Code.CBR (v, l1, l2) -> | Code.CBR (v, l1, l2) ->
fr.pc <- Code.instructions (if Op.is_truthy (eval fr v) then l1 else l2) fr.pc <- Code.instructions (if Op.is_truthy (eval fr v) then l1 else l2)
and call mthd self args = and call mthd self args =
match mthd with match mthd with
| Code.Method pr -> | Code.Method pr ->
if args <> [] then failwith "Interp.call: TODO: method arguments"; if args <> [] then failwith "Interp.call: TODO: method arguments";
run pr self run pr self
| _ -> Value.call mthd self args | _ -> Value.call mthd self args
and run prog self = and run prog self =
let frame_size = 1 in let frame_size = 1 in
let frame_size = max frame_size (Code.frame_size prog) 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 () = let rec run_loop () =
match fr.pc with match fr.pc with
| [] -> () | [] -> ()
| ins :: rest -> | ins :: rest ->
fr.pc <- rest; fr.pc <- rest;
exec fr ins; exec fr ins;
run_loop () run_loop ()
in in
fr.regs.(0) <- self; fr.regs.(0) <- self;
run_loop (); run_loop ();
@ -136,8 +138,8 @@ let stdlib =
let pp ppf vs = let pp ppf vs =
List.iteri List.iteri
(fun i v -> (fun i v ->
if i > 0 then Fmt.pf ppf " "; if i > 0 then Fmt.pf ppf " ";
Value.pp ppf v) Value.pp ppf v)
vs vs
in in
Fmt.pr "%a\n" pp vs; Fmt.pr "%a\n" pp vs;
@ -147,24 +149,24 @@ let stdlib =
| [] -> runtime_error "zero arguments to min()" | [] -> runtime_error "zero arguments to min()"
| [ v ] -> v | [ v ] -> v
| v :: vs -> | v :: vs ->
List.fold_left List.fold_left
(fun v1 v2 -> (fun v1 v2 ->
match Op.lst v1 v2 with match Op.lst v1 v2 with
| Value.True -> v1 | Value.True -> v1
| _ -> v2) | _ -> v2)
v v
vs vs
in in
let max = function let max = function
| [] -> runtime_error "zero arguments to max()" | [] -> runtime_error "zero arguments to max()"
| [ v ] -> v | [ v ] -> v
| v :: vs -> | v :: vs ->
List.fold_left List.fold_left
(fun v1 v2 -> (fun v1 v2 ->
match Op.grt v1 v2 with match Op.grt v1 v2 with
| Value.True -> v1 | Value.True -> v1
| _ -> v2) | _ -> v2)
v v
vs vs
in in
[ "println", println; "min", min; "max", max ] [ "println", println; "min", min; "max", max ]

21
lib/runtime/value.ml
View File

@ -36,9 +36,13 @@ let of_elem e =
let to_elem = function let to_elem = function
| Int idx -> | Int idx ->
let i = Int64.to_int idx in 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 let rec pp ppf = function
| Obj (vtable, slots) -> pp_obj ppf vtable slots | Obj (vtable, slots) -> pp_obj ppf vtable slots
@ -56,10 +60,10 @@ and pp_obj ppf vtable slots =
let sep = ref "" in let sep = ref "" in
Hashtbl.iter Hashtbl.iter
(fun name -> function (fun name -> function
| Method _ -> () | Method _ -> ()
| Field idx -> | Field idx ->
Fmt.pf ppf "%s%S:%a" !sep name pp slots.(idx); Fmt.pf ppf "%s%S:%a" !sep name pp slots.(idx);
sep := ",") sep := ",")
vtable.elems; vtable.elems;
Fmt.pf ppf "}" Fmt.pf ppf "}"
@ -73,7 +77,6 @@ let call mthd _self args =
let native_lib fns = let native_lib fns =
let elems = Hashtbl.create (List.length fns * 4) in let elems = Hashtbl.create (List.length fns * 4) in
List.iteri (fun i (name, _) -> Hashtbl.add elems name (Method i)) fns; 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 let vtable = { n_slots = 0; elems; mthds } in
Obj (vtable, [||]) Obj (vtable, [||])

17
lib/spice.ml
View File

@ -4,19 +4,24 @@ module Value = Spice_runtime.Value
exception Error of string 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 parse input =
let open Spice_syntax in
let lexbuf = Lexing.from_string input ~with_positions:true 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 compile ast = Spice_compile.Bcc.compile ast
let run prog = let run prog =
let open Spice_runtime in
try try
let open Spice_runtime in
let stdlib = Value.native_lib Interp.stdlib in let stdlib = Value.native_lib Interp.stdlib in
Interp.run prog stdlib 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

47
lib/syntax/ast.ml
View File

@ -70,8 +70,8 @@ let pp_list pp_ele ppf list =
Fmt.pf ppf "["; Fmt.pf ppf "[";
List.iteri List.iteri
(fun i ele -> (fun i ele ->
if i > 0 then Fmt.pf ppf ","; if i > 0 then Fmt.pf ppf ",";
pp_ele ppf ele) pp_ele ppf ele)
list; list;
Fmt.pf ppf "]" Fmt.pf ppf "]"
@ -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 | 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) | Call (fn, args) -> Fmt.pf ppf "{\"call\":%a}" (pp_list pp_exp) (Path fn :: args)
| If (ec, et, ee) -> | 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) -> | Binop (op, e1, e2) ->
Fmt.pf Fmt.pf ppf "{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
ppf (string_of_binop op)
"{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}" pp_exp e1
(string_of_binop op) pp_exp e2
pp_exp
e1
pp_exp
e2
| Fun (params, body) -> | 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 | Obj body -> Fmt.pf ppf "{\"obj\":%a}" (pp_list pp_item) body
| Scope body -> Fmt.pf ppf "{\"scope\":%a}" (pp_list pp_item) body | Scope body -> Fmt.pf ppf "{\"scope\":%a}" (pp_list pp_item) body
and pp_item ppf = function 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) -> | Item_fun (name, params, body) ->
Fmt.pf Fmt.pf ppf "{\"fun\":%S,\"params\":%a,\"body\":%a}"
ppf name
"{\"fun\":%S,\"params\":%a,\"body\":%a}" (pp_list Fmt.string) params
name pp_exp body
(pp_list Fmt.string)
params
pp_exp
body
| Item_obj (name, 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 let pp_modl ppf m = pp_list pp_item ppf m.items