Initial

README.md

@@ -0,0 +1,30 @@
+# sequence
+
+A stackless bytecode interpreter implemented in OCaml using CPS.
+
+ All control flow is expressed through explicit continuations rather than the OCaml call to ensure stack safety through a trampoline
+
+## Continuation Representation
+
+Continuations are represented as a recursive type:
+
+```ocaml
+type continuation =
+  | Halt
+  | Return_to of continuation
+  | Apply_to of { func : value; cont : continuation }
+  | Eval_to of { expr : instruction; cont : continuation }
+  | Pop_to of { n : int; cont : continuation }
+  | Exception_to of { handler : continuation; cont : continuation }
+```
+
+Each continuation represents "what to do next" after the current computation completes
+
+Exception continuations enable structured error handling
+
+## Building/Running
+
+```bash
+dune build
+dune exec sequence
+```

bin/main.ml

@@ -0,0 +1,204 @@
+open Sequence
+
+let example_program =
+  [|
+    Instr.PUSH (Instr.Int 5);
+    Instr.PUSH (Instr.Int 3);
+    Instr.ADD;
+    Instr.DUP;
+    Instr.PUSH (Instr.Int 2);
+    Instr.MUL;
+    Instr.ADD;
+    Instr.HALT;
+  |]
+
+let arithmetic_program =
+  [|
+    Instr.PUSH (Instr.Int 10);
+    Instr.PUSH (Instr.Int 7);
+    Instr.SUB;
+    Instr.PUSH (Instr.Int 2);
+    Instr.MUL;
+    Instr.HALT;
+  |]
+
+let conditional_program =
+  [|
+    Instr.PUSH (Instr.Int 5);
+    Instr.PUSH (Instr.Int 3);
+    Instr.LT;
+    Instr.JMP_IF 2;
+    Instr.PUSH (Instr.Int 100);
+    Instr.JMP 1;
+    Instr.PUSH (Instr.Int 200);
+    Instr.HALT;
+  |]
+
+let comparison_program =
+  [|
+    Instr.PUSH (Instr.Int 10);
+    Instr.PUSH (Instr.Int 5);
+    Instr.GT;
+    Instr.PUSH (Instr.Int 5);
+    Instr.PUSH (Instr.Int 10);
+    Instr.LE;
+    Instr.AND;
+    Instr.HALT;
+  |]
+
+let division_program =
+  [|
+    Instr.PUSH (Instr.Int 20);
+    Instr.PUSH (Instr.Int 4);
+    Instr.DIV;
+    Instr.PUSH (Instr.Int 3);
+    Instr.MOD;
+    Instr.HALT;
+  |]
+
+let stack_ops_program =
+  [|
+    Instr.PUSH (Instr.Int 1);
+    Instr.PUSH (Instr.Int 2);
+    Instr.PUSH (Instr.Int 3);
+    Instr.ROT;
+    Instr.SWAP;
+    Instr.OVER;
+    Instr.ADD;
+    Instr.HALT;
+  |]
+
+let logical_program =
+  [|
+    Instr.PUSH (Instr.Bool true);
+    Instr.PUSH (Instr.Bool false);
+    Instr.OR;
+    Instr.PUSH (Instr.Bool true);
+    Instr.AND;
+    Instr.NOT;
+    Instr.HALT;
+  |]
+
+let negation_program =
+  [|
+    Instr.PUSH (Instr.Int 42);
+    Instr.NEG;
+    Instr.PUSH (Instr.Int 10);
+    Instr.ADD;
+    Instr.HALT;
+  |]
+
+let closure_program =
+  [|
+    Instr.PUSH (Instr.Int 100);
+    Instr.MK_CLOSURE 10;
+    Instr.CALL;
+    Instr.HALT;
+    Instr.PUSH (Instr.Int 200);
+    Instr.RET;
+  |]
+
+let exception_program =
+  [|
+    Instr.TRY 3;
+    Instr.PUSH (Instr.Int 42);
+    Instr.PUSH (Instr.Int 0);
+    Instr.DIV;
+    Instr.HALT;
+    Instr.POP;
+    Instr.PUSH (Instr.Int 999);
+    Instr.HALT;
+  |]
+
+let complex_program =
+  [|
+    Instr.PUSH (Instr.Int 15);
+    Instr.PUSH (Instr.Int 3);
+    Instr.DIV;
+    Instr.DUP;
+    Instr.PUSH (Instr.Int 2);
+    Instr.MUL;
+    Instr.SWAP;
+    Instr.ADD;
+    Instr.PUSH (Instr.Int 10);
+    Instr.GT;
+    Instr.JMP_IF 2;
+    Instr.PUSH (Instr.Int 0);
+    Instr.JMP 1;
+    Instr.PUSH (Instr.Int 1);
+    Instr.HALT;
+  |]
+
+let run_test name program expected =
+  Printf.printf "Test: %s\n" name;
+  match Vm.execute_program program with
+  | Vm.Success (Some (Instr.Int result)) ->
+    if result = expected then
+      Printf.printf "  ✓ Pass: %d (expected %d)\n\n" result expected
+    else
+      Printf.printf "  ✗ Fail: got %d, expected %d\n\n" result expected
+  | Vm.Success (Some (Instr.Bool result)) ->
+    Printf.printf "  Result: %b\n\n" result
+  | Vm.Success None ->
+    Printf.printf "  ✗ Fail: No result\n\n"
+  | Vm.Failure e ->
+    Printf.printf "  ✗ Error: %s\n\n" (State.show_error e)
+
+let run_trace_test name program =
+  Printf.printf "Trace test: %s\n" name;
+  let result, trace = Vm.execute_with_trace program in
+  (match result with
+   | Vm.Success (Some (Instr.Int n)) ->
+     Printf.printf "  Result: %d\n" n
+   | Vm.Success (Some (Instr.Bool b)) ->
+     Printf.printf "  Result: %b\n" b
+   | Vm.Success None ->
+     Printf.printf "  Result: None\n"
+   | Vm.Failure e ->
+     Printf.printf "  Error: %s\n" (State.show_error e));
+  Printf.printf "  Trace entries: %d\n" (List.length trace);
+  if List.length trace > 0 then
+    (let last = List.hd (List.rev trace) in
+     Printf.printf "  Final: pc=%d, stack_len=%d, cont_depth=%d\n"
+       last.Trampoline.pc last.Trampoline.stack_len last.Trampoline.cont_depth);
+  Printf.printf "\n"
+
+let () =
+  run_test "Basic arithmetic" example_program 24;
+  run_test "Subtraction and multiplication" arithmetic_program 6;
+  run_test "Conditional branching" conditional_program 200;
+  run_test "Comparison operations" comparison_program 1;
+  run_test "Division and modulo" division_program 2;
+  run_test "Stack operations" stack_ops_program 5;
+  run_test "Logical operations" logical_program 0;
+  run_test "Negation" negation_program (-32);
+  run_test "Complex expression" complex_program 1;
+  
+  let invalid_jump = [|
+    Instr.PUSH (Instr.Int 1);
+    Instr.JMP 1000;
+    Instr.HALT;
+  |] in
+  let errors = Vm.validate invalid_jump in
+  Printf.printf "Invalid jump validation: %d errors found\n" (List.length errors);
+  List.iter (fun (pc, err) ->
+    Printf.printf "  PC %d: %s\n" pc (State.show_error err))
+    errors;
+  Printf.printf "\n";
+  
+  let disasm = Vm.disassemble example_program in
+  List.iter (fun (pc, instr) ->
+    Printf.printf "  %d: %s\n" pc instr)
+    disasm;
+  Printf.printf "\n";
+  
+  run_trace_test "Traced execution" arithmetic_program;
+  
+  match Vm.execute_program exception_program with
+  | Vm.Success (Some (Instr.Int n)) ->
+    Printf.printf "Exception caught, result: %d\n" n
+  | Vm.Success None ->
+    Printf.printf "Exception caught, no result\n"
+  | Vm.Failure e ->
+    Printf.printf "Exception not caught: %s\n" (State.show_error e);
+  Printf.printf "\n"

