haxala1r
947d2274bb
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.
92 lines
2.8 KiB
OCaml
92 lines
2.8 KiB
OCaml
|
|
module Types = Types
|
|
open Types
|
|
|
|
|
|
let do_local state i f =
|
|
match List.nth_opt state.env i with
|
|
| None -> failwith "Invalid index for local access"
|
|
| Some x -> f x
|
|
let load_local state i =
|
|
do_local state i (!)
|
|
let set_local state i v =
|
|
do_local state i (fun r -> r := v)
|
|
|
|
let pop_one state =
|
|
match state.stack with
|
|
| v :: rest -> state.stack <- rest; v
|
|
| [] -> 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)
|
|
|
|
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
|
|
let arg = pop_one state in
|
|
let f = pop_one state in
|
|
match f with
|
|
| Closure (x, e) ->
|
|
state.call_stack <- (cur_i, cur_env) :: state.call_stack;
|
|
state.i <- x;
|
|
state.env <- (ref arg) :: e;
|
|
interpret state
|
|
| Native x ->
|
|
push state (Native.table.(x) arg);
|
|
interpret 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 (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
|
|
push state (Cons (car, cdr))
|
|
| Pop -> ignore (pop_one state) ; interpret state
|
|
| Apply -> do_apply state
|
|
| MakeClosure x -> push state (Closure (x, state.env)); interpret state
|
|
| Jump target -> state.i <- target ; interpret state
|
|
| JumpF target ->
|
|
(match (pop_one state) with
|
|
| Nil -> state.i <- target
|
|
| _ -> ()); interpret state
|
|
| End ->
|
|
(match state.call_stack with
|
|
| [] ->
|
|
print_endline "\nPROGRAM HAS SUCCESSFULLY TERMINATED"
|
|
| (old_i, old_env) :: rest ->
|
|
state.call_stack <- rest;
|
|
state.env <- old_env;
|
|
state.i <- old_i;
|
|
interpret state)
|
|
| NOOP -> interpret state)
|
|
|
|
let make_vm instrs constants global_count =
|
|
let globals = Array.init global_count (fun x -> if x < (Array.length Native.table) then Native x else Nil) in
|
|
{
|
|
i = 0;
|
|
instrs = instrs;
|
|
globals = globals;
|
|
constants = constants;
|
|
env = [];
|
|
stack = [];
|
|
call_stack = [];
|
|
}
|