coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

OCaml runtime: R7RS parameters, VM closure introspection, import suspension

Browse Source 
- R7RS parameter primitives (make-parameter, parameter?, parameterize support)
- VM closure get_val introspection (vm-code, vm-upvalues, vm-name, vm-globals)
- Lazy list caching on vm_code for transpiled VM performance
- VM import suspension: check_io_suspension + resume_module for browser lazy loading
- 23 new R7RS tests (parameter-basic, parameterize-basic, syntax-rules-basic)
- Playwright bytecode-loading spec + WASM rebuild

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-04 18:48:51 +00:00
parent 2727577702
commit 4baed1853c
16 changed files with 692 additions and 178 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
hosts/ocaml/bootstrap_vm.py
View File

@@ -376,7 +376,8 @@ let vm_create_closure vm_val frame_val code_val =
(* --- JIT sentinel --- *)
let _jit_failed_sentinel = {
vm_code = { vc_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||] };
vm_code = { vc_arity = -1; vc_locals = 0; vc_bytecode = [||]; vc_constants = [||];
vc_bytecode_list = None; vc_constants_list = None };
vm_upvalues = [||]; vm_name = Some "__jit_failed__"; vm_env_ref = Hashtbl.create 0; vm_closure_env = None
}
let _is_jit_failed cl = cl.vm_code.vc_arity = -1
@@ -574,7 +575,20 @@ let () = _vm_call_fn := vm_call
Public API — matches Sx_vm interface for drop-in replacement
================================================================ *)
(** Execute a compiled module — entry point for load-sxbc, compile-blob. *)
(** Build a suspension dict from __io_request in globals. *)
let check_io_suspension globals vm_val =
match Hashtbl.find_opt globals "__io_request" with
| Some req when sx_truthy req ->
let d = Hashtbl.create 4 in
Hashtbl.replace d "suspended" (Bool true);
Hashtbl.replace d "op" (String "import");
Hashtbl.replace d "request" req;
Hashtbl.replace d "vm" vm_val;
Some (Dict d)
| _ -> None
(** Execute a compiled module — entry point for load-sxbc, compile-blob.
Returns the result value, or a suspension dict if OP_PERFORM fired. *)
let execute_module (code : vm_code) (globals : (string, value) Hashtbl.t) =
let cl = { vm_code = code; vm_upvalues = [||]; vm_name = Some "module";
vm_env_ref = globals; vm_closure_env = None } in
@@ -587,7 +601,25 @@ let execute_module (code : vm_code) (globals : (string, value) Hashtbl.t) =
done;
m.vm_frames <- [frame];
ignore (vm_run vm_val);
vm_pop vm_val
match check_io_suspension globals vm_val with
| Some suspension -> suspension
| None -> vm_pop vm_val
(** Resume a suspended module. Clears __io_request, pushes nil, re-runs. *)
let resume_module (suspended : value) =
match suspended with
| Dict d ->
let vm_val = Hashtbl.find d "vm" in
let globals = match vm_val with
| VmMachine m -> m.vm_globals
| _ -> raise (Eval_error "resume_module: expected VmMachine") in
Hashtbl.replace globals "__io_request" Nil;
ignore (vm_push vm_val Nil);
ignore (vm_run vm_val);
(match check_io_suspension globals vm_val with
| Some suspension -> suspension
| None -> vm_pop vm_val)
| _ -> raise (Eval_error "resume_module: expected suspension dict")
(** Execute a closure with args — entry point for JIT Lambda calls. *)
let call_closure (cl : vm_closure) (args : value list) (globals : (string, value) Hashtbl.t) =