dune

@@ -0,0 +1,12 @@
+(executable
+ (public_name sequence)
+ (name main)
+ (libraries sequence)
+ (package sequence))
+
+(library
+ (name sequence)
+ (public_name sequence)
+ (modules instr state cont step trampoline vm))
+
+

dune-project

@@ -0,0 +1,9 @@
+(lang dune 3.0)
+
+(name sequence)
+
+(package
+ (name sequence)
+ (depends ocaml))
+
+

lib/cont.ml

@@ -0,0 +1,54 @@
+open Instr
+
+type t = continuation
+
+let halt = Halt
+
+let return_to cont = Return_to cont
+
+let apply_to func cont = Apply_to { func; cont }
+
+let eval_to expr cont = Eval_to { expr; cont }
+
+let pop_to n cont = Pop_to { n; cont }
+
+let exception_to handler cont = Exception_to { handler; cont }
+
+let rec build_cont instructions cont =
+  match instructions with
+  | [] -> cont
+  | instr :: rest ->
+    eval_to instr (build_cont rest cont)
+
+let apply_cont k v : (t * value option) option =
+  match k with
+  | Halt -> None
+  | Return_to k' -> Some (k', Some v)
+  | Apply_to { func; cont } ->
+    (match func with
+     | Closure { code; env } ->
+       Some (Eval_to { expr = Instr.LOAD code; cont }, Some v)
+     | _ -> None)
+  | Eval_to { expr; cont } ->
+    Some (cont, Some v)
+  | Pop_to { n; cont } ->
+    Some (cont, Some v)
+  | Exception_to { handler; cont } ->
+    Some (handler, Some v)
+
+let rec depth = function
+  | Halt -> 0
+  | Return_to k -> 1 + depth k
+  | Apply_to { cont; _ } -> 1 + depth cont
+  | Eval_to { cont; _ } -> 1 + depth cont
+  | Pop_to { cont; _ } -> 1 + depth cont
+  | Exception_to { cont; _ } -> 1 + depth cont
+
+let rec show_cont k =
+  match k with
+  | Halt -> "Halt"
+  | Return_to k' -> Printf.sprintf "Return_to(%s)" (show_cont k')
+  | Apply_to { func; cont } -> Printf.sprintf "Apply_to(%s, %s)" (show_value func) (show_cont cont)
+  | Eval_to { expr; cont } -> Printf.sprintf "Eval_to(%s, %s)" (show expr) (show_cont cont)
+  | Pop_to { n; cont } -> Printf.sprintf "Pop_to(%d, %s)" n (show_cont cont)
+  | Exception_to { handler; cont } -> Printf.sprintf "Exception_to(%s, %s)" (show_cont handler) (show_cont cont)

