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>

hosts/ocaml/bootstrap_vm.py

@@ -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",
 }

hosts/ocaml/sx_vm_ref.ml

@@ -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 =

lib/vm.sx

@@ -19,6 +19,14 @@
     vm-push-frame
     code-from-value
     vm-closure?
+    *active-vm*
+    *jit-compile-fn*
+    lambda?
+    lambda-compiled
+    lambda-set-compiled!
+    lambda-name
+    cek-call-or-suspend
+    try-jit-call
     vm-call
     frame-local-get
     frame-local-set
@@ -42,8 +50,8 @@
     vm-set-frames!
     vm-globals-ref
     collect-n-from-stack
-    pad-n-nils
     collect-n-pairs
+    pad-n-nils
     vm-global-get
     vm-resolve-ho-form
     vm-call-external
@@ -118,28 +126,12 @@
       (fn
         (vm closure args)
         (let
-          ((frame (make-vm-frame closure (get vm "sp"))))
+          ((frame (make-vm-frame closure (vm-sp vm))))
           (for-each (fn (a) (vm-push vm a)) args)
-          (let
-            ((arity (len args))
-              (total-locals (get (get closure "vm-code") "vc-locals")))
-            (let
-              ((pad-count (- total-locals arity)))
-              (when
-                (> pad-count 0)
-                (let
-                  ((i 0))
-                  (define
-                    pad-loop
-                    (fn
-                      ()
-                      (when
-                        (< i pad-count)
-                        (vm-push vm nil)
-                        (set! i (+ i 1))
-                        (pad-loop))))
-                  (pad-loop)))))
-          (dict-set! vm "frames" (cons frame (get vm "frames"))))))
+          (pad-n-nils
+            vm
+            (- (code-locals (closure-code closure)) (len args)))
+          (vm-set-frames! vm (cons frame (vm-frames vm))))))
     (define
       code-from-value
       (fn
@@ -157,6 +149,38 @@
               (arity (if (nil? arity-raw) 0 arity-raw)))
             (make-vm-code arity (+ arity 16) bc consts)))))
     (define vm-closure? (fn (v) (and (dict? v) (has-key? v "vm-code"))))
+    (define *active-vm* nil)
+    (define *jit-compile-fn* nil)
+    (define lambda? (fn (v) (= (type-of v) "lambda")))
+    (define lambda-compiled (fn (f) nil))
+    (define lambda-set-compiled! (fn (f val) nil))
+    (define lambda-name (fn (f) nil))
+    (define cek-call-or-suspend (fn (vm f args) (cek-call f args)))
+    (define
+      try-jit-call
+      (fn
+        (vm f args)
+        (let
+          ((compiled (lambda-compiled f)))
+          (cond
+            (vm-closure? compiled)
+            (vm-push vm (vm-call-closure compiled args (vm-globals-ref vm)))
+            (= compiled :jit-failed)
+            (vm-push vm (cek-call-or-suspend vm f args))
+            (and *jit-compile-fn* (lambda-name f))
+            (do
+              (lambda-set-compiled! f :jit-failed)
+              (let
+                ((result (*jit-compile-fn* f (vm-globals-ref vm))))
+                (if
+                  (vm-closure? result)
+                  (do
+                    (lambda-set-compiled! f result)
+                    (vm-push
+                      vm
+                      (vm-call-closure result args (vm-globals-ref vm))))
+                  (vm-push vm (cek-call-or-suspend vm f args)))))
+            :else (vm-push vm (cek-call-or-suspend vm f args))))))
     (define
       vm-call
       (fn
@@ -164,11 +188,10 @@
         (cond
           (vm-closure? f)
           (vm-push-frame vm f args)
-          (or
-            (= (type-of f) "lambda")
-            (= (type-of f) "component")
-            (= (type-of f) "island"))
-          (vm-push vm (cek-call f args))
+          (lambda? f)
+          (try-jit-call vm f args)
+          (or (= (type-of f) "component") (= (type-of f) "island"))
+          (vm-push vm (cek-call-or-suspend vm f args))
           (callable? f)
           (vm-push vm (apply f args))
           :else (error (str "VM: not callable: " (type-of f))))))
