vm: got the VM to finally actually work

lib/compiler/emit.ml

@@ -104,11 +104,21 @@ let backpatch_one p (i, b) =
   Dynarray.set p.instrs i (Instr (MakeClosure (current_index p)));
   let* _ = compile_one p b in
   emit_instr p End
-let backpatch p =
+let rec backpatch p =
   if Queue.is_empty p.backpatch then
     Ok ()
-  else backpatch_one p (Queue.pop p.backpatch)
+  else
+    (let* _ = backpatch_one p (Queue.pop p.backpatch) in
+     backpatch p)
 
+
+let print_instr = function
+  | Instr i -> Vm.Types.print_one i
+  | BackPatchJumpF ->  "BACKPATCH JUMPF\n"
+  | BackPatchMkClosure -> "BACKPATCH CLOSURE\n"
+let print_instrs =
+  Array.mapi_inplace (fun i ins ->
+    print_endline (Printf.sprintf "%d: %s" i (print_instr ins)); ins)
 let smooth_one = function
   | Instr i -> i
   | _ -> failwith "backpatching process was not complete!"
@@ -123,6 +133,12 @@ let compile (exprs : expression list) (tbl : int SymbolTable.t) =
       backpatch=Queue.create ();
     } in
   let* _ = compile_all program exprs in
+  let* _ = emit_instr program End in
   let* _ = backpatch program in
   let final_instrs = smooth_instrs program in
-  Ok (Vm.Types.make_vm final_instrs (Dynarray.to_array program.constants) (SymbolTable.cardinal tbl))
+  print_endline (string_of_int (SymbolTable.cardinal tbl));
+  Ok (Vm.make_vm final_instrs (Dynarray.to_array program.constants) ((SymbolTable.cardinal tbl) + 1))
+
+let compile_src src =
+  let* (exprs, tbl) = Scope_analysis.of_src src in
+  compile exprs tbl

lib/compiler/scope_analysis.ml

@@ -66,7 +66,7 @@ let default_global_table =
    be kept at runtime.
  *)
 let extract_globals (top : Core_ast.top_level list) =
-  let id_counter = (ref (-1)) in
+  let id_counter = (ref (SymbolTable.cardinal default_global_table)) in
   let id () =
     id_counter := !id_counter + 1; !id_counter in
   let rec aux tbl = function
@@ -156,7 +156,7 @@ let convert program =
        let tbl = SymbolTable.add s (SymbolTable.find s global_tbl) tbl in
        (analyze tbl [] (Set (s, e))) :: (aux tbl rest)
   in
-  let* program = traverse (fun x -> x) (aux SymbolTable.empty program) in
+  let* program = traverse (fun x -> x) (aux default_global_table program) in
   Ok (program, global_tbl)
 
 let of_src src =