lib/instr.ml

@@ -0,0 +1,113 @@
+type value =
+  | Int of int
+  | Closure of { code : int; env : value list }
+  | Continuation of continuation
+  | Bool of bool
+
+and continuation =
+  | Halt
+  | Return_to of continuation
+  | Apply_to of { func : value; cont : continuation }
+  | Eval_to of { expr : t; cont : continuation }
+  | Pop_to of { n : int; cont : continuation }
+  | Exception_to of { handler : continuation; cont : continuation }
+
+and t =
+  | PUSH of value
+  | POP
+  | DUP
+  | SWAP
+  | OVER
+  | ROT
+  | ADD
+  | SUB
+  | MUL
+  | DIV
+  | MOD
+  | EQ
+  | NE
+  | LT
+  | LE
+  | GT
+  | GE
+  | AND
+  | OR
+  | NOT
+  | NEG
+  | JMP of int
+  | JMP_IF of int
+  | JMP_IF_NOT of int
+  | CALL
+  | RET
+  | MK_CLOSURE of int
+  | LOAD of int
+  | STORE of int
+  | PUSH_ENV
+  | POP_ENV
+  | HALT
+  | TRY of int
+  | RAISE
+  | RERAISE
+
+let show_value = function
+  | Int n -> Printf.sprintf "Int(%d)" n
+  | Bool b -> Printf.sprintf "Bool(%b)" b
+  | Closure { code; env } -> Printf.sprintf "Closure(code=%d, env_len=%d)" code (List.length env)
+  | Continuation _ -> "Continuation"
+
+let show_continuation = function
+  | Halt -> "Halt"
+  | Return_to _ -> "Return_to"
+  | Apply_to _ -> "Apply_to"
+  | Eval_to _ -> "Eval_to"
+  | Pop_to _ -> "Pop_to"
+  | Exception_to _ -> "Exception_to"
+
+let show = function
+  | PUSH v -> Printf.sprintf "PUSH %s" (show_value v)
+  | POP -> "POP"
+  | DUP -> "DUP"
+  | SWAP -> "SWAP"
+  | OVER -> "OVER"
+  | ROT -> "ROT"
+  | ADD -> "ADD"
+  | SUB -> "SUB"
+  | MUL -> "MUL"
+  | DIV -> "DIV"
+  | MOD -> "MOD"
+  | EQ -> "EQ"
+  | NE -> "NE"
+  | LT -> "LT"
+  | LE -> "LE"
+  | GT -> "GT"
+  | GE -> "GE"
+  | AND -> "AND"
+  | OR -> "OR"
+  | NOT -> "NOT"
+  | NEG -> "NEG"
+  | JMP offset -> Printf.sprintf "JMP %d" offset
+  | JMP_IF offset -> Printf.sprintf "JMP_IF %d" offset
+  | JMP_IF_NOT offset -> Printf.sprintf "JMP_IF_NOT %d" offset
+  | CALL -> "CALL"
+  | RET -> "RET"
+  | MK_CLOSURE code -> Printf.sprintf "MK_CLOSURE %d" code
+  | LOAD idx -> Printf.sprintf "LOAD %d" idx
+  | STORE idx -> Printf.sprintf "STORE %d" idx
+  | PUSH_ENV -> "PUSH_ENV"
+  | POP_ENV -> "POP_ENV"
+  | HALT -> "HALT"
+  | TRY offset -> Printf.sprintf "TRY %d" offset
+  | RAISE -> "RAISE"
+  | RERAISE -> "RERAISE"
+
+let int_of_value = function
+  | Int n -> Some n
+  | Bool true -> Some 1
+  | Bool false -> Some 0
+  | _ -> None
+
+let bool_of_value = function
+  | Bool b -> Some b
+  | Int 0 -> Some false
+  | Int n -> Some (n <> 0)
+  | _ -> None

