add back CALl instruction

lib/runtime/code.ml

@@ -23,6 +23,7 @@ type ins =
   | SET of reg * reg * reg
   | LOC of reg * reg * string
   | CON of reg * vtable
+  | CAL of reg * reg * reg * reg list
   (* control flow *)
   | RET
   | JMP of block
@@ -44,13 +45,8 @@ let instructions t =
 type prog =
   { entry : block }
 
-(* like [Seq.flat_map] but may change the ordering *)
-let flat_map_u f lst =
-  let rec go acc = function
-    | [] -> []
-    | x :: xs -> go (List.rev_append (f x) acc) xs
-  in
-  go [] lst
+type Value.mthd +=
+  | Method of { n_args : int; body : prog }
 
 let frame_size t =
   let queue = ref [ t.entry ] in
@@ -79,6 +75,8 @@ let frame_size t =
     | GET (r1, r2, r3)
     | SET (r1, r2, r3)
       -> meas r1 (meas r2 (meas r3 fs))
+    | CAL (r1, r2, r3, rs) ->
+      List.fold_right meas (r1::r2::r3::rs) fs
     | JMP b ->
       enqueue b;
       fs
@@ -126,6 +124,10 @@ let pp_ins ~label ppf = function
   | SET (a, b, c) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg b pp_reg c pp_reg a
   | LOC (a, b, el) -> Fmt.pf ppf "mov %a, &%a.%s" pp_reg a pp_reg b el
   | CON (a, vt) -> Fmt.pf ppf "con %a, %a" pp_reg a pp_vtable vt
+  | CAL (a, b, c, ds) ->
+    Fmt.pf ppf "cal %a, %a[%a](" pp_reg a pp_reg b pp_reg c;
+    List.iteri (fun i d -> if i > 0 then Fmt.pf ppf ","; pp_reg ppf d) ds;
+    Fmt.pf ppf ")"
   | RET -> Fmt.pf ppf "ret"
   | JMP b -> Fmt.pf ppf "jmp %s" (label b)
   | CBR (a, b1, b2) ->

lib/runtime/interp.ml

@@ -64,7 +64,7 @@ type frame = {
 
 let jmp fr b = fr.pc <- Code.instructions b
 
-let exec ({ r; _ } as fr) = function
+let rec exec ({ r; _ } as fr) = function
   | Code.LDI (R a, v) -> r.(a) <- v
   | Code.LDR (R a, R b) -> r.(a) <- r.(b)
   | Code.ADD (R a, R b, R c) -> r.(a) <- Prim.add r.(b) r.(c)
@@ -78,13 +78,27 @@ let exec ({ r; _ } as fr) = function
   | Code.SET (R a, R b, R c) -> Prim.set r.(b) r.(c) r.(a)
   | Code.LOC (R a, R b, el) -> r.(a) <- Prim.loc r.(b) el
   | Code.CON (R a, vtbl) -> r.(a) <- Value.make_obj vtbl
+  | Code.CAL (R a, R b, R c, args) ->
+    let obj, mthd = Prim.mthd r.(b) r.(c) in
+    let args = List.map (fun (Code.R i) -> r.(i)) args in
+    r.(a) <- call mthd obj args
   | Code.JMP b -> jmp fr b
   | Code.CBR (R a, b1, b2) ->
     jmp fr (if Value.truthy r.(a) then b1 else b2)
   | Code.RET ->
     fr.pc <- []
 
-let rec step fr =
+and call mthd self args =
+  match mthd with
+  | Code.Method { n_args; body } ->
+    if List.length args <> n_args then
+      runtime_error "wrong number of arguments, expected %d" n_args;
+    run body self (* args *)
+
+  | _ ->
+    Value.call mthd self args
+
+and step fr =
   match fr.pc with
   | [] -> ()
   | i :: rest ->
@@ -92,10 +106,11 @@ let rec step fr =
     exec fr i;
     step fr
 
-let run prog self =
+and run prog self (* args *) =
   let r = Array.make (Code.frame_size prog) Value.Nil in
   let fr = { r; pc = [] } in
   r.(0) <- self;
   jmp fr prog.entry;
   step fr;
   r.(0)
+