diff --git a/lib/compile/bcc.ml b/lib/compile/bcc.ml index ad62b11..67c6d72 100644 --- a/lib/compile/bcc.ml +++ b/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 diff --git a/lib/runtime/code.ml b/lib/runtime/code.ml index 60ea167..324fdbb 100644 --- a/lib/runtime/code.ml +++ b/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 diff --git a/lib/runtime/interp.ml b/lib/runtime/interp.ml index 31d29ff..851cffb 100644 --- a/lib/runtime/interp.ml +++ b/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)