lib/state.ml

@@ -0,0 +1,79 @@
+type error =
+  | StackUnderflow
+  | InvalidIndex of int
+  | TypeMismatch of string
+  | DivisionByZero
+  | InvalidJump of int
+  | InvalidClosure
+  | NoExceptionHandler
+
+type 'a result = Ok of 'a | Error of error
+
+type t = {
+  pc : int;
+  stack : Instr.value list;
+  code : Instr.t array;
+  env : Instr.value list;
+  env_stack : Instr.value list list;
+  exception_value : Instr.value option;
+}
+
+let create code = {
+  pc = 0;
+  stack = [];
+  code;
+  env = [];
+  env_stack = [];
+  exception_value = None;
+}
+
+let with_pc state pc = { state with pc }
+let with_stack state stack = { state with stack }
+let with_env state env = { state with env }
+let with_exception state exn = { state with exception_value = Some exn }
+let clear_exception state = { state with exception_value = None }
+
+let push state v = { state with stack = v :: state.stack }
+
+let pop state = match state.stack with
+  | [] -> Error StackUnderflow
+  | v :: rest -> Ok (v, { state with stack = rest })
+
+let pop_n state n =
+  if n < 0 then Error (InvalidIndex n)
+  else if n = 0 then Ok ([], state)
+  else
+    let rec aux acc n = function
+      | [] when n > 0 -> Error StackUnderflow
+      | rest when n = 0 -> Ok (List.rev acc, { state with stack = rest })
+      | v :: rest -> aux (v :: acc) (n - 1) rest
+    in
+    aux [] n state.stack
+
+let peek state = match state.stack with
+  | [] -> Error StackUnderflow
+  | v :: _ -> Ok v
+
+let push_env state =
+  { state with env_stack = state.env :: state.env_stack }
+
+let pop_env state = match state.env_stack with
+  | [] -> Error StackUnderflow
+  | env :: rest -> Ok ({ state with env = env; env_stack = rest })
+
+let get_env state = state.env
+
+let set_env state env = { state with env }
+
+let show state =
+  Printf.sprintf "State(pc=%d, stack_len=%d, env_len=%d, env_stack_len=%d)"
+    state.pc (List.length state.stack) (List.length state.env) (List.length state.env_stack)
+
+let show_error = function
+  | StackUnderflow -> "StackUnderflow"
+  | InvalidIndex i -> Printf.sprintf "InvalidIndex(%d)" i
+  | TypeMismatch s -> Printf.sprintf "TypeMismatch(%s)" s
+  | DivisionByZero -> "DivisionByZero"
+  | InvalidJump i -> Printf.sprintf "InvalidJump(%d)" i
+  | InvalidClosure -> "InvalidClosure"
+  | NoExceptionHandler -> "NoExceptionHandler"

