Big changes:

Compiler and VM are now working well enough to support larger programs.
A test program is included and executed immediately upon running
the executable.

A more feature complete read-eval-print loop is planned.

lib/vm/native.ml

@@ -4,18 +4,9 @@
    here.
  *)
 open Types
+
 let builtin_print (v : Types.value) =
-  let p = Printf.sprintf in
-  let rec aux_print = function
-    | Int x -> p "%d" x
-    | Double x -> p "%f" x
-    | String x -> p "\"%s\"" x
-    | Nil -> p "'()"
-    | Cons (a, b) -> p "(%s . %s)" (aux_print a) (aux_print b)
-    | Symbol x -> p "'%s" x
-    | Closure (i, _) -> p "<closure %d>" i
-    | Native i -> p "<native %d>" i in
-  print_endline (aux_print v);
+  print_endline (print_value v);
   Types.Nil
 
 let table = [|

lib/vm/types.ml

@@ -39,6 +39,18 @@ type vm_state = {
 
 
 let p = Printf.sprintf 
+
+let rec print_value = function
+    | Int x -> p "%d" x
+    | Double x -> p "%f" x
+    | String x -> p "\"%s\"" x
+    | Nil -> p "'()"
+    | Cons (a, b) -> p "(%s . %s)" (print_value a) (print_value b)
+    | Symbol x -> p "'%s" x
+    | Closure (i, _) -> p "<closure %d>" i
+    | Native i -> p "<native %d>" i
+
+
 let print_one = function
     | Constant i -> p "CONSTANT %d\n" i
     | LoadLocal i -> p "LOCAL %d\n" i

lib/vm/vm.ml

@@ -20,6 +20,11 @@ let pop_one state =
 let push state v =
   state.stack <- (v :: state.stack)
 
+let trace state =
+  let stack () = List.fold_left (fun acc x -> acc ^ " " ^ (Types.print_value x)) "" state.stack in
+  let env () = List.fold_left (fun acc x -> acc ^ " " ^ (Types.print_value !x)) "" state.env in
+  Printf.printf "%d: \n\tstack: [%s ]\n\tenv:[%s]\n" state.i (stack ()) (env ())
+
 let rec do_apply state =
   let cur_env = state.env in
   let cur_i = state.i in
@@ -32,13 +37,11 @@ let rec do_apply state =
      state.env <- (ref arg) :: e;
      interpret state
   | Native x ->
-     push state (Native.table.(x) arg)
+     push state (Native.table.(x) arg);
+     interpret state
   | _ -> failwith "Cannot apply non-closure object"
 
 and interpret state =
-  (match state.stack with
-  | [] -> print_endline "empty"
-  | _ -> print_endline "nonempty");
   let i = state.i in
   state.i <- i + 1;
   (match state.instrs.(i) with
@@ -62,7 +65,7 @@ and interpret state =
   | End ->
      (match state.call_stack with
      | [] ->
-        print_endline "\nPROGRAM HAS SUCCESSFULLY TERMINATED\n"
+        print_endline "\nPROGRAM HAS SUCCESSFULLY TERMINATED"
      | (old_i, old_env) :: rest ->
         state.call_stack <- rest;
         state.env <- old_env;