module Ast = Spice_syntax.Ast
module Code = Spice_runtime.Code
module Value = Spice_runtime.Value
module Env = Map.Make (String)

type binding = {
  self : Code.regidx;
  slot : Value.slotidx;
}

let compile modl =
  let ep = Code.make_basic_block [] in
  let sp = ref 0 in
  let bb = ref ep in

  let emit is = Code.add_ins !bb is in
  let emit_mov lhs rhs = if rhs <> Code.Reg lhs then emit (MOV (lhs, rhs)) in

  let rec compile_exp env = function
    | Ast.Literal Nil -> Code.Cst_nil
    | Ast.Literal True -> Code.Cst_true
    | Ast.Literal False -> Code.Cst_false
    | Ast.Literal (Int i) -> Code.Cst_int i
    | Ast.Path (Var name) -> (
        match Env.find name env with
        | exception Not_found -> Fmt.failwith "unbound: %S" name
        | { self; slot } ->
            let ret = !sp in
            sp := ret + 1;
            emit_mov ret (Code.cst_of_int slot);
            emit (GET (self, ret));
            Reg ret)
    | Ast.Binop (op, lhs, rhs) ->
        let ret = !sp in
        let lhs = compile_exp env lhs in
        emit_mov ret lhs;
        sp := ret + 1;
        let rhs = compile_exp env rhs in
        (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"
  and compile_obj env items =
    let self = !sp in

    (* construct new env and vtable *)
    let elems = Hashtbl.create (List.length items * 2) in
    let env, n_slots =
      List.fold_left
        (fun (env, n) -> function
          | Ast.Item_fun (_, _, _) | Ast.Item_exp _ -> env, n
          | Ast.Item_obj (name, _) | Ast.Item_val (name, _) ->
              let slot = n in
              let env = Env.add name { self; slot } env in
              Hashtbl.add elems name (Value.Field slot);
              env, n + 1)
        (env, 0)
        items
    in
    let vtable = Value.{ elems; n_slots } in

    (* emit constructor / field inits *)
    emit (CON (self, vtable));
    let emit_set name rhs =
      let slot = (Env.find name env).slot in
      emit_mov (self + 2) rhs;
      emit_mov (self + 1) (Code.cst_of_int slot);
      emit (SET (self, self + 1))
    in
    List.iter
      (function
        | Ast.Item_fun (_, _, _) -> failwith "Bcc: unsupported: methods"
        | Ast.Item_exp e ->
            sp := self + 1;
            ignore (compile_exp env e)
        | Ast.Item_obj (name, body) ->
            sp := self + 2;
            emit_set name (compile_obj env body)
        | Ast.Item_val (name, rhs) ->
            sp := self + 2;
            emit_set name (compile_exp env rhs))
      items;

    (* reset sp and return self *)
    sp := self + 1;
    Code.Reg self
  in

  let env = Env.empty in
  emit_mov 0 (compile_obj env modl.Ast.items);
  emit RET;
  Code.make_program ep