lib/step.ml

@@ -0,0 +1,361 @@
+open Instr
+
+type result =
+  | Continue of { state : State.t; cont : Cont.t }
+  | Halted of value option
+  | Error of State.error
+
+let step state cont : result =
+  if state.pc >= Array.length state.code then
+    Halted None
+  else
+    let instr = state.code.(state.pc) in
+    let next_pc = state.pc + 1 in
+    let next_state = State.with_pc state next_pc in
+    
+    match instr with
+    | PUSH v ->
+      let new_state = State.push next_state v in
+      Continue { state = new_state; cont }
+    
+    | POP ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (_, new_state) ->
+         Continue { state = new_state; cont })
+    
+    | DUP ->
+      (match State.peek next_state with
+       | State.Error e -> Error e
+       | State.Ok v ->
+         let new_state = State.push next_state v in
+         Continue { state = new_state; cont })
+    
+    | SWAP ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([a; b], new_state) ->
+         let new_state = State.push (State.push new_state a) b in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "SWAP"))
+    
+    | OVER ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([a; b], new_state) ->
+         let new_state = State.push (State.push new_state b) a in
+         let new_state = State.push new_state b in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "OVER"))
+    
+    | ROT ->
+      (match State.pop_n next_state 3 with
+       | State.Error e -> Error e
+       | State.Ok ([a; b; c], new_state) ->
+         let new_state = State.push (State.push (State.push new_state a) c) b in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "ROT"))
+    
+    | ADD ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (a + b)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "ADD"))
+    
+    | SUB ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (a - b)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "SUB"))
+    
+    | MUL ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (a * b)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "MUL"))
+    
+    | DIV ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int 0], _) -> Error State.DivisionByZero
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (a / b)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "DIV"))
+    
+    | MOD ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int 0], _) -> Error State.DivisionByZero
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (a mod b)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "MOD"))
+    
+    | EQ ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (if a = b then 1 else 0)) in
+         Continue { state = new_state; cont }
+       | State.Ok ([Bool a; Bool b], new_state) ->
+         let new_state = State.push new_state (Bool (a = b)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "EQ"))
+    
+    | NE ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (if a <> b then 1 else 0)) in
+         Continue { state = new_state; cont }
+       | State.Ok ([Bool a; Bool b], new_state) ->
+         let new_state = State.push new_state (Bool (a <> b)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "NE"))
+    
+    | LT ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (if a < b then 1 else 0)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "LT"))
+    
+    | LE ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (if a <= b then 1 else 0)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "LE"))
+    
+    | GT ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (if a > b then 1 else 0)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "GT"))
+    
+    | GE ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([Int a; Int b], new_state) ->
+         let new_state = State.push new_state (Int (if a >= b then 1 else 0)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "GE"))
+    
+    | AND ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([a; b], new_state) ->
+         (match (bool_of_value a, bool_of_value b) with
+          | (Some a', Some b') ->
+            let new_state = State.push new_state (Bool (a' && b')) in
+            Continue { state = new_state; cont }
+          | _ -> Error (State.TypeMismatch "AND")))
+    
+    | OR ->
+      (match State.pop_n next_state 2 with
+       | State.Error e -> Error e
+       | State.Ok ([a; b], new_state) ->
+         (match (bool_of_value a, bool_of_value b) with
+          | (Some a', Some b') ->
+            let new_state = State.push new_state (Bool (a' || b')) in
+            Continue { state = new_state; cont }
+          | _ -> Error (State.TypeMismatch "OR")))
+    
+    | NOT ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (v, new_state) ->
+         (match bool_of_value v with
+          | Some b ->
+            let new_state = State.push new_state (Bool (not b)) in
+            Continue { state = new_state; cont }
+          | None -> Error (State.TypeMismatch "NOT")))
+    
+    | NEG ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (Int n, new_state) ->
+         let new_state = State.push new_state (Int (-n)) in
+         Continue { state = new_state; cont }
+       | State.Ok _ -> Error (State.TypeMismatch "NEG"))
+    
+    | JMP offset ->
+      let new_pc = next_state.pc + offset - 1 in
+      if new_pc < 0 || new_pc >= Array.length state.code then
+        Error (State.InvalidJump new_pc)
+      else
+        let new_state = State.with_pc next_state new_pc in
+        Continue { state = new_state; cont }
+    
+    | JMP_IF offset ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (v, new_state) ->
+         (match bool_of_value v with
+          | Some true ->
+            let new_pc = new_state.pc + offset - 1 in
+            if new_pc < 0 || new_pc >= Array.length state.code then
+              Error (State.InvalidJump new_pc)
+            else
+              let new_state = State.with_pc new_state new_pc in
+              Continue { state = new_state; cont }
+          | Some false ->
+            Continue { state = new_state; cont }
+          | None -> Error (State.TypeMismatch "JMP_IF")))
+    
+    | JMP_IF_NOT offset ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (v, new_state) ->
+         (match bool_of_value v with
+          | Some false ->
+            let new_pc = new_state.pc + offset - 1 in
+            if new_pc < 0 || new_pc >= Array.length state.code then
+              Error (State.InvalidJump new_pc)
+            else
+              let new_state = State.with_pc new_state new_pc in
+              Continue { state = new_state; cont }
+          | Some true ->
+            Continue { state = new_state; cont }
+          | None -> Error (State.TypeMismatch "JMP_IF_NOT")))
+    
+    | CALL ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (func, new_state) ->
+         (match func with
+          | Closure { code; env } ->
+            let new_state = State.push_env new_state in
+            let new_state = State.set_env new_state env in
+            let new_pc = code in
+            if new_pc < 0 || new_pc >= Array.length state.code then
+              Error (State.InvalidJump new_pc)
+            else
+              let new_state = State.with_pc new_state new_pc in
+              let new_cont = Cont.return_to cont in
+              Continue { state = new_state; cont = new_cont }
+          | _ -> Error State.InvalidClosure))
+    
+    | RET ->
+      (match State.pop_env next_state with
+       | State.Error _ ->
+         (match cont with
+          | Return_to k ->
+            Continue { state = next_state; cont = k }
+          | Halt ->
+            Halted (match State.peek next_state with State.Ok v -> Some v | _ -> None)
+          | _ ->
+            Halted (match State.peek next_state with State.Ok v -> Some v | _ -> None))
+       | State.Ok (new_state, _) ->
+         (match cont with
+          | Return_to k ->
+            Continue { state = new_state; cont = k }
+          | Halt ->
+            Halted (match State.peek new_state with State.Ok v -> Some v | _ -> None)
+          | _ ->
+            Halted (match State.peek new_state with State.Ok v -> Some v | _ -> None)))
+    
+    | MK_CLOSURE code ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (env_val, new_state) ->
+         let env = match env_val with
+           | Closure { env; _ } -> env
+           | _ -> State.get_env new_state
+         in
+         let closure = Closure { code; env } in
+         let new_state = State.push new_state closure in
+         Continue { state = new_state; cont })
+    
+    | LOAD idx ->
+      if idx < 0 || idx >= List.length next_state.env then
+        Error (State.InvalidIndex idx)
+      else
+        let v = List.nth next_state.env idx in
+        let new_state = State.push next_state v in
+        Continue { state = new_state; cont }
+    
+    | STORE idx ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (v, new_state) ->
+         let env = new_state.env in
+         let env' = if idx < List.length env then
+             let rec update i = function
+               | [] -> []
+               | x :: xs -> if i = idx then v :: xs else x :: update (i + 1) xs
+             in update 0 env
+           else
+             let padding = List.init (idx - List.length env) (fun _ -> Int 0) in
+             env @ padding @ [v]
+         in
+         let new_state = State.set_env new_state env' in
+         Continue { state = new_state; cont })
+    
+    | PUSH_ENV ->
+      let new_state = State.push_env next_state in
+      Continue { state = new_state; cont }
+    
+    | POP_ENV ->
+      (match State.pop_env next_state with
+       | State.Error e -> Error e
+       | State.Ok (new_state, _) ->
+         Continue { state = new_state; cont })
+    
+    | TRY offset ->
+      let handler_pc = next_state.pc + offset - 1 in
+      if handler_pc < 0 || handler_pc >= Array.length state.code then
+        Error (State.InvalidJump handler_pc)
+      else
+        let handler_cont = Cont.eval_to (state.code.(handler_pc)) Cont.halt in
+        let new_cont = Cont.exception_to handler_cont cont in
+        Continue { state = next_state; cont = new_cont }
+    
+    | RAISE ->
+      (match State.pop next_state with
+       | State.Error e -> Error e
+       | State.Ok (exn_val, new_state) ->
+         let new_state = State.with_exception new_state exn_val in
+         let rec find_handler = function
+           | Exception_to { handler; cont } ->
+             let new_state = State.clear_exception new_state in
+             let new_state = State.push new_state exn_val in
+             Continue { state = new_state; cont = handler }
+           | Return_to k -> find_handler k
+           | Apply_to { cont; _ } -> find_handler cont
+           | Eval_to { cont; _ } -> find_handler cont
+           | Pop_to { cont; _ } -> find_handler cont
+           | Halt -> Error State.NoExceptionHandler
+         in
+         find_handler cont)
+    
+    | RERAISE ->
+      (match next_state.exception_value with
+       | None -> Error State.NoExceptionHandler
+       | Some exn_val ->
+         let rec find_handler = function
+           | Exception_to { handler; cont } ->
+             let new_state = State.clear_exception new_state in
+             let new_state = State.push new_state exn_val in
+             Continue { state = new_state; cont = handler }
+           | Return_to k -> find_handler k
+           | Apply_to { cont; _ } -> find_handler cont
+           | Eval_to { cont; _ } -> find_handler cont
+           | Pop_to { cont; _ } -> find_handler cont
+           | Halt -> Error State.NoExceptionHandler
+         in
+         find_handler cont)
+    
+    | HALT ->
+      Halted (match State.peek next_state with State.Ok v -> Some v | _ -> None)

