add GRT instruction and implement missing comparators

lib/compile/bcc.ml

@@ -40,15 +40,19 @@ let compile modl =
         | Ast.Add -> emit (ADD (ret, rhs))
         | Ast.Sub -> emit (SUB (ret, rhs))
         | Ast.Mul -> emit (MUL (ret, rhs))
+        | Ast.Div | Ast.Mod -> failwith "Bcc.compile_exp: TODO: div/mod"
         | Ast.Eql -> emit (EQL (ret, rhs))
         | Ast.Not_eql ->
             emit (EQL (ret, rhs));
             emit (NOT ret)
         | Ast.Lst -> emit (LST (ret, rhs))
-        | Ast.Grt_eql ->
+        | Ast.Lst_eql ->
             emit (LST (ret, rhs));
             emit (NOT ret)
-        | _ -> Fmt.failwith "Bcc.compile_exp: TODO: %S" (Ast.string_of_binop op));
+        | Ast.Grt -> emit (GRT (ret, rhs))
+        | Ast.Grt_eql ->
+            emit (LST (ret, rhs));
+            emit (NOT ret));
         Reg ret
     | Ast.If (cnd, e1, e2) ->
         let l1 = Code.make_basic_block [] in

lib/runtime/code.ml

@@ -23,6 +23,7 @@ and ins =
   | MUL of regidx * operand
   | EQL of regidx * operand
   | LST of regidx * operand
+  | GRT of regidx * operand
   | NOT of regidx
   | CON of regidx * Value.vtable
   | GET of regidx * regidx
@@ -58,8 +59,13 @@ let frame_size prog =
     | _ -> acc
   in
   let ins acc = function
-    | MOV (r, v) | ADD (r, v) | SUB (r, v) | MUL (r, v) | EQL (r, v) | LST (r, v) ->
-        op (reg acc r) v
+    | MOV (r, v)
+    | ADD (r, v)
+    | SUB (r, v)
+    | MUL (r, v)
+    | EQL (r, v)
+    | 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)
@@ -112,6 +118,7 @@ let pp_ins ~label ppf = function
   | MUL (l, r) -> Fmt.pf ppf "mul %a, %a" pp_reg l pp_operand r
   | EQL (l, r) -> Fmt.pf ppf "eql %a, %a" pp_reg l pp_operand r
   | LST (l, r) -> Fmt.pf ppf "lst %a, %a" pp_reg l pp_operand r
+  | 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
   | GET (o, s) -> Fmt.pf ppf "mov %a, %a[%a]" pp_reg s pp_reg o pp_reg s
@@ -128,13 +135,12 @@ let pp_program ppf pr =
   let basic_blocks = ref [ ep, "START" ] in
   let work_list = ref [ ep ] in
   let label bb =
-    match List.find (fun (bb', _) -> bb == bb') !basic_blocks with
-    | _, name -> name
-    | exception Not_found ->
-        let name = Fmt.str "L%d" (List.length !basic_blocks - 1) in
-        basic_blocks := (bb, name) :: !basic_blocks;
-        work_list := !work_list @ [ bb ];
-        name
+    try List.assq bb !basic_blocks
+    with Not_found ->
+      let name = Fmt.str "L%d" (List.length !basic_blocks - 1) in
+      basic_blocks := (bb, name) :: !basic_blocks;
+      work_list := !work_list @ [ bb ];
+      name
   in
   let rec loop i =
     match !work_list with

lib/runtime/interp.ml

@@ -26,6 +26,11 @@ 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 grt v1 v2 =
+    match v1, v2 with
+    | Value.Int x, Value.Int y -> Value.bool (Int64.compare x y > 0)
+    | _, _ -> raise (Runtime_error "cannot compare non integer values")
+
   let truthy = function
     | Value.False | Value.Nil -> false
     | _ -> true
@@ -70,6 +75,7 @@ let exec fr = function
   | Code.MUL (l, r) -> fr.regs.(l) <- Op.mul fr.regs.(l) (eval fr r)
   | Code.EQL (l, r) -> fr.regs.(l) <- Op.eql fr.regs.(l) (eval fr r)
   | Code.LST (l, r) -> fr.regs.(l) <- Op.lst fr.regs.(l) (eval fr r)
+  | 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.GET (o, s) -> fr.regs.(s) <- Op.get fr.regs.(o) fr.regs.(s)