vm: modified StoreLocal and StoreGlobal logic to be more consistent with the rest of the VM,

and modified the emit module to emit a Pop instruction after every top-level expression.

This change was required because the semantics of the language are pretty clear.
Every expression evaluates to something - meaning that, in the corresponding bytecode,
every expression must have exactly a +1 effect on the data stack. I.e. every expression,
when its corresponding bytecode is evaluated, has the effect of pushing something
to the stack. For values that are not used by another expression, this value
must be immediately popped.

Some optimizations could target this area. For example, for top-level expressions,
it is obvious to the compiler that their values will not be used - hence the compiler
can use optimized versions of some instructions (like StoreLocal and StoreGlobal)
to simply never leave the value on the stack, thus saving an extra Pop instruction
(good for performance and code size).

Same thing applies in function bodies, letrec/let/begin bodies, where expressions
whose values are never used may appear.

It may also make sense to introduce registers to the VM, for the purposes of
parameter passing (such that up to a predetermined number of parameters are
progressively passed through registers instead of pushed to the stack).
This would pair well with eliminating unnecessary currying in the byte code.

lib/compiler/emit.ml

@@ -95,7 +95,10 @@ let rec compile_one p = function
      compile_one p (Begin (e2 :: rest))
 
 and compile_all p exprs =
-  Util.traverse (compile_one p) exprs
+  Util.traverse
+    (fun e ->
+      let* _ = compile_one p e in
+      emit_instr p Pop) exprs
 
 (* Once we have compiled the top-level expressions, we must now compile
    all of the lambdas we held off on. Some of these will hold more

lib/vm/vm.ml

@@ -15,7 +15,11 @@ let set_local state i v =
 let pop_one state =
   match state.stack with
   | v :: rest -> state.stack <- rest; v
-  | [] -> failwith ("VM error: cannot pop from empty stack! " ^ (string_of_int state.i))
+  | [] -> failwith ("VM error: cannot pop from empty stack! " )
+let peek_one state =
+  match state.stack with
+  | v :: _ -> v
+  | [] -> failwith ("VM error: cannot peek on empty stack! " )
 
 let push state v =
   state.stack <- (v :: state.stack)
@@ -42,14 +46,15 @@ let rec do_apply state =
   | _ -> failwith "Cannot apply non-closure object"
 
 and interpret state =
+  trace state;
   let i = state.i in
   state.i <- i + 1;
   (match state.instrs.(i) with
   | Constant x -> push state state.constants.(x) ; interpret state
   | LoadLocal x -> push state (load_local state x) ; interpret state
   | LoadGlobal x -> push state state.globals.(x) ; interpret state
-  | StoreLocal x -> set_local state x (pop_one state) ; interpret state
-  | StoreGlobal x -> Array.set state.globals x (pop_one state) ; interpret state
+  | StoreLocal x -> set_local state x (peek_one state) ; interpret state
+  | StoreGlobal x -> Array.set state.globals x (peek_one state) ; interpret state
   | MakeCons ->
      let cdr = pop_one state in
      let car = pop_one state in