@@ -580,9 +603,11 @@
       (fn
         (closure args globals)
         (let
-          ((vm (make-vm globals)))
+          ((prev-vm *active-vm*) (vm (make-vm globals)))
+          (set! *active-vm* vm)
           (vm-push-frame vm closure args)
           (vm-run vm)
+          (set! *active-vm* prev-vm)
           (vm-pop vm))))
     (define
       vm-execute-module

shared/static/wasm/sx/vm.sx

@@ -19,6 +19,14 @@
     vm-push-frame
     code-from-value
     vm-closure?
+    *active-vm*
+    *jit-compile-fn*
+    lambda?
+    lambda-compiled
+    lambda-set-compiled!
+    lambda-name
+    cek-call-or-suspend
+    try-jit-call
     vm-call
     frame-local-get
     frame-local-set
@@ -42,8 +50,8 @@
     vm-set-frames!
     vm-globals-ref
     collect-n-from-stack
-    pad-n-nils
     collect-n-pairs
+    pad-n-nils
     vm-global-get
     vm-resolve-ho-form
     vm-call-external
@@ -118,28 +126,12 @@
       (fn
         (vm closure args)
         (let
-          ((frame (make-vm-frame closure (get vm "sp"))))
+          ((frame (make-vm-frame closure (vm-sp vm))))
           (for-each (fn (a) (vm-push vm a)) args)
-          (let
-            ((arity (len args))
-              (total-locals (get (get closure "vm-code") "vc-locals")))
-            (let
-              ((pad-count (- total-locals arity)))
-              (when
-                (> pad-count 0)
-                (let
-                  ((i 0))
-                  (define
-                    pad-loop
-                    (fn
-                      ()
-                      (when
-                        (< i pad-count)
-                        (vm-push vm nil)
-                        (set! i (+ i 1))
-                        (pad-loop))))
-                  (pad-loop)))))
-          (dict-set! vm "frames" (cons frame (get vm "frames"))))))
+          (pad-n-nils
+            vm
+            (- (code-locals (closure-code closure)) (len args)))
+          (vm-set-frames! vm (cons frame (vm-frames vm))))))
     (define
       code-from-value
       (fn
@@ -157,6 +149,38 @@
               (arity (if (nil? arity-raw) 0 arity-raw)))
             (make-vm-code arity (+ arity 16) bc consts)))))
     (define vm-closure? (fn (v) (and (dict? v) (has-key? v "vm-code"))))
+    (define *active-vm* nil)
+    (define *jit-compile-fn* nil)
+    (define lambda? (fn (v) (= (type-of v) "lambda")))
+    (define lambda-compiled (fn (f) nil))
+    (define lambda-set-compiled! (fn (f val) nil))
+    (define lambda-name (fn (f) nil))
+    (define cek-call-or-suspend (fn (vm f args) (cek-call f args)))
+    (define
+      try-jit-call
+      (fn
+        (vm f args)
+        (let
+          ((compiled (lambda-compiled f)))
+          (cond
+            (vm-closure? compiled)
+            (vm-push vm (vm-call-closure compiled args (vm-globals-ref vm)))
+            (= compiled :jit-failed)
+            (vm-push vm (cek-call-or-suspend vm f args))
+            (and *jit-compile-fn* (lambda-name f))
+            (do
+              (lambda-set-compiled! f :jit-failed)
+              (let
+                ((result (*jit-compile-fn* f (vm-globals-ref vm))))
+                (if
+                  (vm-closure? result)
+                  (do
+                    (lambda-set-compiled! f result)
+                    (vm-push
+                      vm
+                      (vm-call-closure result args (vm-globals-ref vm))))
+                  (vm-push vm (cek-call-or-suspend vm f args)))))
+            :else (vm-push vm (cek-call-or-suspend vm f args))))))
     (define
       vm-call
       (fn
@@ -164,11 +188,10 @@
         (cond
           (vm-closure? f)
           (vm-push-frame vm f args)
-          (or
-            (= (type-of f) "lambda")
-            (= (type-of f) "component")
-            (= (type-of f) "island"))
-          (vm-push vm (cek-call f args))
+          (lambda? f)
+          (try-jit-call vm f args)
+          (or (= (type-of f) "component") (= (type-of f) "island"))
+          (vm-push vm (cek-call-or-suspend vm f args))
           (callable? f)
           (vm-push vm (apply f args))
           :else (error (str "VM: not callable: " (type-of f))))))
@@ -580,9 +603,11 @@
       (fn
         (closure args globals)
         (let
-          ((vm (make-vm globals)))
+          ((prev-vm *active-vm*) (vm (make-vm globals)))
+          (set! *active-vm* vm)
           (vm-push-frame vm closure args)
           (vm-run vm)
+          (set! *active-vm* prev-vm)
           (vm-pop vm))))
     (define
       vm-execute-module