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

add named fields and preliminary method support

This commit is contained in:
tali 2023-12-02 13:51:15 -05:00
parent b018c83782
commit 24409f7902
5 changed files with 86 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
bin/main.ml
View File

@ -5,7 +5,7 @@ let () =
Logs.set_level (Some Logs.Debug);
try
let ast = parse "val z = 5 val output = 1 + (({ val x = 3 val y = 4 x * y }) + z)" in
let ast = parse "obj pos { val x = 3 val y = 4 } val result = pos.x" in
let prog = compile ast in
let ret = run prog in
Fmt.pr "{\"program\":%a,\"output\":%a}" Code.pp_program prog Value.pp ret

11
lib/compile/bcc.ml
View File

@ -27,6 +27,11 @@ let compile modl =
emit_mov sp (Code.cst_of_int slot);
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
| Ast.Binop (op, lhs, rhs) ->
let lhs = compile_exp env sp lhs in
emit_mov sp lhs;
@ -83,7 +88,11 @@ let compile modl =
(env, 0)
items
in
let vtable = Value.{ elems; n_slots } in
(* compile methods *)
let mthds = [||] in
let vtable = Value.{ n_slots; elems; mthds } in
(* emit constructor, compile val fields, and get result of final expression *)
emit (CON (self, vtable));

19
lib/runtime/code.ml
View File