lib/trampoline.ml

@@ -0,0 +1,63 @@
+open Step
+
+type thunk = unit -> result
+
+type trace_entry = {
+  pc : int;
+  stack_len : int;
+  cont_depth : int;
+}
+
+type config = {
+  max_steps : int option;
+  trace : bool;
+  trace_entries : trace_entry list ref;
+}
+
+let default_config = {
+  max_steps = None;
+  trace = false;
+  trace_entries = ref [];
+}
+
+let rec run ?(config = default_config) thunk =
+  match config.max_steps with
+  | Some max when max <= 0 -> None
+  | Some max -> run_with_limit ~config max thunk
+  | None -> run_unlimited ~config thunk
+
+and run_unlimited ~config thunk =
+  match thunk () with
+  | Continue { state; cont } ->
+    (if config.trace then
+       config.trace_entries := {
+         pc = state.pc;
+         stack_len = List.length state.stack;
+         cont_depth = Cont.depth cont;
+       } :: !(config.trace_entries));
+    run_unlimited ~config (fun () -> step state cont)
+  | Halted v -> Some v
+  | Error e -> None
+
+and run_with_limit ~config max_steps thunk =
+  let rec aux steps thunk =
+    if steps >= max_steps then
+      None
+    else
+      match thunk () with
+      | Continue { state; cont } ->
+        (if config.trace then
+           config.trace_entries := {
+             pc = state.pc;
+             stack_len = List.length state.stack;
+             cont_depth = Cont.depth cont;
+           } :: !(config.trace_entries));
+        aux (steps + 1) (fun () -> step state cont)
+      | Halted v -> Some v
+      | Error e -> None
+  in
+  aux 0 thunk
+
+let get_trace config = List.rev !(config.trace_entries)
+
+let clear_trace config = config.trace_entries := []

