switch formatter to ocp-indent
This commit is contained in:
parent
d523c5c997
commit
333b8e7450
|
|
@ -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
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
#!/usr/bin/env sh
|
||||
|
||||
git ls-tree HEAD -r --name-only | grep 'ml$' | xargs ocp-indent -i
|
||||
|
|
@ -25,66 +25,61 @@ let compile modl =
|
|||
match Env.find name env with
|
||||
| exception Not_found -> Fmt.failwith "unbound: %S" name
|
||||
| { self; elem } ->
|
||||
let idx = Code.cst (Value.of_elem elem) in
|
||||
emit_mov sp idx;
|
||||
emit (GET (self, sp));
|
||||
Reg sp)
|
||||
let idx = Code.cst (Value.of_elem elem) in
|
||||
emit_mov sp idx;
|
||||
emit (GET (self, sp));
|
||||
Reg sp)
|
||||
| Ast.Path (Ele (obj, ele)) ->
|
||||
emit_mov (sp + 1) (compile_exp env sp obj);
|
||||
emit (SLT (sp + 1, sp, ele));
|
||||
emit (GET (sp + 1, sp));
|
||||
Reg sp
|
||||
emit_mov (sp + 1) (compile_exp env sp obj);
|
||||
emit (SLT (sp + 1, sp, ele));
|
||||
emit (GET (sp + 1, sp));
|
||||
Reg sp
|
||||
| Ast.Call (Var name, args) -> (
|
||||
match Env.find name env with
|
||||
| exception Not_found -> Fmt.failwith "unbound: %S" name
|
||||
| { self; elem } ->
|
||||
List.iteri
|
||||
(fun i arg ->
|
||||
let sp = sp + i + 1 in
|
||||
emit_mov sp (compile_exp env sp arg))
|
||||
args;
|
||||
let idx = Code.cst (Value.of_elem elem) in
|
||||
emit_mov sp idx;
|
||||
emit (CLL (self, sp, List.length args));
|
||||
Reg sp)
|
||||
List.iteri
|
||||
(fun i arg ->
|
||||
let sp = sp + i + 1 in
|
||||
emit_mov sp (compile_exp env sp arg))
|
||||
args;
|
||||
let idx = Code.cst (Value.of_elem elem) in
|
||||
emit_mov sp idx;
|
||||
emit (CLL (self, sp, List.length args));
|
||||
Reg sp)
|
||||
| Ast.Binop (op, lhs, rhs) ->
|
||||
let lhs = compile_exp env sp lhs in
|
||||
emit_mov sp lhs;
|
||||
let rhs = compile_exp env (sp + 1) rhs in
|
||||
(match op with
|
||||
| Ast.Add -> emit (ADD (sp, rhs))
|
||||
| Ast.Sub -> emit (SUB (sp, rhs))
|
||||
| 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.Lst -> emit (LST (sp, rhs))
|
||||
| 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));
|
||||
Reg sp
|
||||
let lhs = compile_exp env sp lhs in
|
||||
emit_mov sp lhs;
|
||||
let rhs = compile_exp env (sp + 1) rhs in
|
||||
(match op with
|
||||
| Ast.Add -> emit (ADD (sp, rhs))
|
||||
| Ast.Sub -> emit (SUB (sp, rhs))
|
||||
| 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.Lst -> emit (LST (sp, rhs))
|
||||
| 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));
|
||||
Reg sp
|
||||
| Ast.If (cnd, e1, e2) ->
|
||||
let l1 = Code.make_basic_block [] in
|
||||
let l2 = Code.make_basic_block [] in
|
||||
let jp = Code.make_basic_block [] in
|
||||
emit (CBR (compile_exp env sp cnd, l1, l2));
|
||||
bb := l1;
|
||||
emit_mov sp (compile_exp env sp e1);
|
||||
emit (JMP jp);
|
||||
bb := l2;
|
||||
emit_mov sp (compile_exp env sp e2);
|
||||
emit (JMP jp);
|
||||
bb := jp;
|
||||
Reg sp
|
||||
let l1 = Code.make_basic_block [] in
|
||||
let l2 = Code.make_basic_block [] in
|
||||
let jp = Code.make_basic_block [] in
|
||||
emit (CBR (compile_exp env sp cnd, l1, l2));
|
||||
bb := l1;
|
||||
emit_mov sp (compile_exp env sp e1);
|
||||
emit (JMP jp);
|
||||
bb := l2;
|
||||
emit_mov sp (compile_exp env sp e2);
|
||||
emit (JMP jp);
|
||||
bb := jp;
|
||||
Reg sp
|
||||
| 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,12 +89,13 @@ let compile modl =
|
|||
let env, n_slots =
|
||||
List.fold_left
|
||||
(fun (env, n) -> function
|
||||
| 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
|
||||
Hashtbl.add elems name elem;
|
||||
env, n + 1)
|
||||
| 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
|
||||
Hashtbl.add elems name elem;
|
||||
env, n + 1)
|
||||
(env, 0)
|
||||
items
|
||||
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
|
||||
|
|
@ -121,18 +116,20 @@ let compile modl =
|
|||
let final_exp =
|
||||
List.fold_left
|
||||
(fun _ -> function
|
||||
| Ast.Item_fun (_, _, _) -> failwith "Bcc: unsupported: methods"
|
||||
| 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
|
||||
| Ast.Item_val (name, rhs) ->
|
||||
emit_set name (compile_exp env (sp + 1) rhs);
|
||||
None)
|
||||
| Ast.Item_fun (_, _, _) -> failwith "Bcc: unsupported: methods"
|
||||
| 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
|
||||
| Ast.Item_val (name, rhs) ->
|
||||
emit_set name (compile_exp env (sp + 1) rhs);
|
||||
None)
|
||||
None
|
||||
items
|
||||
in
|
||||
self, final_exp
|
||||
|
||||
and compile_obj env sp items =
|
||||
let self, _ = compile_block env sp items in
|
||||
Code.Reg self
|
||||
|
|
|
|||
|
|
@ -17,8 +17,8 @@ let cst = function
|
|||
type basic_block = {
|
||||
mutable ins_builder : ins list;
|
||||
mutable ins_list : ins list;
|
||||
(* bc_pc : int *)
|
||||
(* bc_len : int *)
|
||||
(* bc_pc : int *)
|
||||
(* bc_len : int *)
|
||||
}
|
||||
|
||||
and ins =
|
||||
|
|
@ -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
|
||||
|
|
@ -78,22 +83,22 @@ let frame_size prog =
|
|||
| GET (o, s) | SLT (o, s, _) -> reg (reg acc o) s
|
||||
| SET (o, s) -> reg (reg acc o) (s + 1)
|
||||
| CBR (v, b1, b2) ->
|
||||
enqueue b1;
|
||||
enqueue b2;
|
||||
op acc v
|
||||
enqueue b1;
|
||||
enqueue b2;
|
||||
op acc v
|
||||
| CLL (o, m, k) -> reg (reg acc o) (m + k + 1)
|
||||
| JMP b ->
|
||||
enqueue b;
|
||||
acc
|
||||
enqueue b;
|
||||
acc
|
||||
| RET -> acc
|
||||
in
|
||||
let rec loop acc =
|
||||
match !work_list with
|
||||
| [] -> acc
|
||||
| bb :: rest ->
|
||||
visited := bb :: !visited;
|
||||
work_list := rest;
|
||||
List.fold_left ins acc (instructions bb) |> loop
|
||||
visited := bb :: !visited;
|
||||
work_list := rest;
|
||||
List.fold_left ins acc (instructions bb) |> loop
|
||||
in
|
||||
loop 1
|
||||
|
||||
|
|
@ -113,10 +118,10 @@ let pp_vtable ppf vt =
|
|||
let sep = ref "" in
|
||||
Hashtbl.iter
|
||||
(fun name -> function
|
||||
| Value.Method _ -> ()
|
||||
| Value.Field idx ->
|
||||
Fmt.pf ppf "%s%s@%d" !sep name idx;
|
||||
sep := ";")
|
||||
| Value.Method _ -> ()
|
||||
| Value.Field idx ->
|
||||
Fmt.pf ppf "%s%s@%d" !sep name idx;
|
||||
sep := ";")
|
||||
vt.elems;
|
||||
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
|
||||
| SET (o, s) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg o pp_reg s pp_reg (s + 1)
|
||||
| CLL (o, m, k) ->
|
||||
Fmt.pf ppf "cll %a, %a[%a](" pp_reg m pp_reg o pp_reg m;
|
||||
for i = 1 to k do
|
||||
if i > 1 then Fmt.pf ppf ",";
|
||||
Fmt.pf ppf "%a" pp_reg (m + i)
|
||||
done;
|
||||
Fmt.pf ppf ")"
|
||||
Fmt.pf ppf "cll %a, %a[%a](" pp_reg m pp_reg o pp_reg m;
|
||||
for i = 1 to k do
|
||||
if i > 1 then Fmt.pf ppf ",";
|
||||
Fmt.pf ppf "%a" pp_reg (m + i)
|
||||
done;
|
||||
Fmt.pf ppf ")"
|
||||
| CBR (v, b1, b2) ->
|
||||
let l1 = label b1 in
|
||||
let l2 = label b2 in
|
||||
Fmt.pf ppf "cbr %a, %s, %s" pp_operand v l1 l2
|
||||
let l1 = label b1 in
|
||||
let l2 = label b2 in
|
||||
Fmt.pf ppf "cbr %a, %s, %s" pp_operand v l1 l2
|
||||
| RET -> Fmt.pf ppf "ret"
|
||||
| JMP l -> Fmt.pf ppf "jmp %s" (label l)
|
||||
|
||||
|
|
@ -163,17 +168,17 @@ let pp_program ppf pr =
|
|||
match !work_list with
|
||||
| [] -> ()
|
||||
| bb :: rest ->
|
||||
work_list := rest;
|
||||
if i > 0 then Fmt.pf ppf ",";
|
||||
Fmt.pf ppf "%S:[" (label bb);
|
||||
List.iteri
|
||||
(fun i is ->
|
||||
if i > 0 then Fmt.pf ppf ",";
|
||||
let str = Fmt.str "%a" (pp_ins ~label) is in
|
||||
Fmt.pf ppf "%S" str)
|
||||
(instructions bb);
|
||||
Fmt.pf ppf "]";
|
||||
loop (i + 1)
|
||||
work_list := rest;
|
||||
if i > 0 then Fmt.pf ppf ",";
|
||||
Fmt.pf ppf "%S:[" (label bb);
|
||||
List.iteri
|
||||
(fun i is ->
|
||||
if i > 0 then Fmt.pf ppf ",";
|
||||
let str = Fmt.str "%a" (pp_ins ~label) is in
|
||||
Fmt.pf ppf "%S" str)
|
||||
(instructions bb);
|
||||
Fmt.pf ppf "]";
|
||||
loop (i + 1)
|
||||
in
|
||||
Fmt.pf ppf "{";
|
||||
loop 0;
|
||||
|
|
|
|||
|
|
@ -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 =
|
||||
|
|
@ -66,8 +69,8 @@ module Op = struct
|
|||
| Value.Obj (_, _), Field _ -> failwith "Interp.Op.get: TODO: fcf calls"
|
||||
| exception Invalid_argument _ -> runtime_error "invalid index"
|
||||
| _ ->
|
||||
(* TODO: create vtable from primitive types *)
|
||||
runtime_error "call field of non-object"
|
||||
(* TODO: create vtable from primitive types *)
|
||||
runtime_error "call field of non-object"
|
||||
end
|
||||
|
||||
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.RET -> fr.pc <- []
|
||||
| Code.CLL (o, m, k) ->
|
||||
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
|
||||
fr.regs.(m) <- call mthd self args
|
||||
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
|
||||
fr.regs.(m) <- call mthd self args
|
||||
| Code.JMP l -> fr.pc <- Code.instructions l
|
||||
| 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 =
|
||||
match mthd with
|
||||
| Code.Method pr ->
|
||||
if args <> [] then failwith "Interp.call: TODO: method arguments";
|
||||
run pr self
|
||||
if args <> [] then failwith "Interp.call: TODO: method arguments";
|
||||
run pr self
|
||||
| _ -> Value.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
|
||||
| [] -> ()
|
||||
| ins :: rest ->
|
||||
fr.pc <- rest;
|
||||
exec fr ins;
|
||||
run_loop ()
|
||||
fr.pc <- rest;
|
||||
exec fr ins;
|
||||
run_loop ()
|
||||
in
|
||||
fr.regs.(0) <- self;
|
||||
run_loop ();
|
||||
|
|
@ -136,8 +138,8 @@ let stdlib =
|
|||
let pp ppf vs =
|
||||
List.iteri
|
||||
(fun i v ->
|
||||
if i > 0 then Fmt.pf ppf " ";
|
||||
Value.pp ppf v)
|
||||
if i > 0 then Fmt.pf ppf " ";
|
||||
Value.pp ppf v)
|
||||
vs
|
||||
in
|
||||
Fmt.pr "%a\n" pp vs;
|
||||
|
|
@ -147,24 +149,24 @@ let stdlib =
|
|||
| [] -> runtime_error "zero arguments to min()"
|
||||
| [ v ] -> v
|
||||
| v :: vs ->
|
||||
List.fold_left
|
||||
(fun v1 v2 ->
|
||||
match Op.lst v1 v2 with
|
||||
| Value.True -> v1
|
||||
| _ -> v2)
|
||||
v
|
||||
vs
|
||||
List.fold_left
|
||||
(fun v1 v2 ->
|
||||
match Op.lst v1 v2 with
|
||||
| Value.True -> v1
|
||||
| _ -> v2)
|
||||
v
|
||||
vs
|
||||
in
|
||||
let max = function
|
||||
| [] -> runtime_error "zero arguments to max()"
|
||||
| [ v ] -> v
|
||||
| v :: vs ->
|
||||
List.fold_left
|
||||
(fun v1 v2 ->
|
||||
match Op.grt v1 v2 with
|
||||
| Value.True -> v1
|
||||
| _ -> v2)
|
||||
v
|
||||
vs
|
||||
List.fold_left
|
||||
(fun v1 v2 ->
|
||||
match Op.grt v1 v2 with
|
||||
| Value.True -> v1
|
||||
| _ -> v2)
|
||||
v
|
||||
vs
|
||||
in
|
||||
[ "println", println; "min", min; "max", max ]
|
||||
|
|
|
|||
|
|
@ -36,9 +36,13 @@ 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"
|
||||
let i = Int64.to_int idx in
|
||||
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
|
||||
|
|
@ -56,10 +60,10 @@ and pp_obj ppf vtable slots =
|
|||
let sep = ref "" in
|
||||
Hashtbl.iter
|
||||
(fun name -> function
|
||||
| Method _ -> ()
|
||||
| Field idx ->
|
||||
Fmt.pf ppf "%s%S:%a" !sep name pp slots.(idx);
|
||||
sep := ",")
|
||||
| Method _ -> ()
|
||||
| Field idx ->
|
||||
Fmt.pf ppf "%s%S:%a" !sep name pp slots.(idx);
|
||||
sep := ",")
|
||||
vtable.elems;
|
||||
Fmt.pf ppf "}"
|
||||
|
||||
|
|
@ -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, [||])
|
||||
|
|
|
|||
17
lib/spice.ml
17
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
|
||||
| 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 =
|
||||
let open Spice_runtime in
|
||||
try
|
||||
let open Spice_runtime in
|
||||
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
|
||||
|
|
|
|||
|
|
@ -70,8 +70,8 @@ let pp_list pp_ele ppf list =
|
|||
Fmt.pf ppf "[";
|
||||
List.iteri
|
||||
(fun i ele ->
|
||||
if i > 0 then Fmt.pf ppf ",";
|
||||
pp_ele ppf ele)
|
||||
if i > 0 then Fmt.pf ppf ",";
|
||||
pp_ele ppf ele)
|
||||
list;
|
||||
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
|
||||
| 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}"
|
||||
(string_of_binop op)
|
||||
pp_exp
|
||||
e1
|
||||
pp_exp
|
||||
e2
|
||||
Fmt.pf ppf "{\"binop\":%S,\"lhs\":%a,\"rhs\":%a}"
|
||||
(string_of_binop op)
|
||||
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}"
|
||||
name
|
||||
(pp_list Fmt.string)
|
||||
params
|
||||
pp_exp
|
||||
body
|
||||
Fmt.pf ppf "{\"fun\":%S,\"params\":%a,\"body\":%a}"
|
||||
name
|
||||
(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
|
||||
|
|
|
|||
Loading…
Reference in New Issue