@ -26,8 +26,10 @@ and ins =
| GRT of regidx * operand
| NOT of regidx
| CON of regidx * Value.vtable
| SLT of regidx * regidx * string
| GET of regidx * regidx
| SET of regidx * regidx
| CLL of regidx * regidx * int
| JMP of basic_block
| CBR of operand * basic_block * basic_block
| RET
@ -47,6 +49,8 @@ let add_ins bb is =
type program = { entrypoint : basic_block }
type Value.mthd += Method of program
let make_program entrypoint = { entrypoint }
let frame_size prog =
@ -67,12 +71,13 @@ let frame_size prog =
| LST (r, v)
| GRT (r, v) -> op (reg acc r) v
| CON (r, _) | NOT r -> reg acc r
| GET (o, v) -> reg (reg acc o) v
| SET (o, v) -> reg (reg acc o) (v + 1)
| 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
| CLL (o, m, k) -> reg (reg acc o) (m + k + 1)
| JMP b ->
enqueue b;
acc
@ -104,7 +109,7 @@ let pp_vtable ppf vt =
let sep = ref "" in
Hashtbl.iter
(fun name -> function
| Value.Method -> ()
| Value.Method _ -> ()
| Value.Field idx ->
Fmt.pf ppf "%s%s@%d" !sep name idx;
sep := ";")
@ -121,8 +126,16 @@ let pp_ins ~label ppf = function
| GRT (l, r) -> Fmt.pf ppf "grt %a, %a" pp_reg l pp_operand r
| NOT l -> Fmt.pf ppf "not %a" pp_reg l
| CON (l, vt) -> Fmt.pf ppf "con %a, %a" pp_reg l pp_vtable vt
| SLT (o, s, n) -> Fmt.pf ppf "mov %a, @%a.%s" pp_reg s pp_reg o n
| 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](" 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

51
lib/runtime/interp.ml
View File

@ -31,21 +31,45 @@ module Op = struct
| Value.Int x, Value.Int y -> Value.bool (Int64.compare x y > 0)
| _, _ -> raise (Runtime_error "cannot compare non integer values")
let truthy = function
let is_truthy = function
| Value.False | Value.Nil -> false
| _ -> true
let not v = Value.bool (not (truthy v))
let not v = Value.bool (not (is_truthy v))
let slt o nm =
match o with
| Value.Obj (vtable, _) -> (
match Hashtbl.find vtable.elems nm with
| Value.Field i -> Value.int i
| Value.Method i -> Value.int (-succ i)
| exception Not_found -> raise (Runtime_error (Fmt.str "no method %S" nm)))
| _ -> raise (Runtime_error "get element of non-object")
let get o s =
match o, s with
| Value.Obj (_, slots), Value.Int i -> slots.(Int64.to_int i)
| Value.Obj (_, slots), Value.Int i ->
let i = Int64.to_int i in
if i < 0 then
failwith "Interp.Op.get: TODO: method reification"
else
slots.(i)
| _ -> raise (Runtime_error "get field of non-object")
let set o s v =
match o, s with
| Value.Obj (_, slots), Value.Int i -> slots.(Int64.to_int i) <- v
| _ -> raise (Runtime_error "set field of non-object")
let mthd o s =
match o, s with
| Value.Obj (vtable, _), Value.Int i ->
let i = Int64.to_int i in
if i < 0 then
o, vtable.mthds.(-succ i)
else
failwith "Interp.Op.get: first class function calls"
| _ -> raise (Runtime_error "call method of non-object")
end
type frame = {
@ -68,7 +92,7 @@ let eval fr = function
| Code.Cst_int n -> Value.Int n
| Code.Reg i -> fr.regs.(i)
let exec fr = function
let rec exec fr = function
| Code.MOV (l, r) -> fr.regs.(l) <- eval fr r
| Code.ADD (l, r) -> fr.regs.(l) <- Op.add fr.regs.(l) (eval fr r)
| Code.SUB (l, r) -> fr.regs.(l) <- Op.add fr.regs.(l) (eval fr r)
@ -78,14 +102,27 @@ let exec fr = function
| Code.GRT (l, r) -> fr.regs.(l) <- Op.grt fr.regs.(l) (eval fr r)
| Code.NOT l -> fr.regs.(l) <- Op.not fr.regs.(l)
| Code.CON (l, vt) -> fr.regs.(l) <- Value.make_obj vt
| Code.SLT (o, s, nm) -> fr.regs.(s) <- Op.slt fr.regs.(o) nm
| Code.GET (o, s) -> fr.regs.(s) <- Op.get fr.regs.(o) fr.regs.(s)
| Code.SET (o, s) -> Op.set fr.regs.(o) fr.regs.(s) fr.regs.(s + 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
| Code.JMP l -> fr.pc <- Code.instructions l
| Code.CBR (v, l1, l2) ->
fr.pc <- Code.instructions (if Op.truthy (eval fr v) then l1 else l2)
fr.pc <- Code.instructions (if Op.is_truthy (eval fr v) then l1 else l2)
let rec run fr =
and call mthd self args = match mthd with
| Code.Method pr ->
if args <> [] then
failwith "Interp.call: TODO: method arguments";
run_program pr
| _ ->
Value.call mthd self args
and run fr =
match fr.pc with
| [] -> return_value fr
| is :: rest ->
@ -93,4 +130,4 @@ let rec run fr =
exec fr is;
run fr
let run_program pr = run (make_frame pr)
and run_program pr = run (make_frame pr)

24
lib/runtime/value.ml
View File

@ -1,19 +1,17 @@
type slotidx = int
type mthdidx = int
type vtable = {
n_slots : int;
elems : (string, elem) Hashtbl.t;
mthds : mthd array;
}
and slotidx = int
and elem =
| Field of slotidx
| Method (* of callable *)
| Method of mthdidx
let make_vtable fields =
{
n_slots = List.length fields;
elems = List.to_seq fields |> Seq.mapi (fun i name -> name, Field i) |> Hashtbl.of_seq;
}
and mthd = ..
type t =
| Nil
@ -23,6 +21,7 @@ type t =
| Obj of vtable * t array
let make_obj vtable = Obj (vtable, Array.make vtable.n_slots Nil)
let int n = Int (Int64.of_int n)
let bool = function
| true -> True
@ -44,9 +43,16 @@ and pp_obj ppf vtable slots =
let sep = ref "" in
Hashtbl.iter
(fun name -> function
| Method -> ()
| Method _ -> ()
| Field idx ->
Fmt.pf ppf "%s%S:%a" !sep name pp slots.(idx);
sep := ",")
vtable.elems;
Fmt.pf ppf "}"
type mthd +=
| Native_function of (t -> t list -> t)
let call mthd self args = match mthd with
| Native_function f -> f self args
| _ -> raise Not_found