vm.sx feature parity: JIT dispatch, active VM tracking, CEK fallback
Add missing features to lib/vm.sx that sx_vm.ml has: - *active-vm* mutable global for HO primitive callback VM reuse - *jit-compile-fn* platform-settable JIT compilation hook - try-jit-call: check lambda-compiled, attempt JIT, fallback to CEK - vm-call: VmClosure→push-frame, Lambda→try-jit, Component→CEK - vm-call-closure: save/restore *active-vm* around execution - vm-push-frame: refactored to use accessor functions - cek-call-or-suspend: preamble-provided CEK interop Transpiled output (sx_vm_ref.ml) now has 12 functions (was 9): *active-vm*, *jit-compile-fn*, try-jit-call, vm-call, vm-resolve-ho-form, vm-call-external, env-walk, env-walk-set!, vm-run, vm-step, vm-call-closure, vm-execute-module 48 preamble functions (native OCaml type access). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -70,6 +70,10 @@ SKIP = {
|
||||
# Complex native ops
|
||||
"vm-push-frame", "code-from-value", "vm-closure?",
|
||||
"vm-create-closure",
|
||||
# Lambda accessors (native type)
|
||||
"lambda?", "lambda-compiled", "lambda-set-compiled!", "lambda-name",
|
||||
# CEK interop
|
||||
"cek-call-or-suspend",
|
||||
# Collection helpers (use mutable state + recursion)
|
||||
"collect-n-from-stack", "collect-n-pairs", "pad-n-nils",
|
||||
}
|
||||
|
||||
@@ -137,9 +137,21 @@ let pad_n_nils vm n = Nil
|
||||
|
||||
|
||||
(* === Transpiled from lib/vm.sx === *)
|
||||
(* *active-vm* *)
|
||||
let rec _active_vm_ =
|
||||
Nil
|
||||
|
||||
(* *jit-compile-fn* *)
|
||||
and _jit_compile_fn_ =
|
||||
Nil
|
||||
|
||||
(* try-jit-call *)
|
||||
and try_jit_call vm f args =
|
||||
(let compiled = (lambda_compiled (f)) in (if sx_truthy ((vm_closure_p (compiled))) then (vm_push (vm) ((vm_call_closure (compiled) (args) ((vm_globals_ref (vm)))))) else (if sx_truthy ((prim_call "=" [compiled; (String "jit-failed")])) then (vm_push (vm) ((cek_call_or_suspend (vm) (f) (args)))) else (if sx_truthy ((let _and = _jit_compile_fn_ in if not (sx_truthy _and) then _and else (lambda_name (f)))) then (let () = ignore ((lambda_set_compiled_b (f) ((String "jit-failed")))) in (let result' = (_jit_compile_fn_ (f) ((vm_globals_ref (vm)))) in (if sx_truthy ((vm_closure_p (result'))) then (let () = ignore ((lambda_set_compiled_b (f) (result'))) in (vm_push (vm) ((vm_call_closure (result') (args) ((vm_globals_ref (vm))))))) else (vm_push (vm) ((cek_call_or_suspend (vm) (f) (args))))))) else (vm_push (vm) ((cek_call_or_suspend (vm) (f) (args))))))))
|
||||
|
||||
(* vm-call *)
|
||||
let rec vm_call vm f args =
|
||||
(if sx_truthy ((vm_closure_p (f))) then (vm_push_frame (vm) (f) (args)) else (if sx_truthy ((let _or = (prim_call "=" [(type_of (f)); (String "lambda")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [(type_of (f)); (String "component")]) in if sx_truthy _or then _or else (prim_call "=" [(type_of (f)); (String "island")])))) then (vm_push (vm) ((cek_call (f) (args)))) else (if sx_truthy ((is_callable (f))) then (vm_push (vm) ((sx_apply f args))) else (raise (Eval_error (value_to_str (String (sx_str [(String "VM: not callable: "); (type_of (f))]))))))))
|
||||
and vm_call vm f args =
|
||||
(if sx_truthy ((vm_closure_p (f))) then (vm_push_frame (vm) (f) (args)) else (if sx_truthy ((is_lambda (f))) then (try_jit_call (vm) (f) (args)) else (if sx_truthy ((let _or = (prim_call "=" [(type_of (f)); (String "component")]) in if sx_truthy _or then _or else (prim_call "=" [(type_of (f)); (String "island")]))) then (vm_push (vm) ((cek_call_or_suspend (vm) (f) (args)))) else (if sx_truthy ((is_callable (f))) then (vm_push (vm) ((sx_apply f args))) else (raise (Eval_error (value_to_str (String (sx_str [(String "VM: not callable: "); (type_of (f))])))))))))
|
||||
|
||||
(* vm-resolve-ho-form *)
|
||||
and vm_resolve_ho_form vm name =
|
||||
@@ -167,7 +179,7 @@ and vm_step vm frame rest_frames bc consts =
|
||||
|
||||
(* vm-call-closure *)
|
||||
and vm_call_closure closure args globals =
|
||||
(let vm = (make_vm (globals)) in (let () = ignore ((vm_push_frame (vm) (closure) (args))) in (let () = ignore ((vm_run (vm))) in (vm_pop (vm)))))
|
||||
let _active_vm_ = ref Nil in (let prev_vm = !_active_vm_ in let vm = (make_vm (globals)) in (let () = ignore ((_active_vm_ := vm; Nil)) in (let () = ignore ((vm_push_frame (vm) (closure) (args))) in (let () = ignore ((vm_run (vm))) in (let () = ignore ((_active_vm_ := prev_vm; Nil)) in (vm_pop (vm)))))))
|
||||
|
||||
(* vm-execute-module *)
|
||||
and vm_execute_module code globals =
|
||||
|
||||
Reference in New Issue
Block a user