lib/vm.ml

@@ -0,0 +1,62 @@
+open Instr
+open State
+open Cont
+open Step
+open Trampoline
+
+type t = {
+  code : Instr.t array;
+  initial_state : State.t;
+}
+
+type execution_result =
+  | Success of value option
+  | Failure of State.error
+  | Timeout
+
+let create code =
+  let state = State.create code in
+  { code; initial_state = state }
+
+let execute ?(config = Trampoline.default_config) vm =
+  let state = vm.initial_state in
+  let cont = Cont.halt in
+  match Trampoline.run ~config (fun () -> step state cont) with
+  | Some v -> Success v
+  | None -> Failure NoExceptionHandler
+
+let execute_with_limit vm max_steps =
+  let config = { Trampoline.default_config with max_steps = Some max_steps } in
+  execute ~config vm
+
+let execute_program ?(config = Trampoline.default_config) code =
+  let vm = create code in
+  execute ~config vm
+
+let execute_program_with_limit code max_steps =
+  let vm = create code in
+  execute_with_limit vm max_steps
+
+let execute_with_trace code =
+  let config = { Trampoline.default_config with trace = true } in
+  let result = execute_program ~config code in
+  (result, Trampoline.get_trace config)
+
+let disassemble code =
+  Array.mapi (fun i instr -> (i, Instr.show instr)) code
+  |> Array.to_list
+
+let validate code =
+  let errors = ref [] in
+  Array.iteri (fun i instr ->
+    match instr with
+    | JMP offset | JMP_IF offset | JMP_IF_NOT offset | TRY offset ->
+      let target = i + 1 + offset - 1 in
+      if target < 0 || target >= Array.length code then
+        errors := (i, State.InvalidJump target) :: !errors
+    | MK_CLOSURE code_addr ->
+      if code_addr < 0 || code_addr >= Array.length code then
+        errors := (i, State.InvalidJump code_addr) :: !errors
+    | _ -> ())
+    code;
+  List.rev !errors