diff --git a/bin/main.ml b/bin/main.ml index 22d70a8..3c329fe 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -5,7 +5,7 @@ let[@warning "-26"] () = Logs.set_level (Some Logs.Debug); try - let ast = parse "val o = obj { val x = 3 }" in + let ast = parse "val ret = 1 + 1 == 2" in let prog = compile ast in let ret = run prog in Fmt.pr "{\"program\":%a,\"output\":%a}" Code.pp_program prog Value.pp ret diff --git a/lib/compile/bcc.ml b/lib/compile/bcc.ml index 42d8123..ea242aa 100644 --- a/lib/compile/bcc.ml +++ b/lib/compile/bcc.ml @@ -30,18 +30,25 @@ let compile modl = emit_mov ret (Code.cst_of_int slot); emit (GET (self, ret)); Reg ret) - | Ast.Binop (op, e1, e2) -> + | Ast.Binop (op, lhs, rhs) -> let ret = !sp in - let lhs = compile_exp env e1 in - let rhs = compile_exp env e2 in + let lhs = compile_exp env lhs in + let rhs = compile_exp env rhs in sp := ret + 1; emit_mov ret lhs; - emit - (match op with - | Ast.Add -> ADD (ret, rhs) - | Ast.Sub -> SUB (ret, rhs) - | Ast.Mul -> MUL (ret, rhs) - | _ -> Fmt.failwith "Bcc.compile_exp: TODO: %S" (Ast.string_of_binop op)); + (match op with + | Ast.Add -> emit (ADD (ret, rhs)) + | Ast.Sub -> emit (SUB (ret, rhs)) + | Ast.Mul -> emit (MUL (ret, rhs)) + | 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 -> + emit (LST (ret, rhs)); + emit (NOT ret) + | _ -> Fmt.failwith "Bcc.compile_exp: TODO: %S" (Ast.string_of_binop op)); Reg ret | Ast.Obj body -> compile_obj env body | _ -> failwith "Bcc.compile_exp: TODO" diff --git a/lib/runtime/code.ml b/lib/runtime/code.ml index f6dace5..e1c6bde 100644 --- a/lib/runtime/code.ml +++ b/lib/runtime/code.ml @@ -21,10 +21,14 @@ and ins = | ADD of regidx * operand | SUB of regidx * operand | MUL of regidx * operand + | EQL of regidx * operand + | LST of regidx * operand + | NOT of regidx | CON of regidx * Value.vtable | GET of regidx * regidx | SET of regidx * regidx | JMP of basic_block + | CBR of operand * basic_block * basic_block | RET let make_basic_block ins_list = { ins_builder = List.rev ins_list; ins_list } @@ -54,14 +58,15 @@ let frame_size prog = | _ -> acc in let ins acc = function - | MOV (r, v) | ADD (r, v) | SUB (r, v) | MUL (r, v) -> op (reg acc r) v - | CON (r, _) -> reg acc r + | MOV (r, v) | ADD (r, v) | SUB (r, v) | MUL (r, v) | EQL (r, v) | LST (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) - (* | BRT (v, b1, b2) -> *) - (* enqueue b1; *) - (* enqueue b2; *) - (* op acc v *) + | CBR (v, b1, b2) -> + enqueue b1; + enqueue b2; + op acc v | JMP b -> enqueue b; acc @@ -100,22 +105,26 @@ let pp_vtable ppf vt = vt.elems; Fmt.pf ppf "}" -let pp_ins ~get_bb_name ppf = function +let pp_ins ~label ppf = function | MOV (l, r) -> Fmt.pf ppf "mov %a, %a" pp_reg l pp_operand r | ADD (l, r) -> Fmt.pf ppf "add %a, %a" pp_reg l pp_operand r | SUB (l, r) -> Fmt.pf ppf "sub %a, %a" pp_reg l pp_operand r | 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 + | 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 | SET (o, s) -> Fmt.pf ppf "mov %a[%a], %a" pp_reg o pp_reg s pp_reg (s + 1) + | CBR (v, b1, b2) -> Fmt.pf ppf "cbr %a, %s, %s" pp_operand v (label b1) (label b2) | RET -> Fmt.pf ppf "ret" - | JMP l -> Fmt.pf ppf "jmp %s" (get_bb_name l) + | JMP l -> Fmt.pf ppf "jmp %s" (label l) let pp_program ppf pr = let ep = pr.entrypoint in let basic_blocks = ref [ ep, "START" ] in let work_list = ref [ ep ] in - let get_bb_name bb = + let label bb = match List.find (fun (bb', _) -> bb == bb') !basic_blocks with | _, name -> name | exception Not_found -> @@ -130,11 +139,11 @@ let pp_program ppf pr = | bb :: rest -> work_list := rest; if i > 0 then Fmt.pf ppf ","; - Fmt.pf ppf "%S:[" (get_bb_name bb); + 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 ~get_bb_name) is in + let str = Fmt.str "%a" (pp_ins ~label) is in Fmt.pf ppf "%S" str) (instructions bb); Fmt.pf ppf "]"; diff --git a/lib/runtime/interp.ml b/lib/runtime/interp.ml index 8619d28..31d29ff 100644 --- a/lib/runtime/interp.ml +++ b/lib/runtime/interp.ml @@ -16,6 +16,22 @@ module Op = struct | Value.Int x, Value.Int y -> Value.Int (Int64.mul x y) | _, _ -> raise (Runtime_error "cannot mul non integer values") + let eql v1 v2 = + match v1, v2 with + | Value.Int x, Value.Int y -> Value.bool (Int64.equal x y) + | _, _ -> Value.bool (v1 == v2) + + let lst 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 + + let not v = Value.bool (not (truthy v)) + let get o s = match o, s with | Value.Obj (_, slots), Value.Int i -> slots.(Int64.to_int i) @@ -52,11 +68,16 @@ let exec fr = function | 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) | 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.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) | Code.SET (o, s) -> Op.set fr.regs.(o) fr.regs.(s) fr.regs.(s + 1) | Code.RET -> fr.pc <- [] | 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) let rec run fr = match fr.pc with diff --git a/lib/runtime/value.ml b/lib/runtime/value.ml index b8f2c9b..1a36862 100644 --- a/lib/runtime/value.ml +++ b/lib/runtime/value.ml @@ -22,13 +22,12 @@ type t = | Int of int64 | Obj of vtable * t array -let equal v1 v2 = - match v1, v2 with - | Int x, Int y -> Int64.equal x y - | _, _ -> v1 == v2 - let make_obj vtable = Obj (vtable, Array.make vtable.n_slots Nil) +let bool = function + | true -> True + | false -> False + let rec pp ppf = function | Obj (vtable, slots) -> pp_obj ppf vtable slots | Int n -> Fmt.string ppf (Int64.to_string n)