From 5ca2ee92bc099426076d0cd42a40b62ed01abcfd Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 19 Mar 2026 19:30:54 +0000 Subject: [PATCH] VM auto-compile infrastructure + disable until compiler is complete MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Added vm-compile command: iterates env, compiles lambdas to bytecode, replaces with NativeFn VM wrappers (with CEK fallback on error). Tested: 3/109 compile, reduces CEK steps 23%. Disabled auto-compile in production — the compiler doesn't handle closures with upvalues yet, and compiled functions that reference dynamic env vars crash. Infrastructure stays for when compiler handles all SX features. Also: added set-nth! and mutable-list primitives (needed by compiler.sx for bytecode patching). Fixed compiler.sx to use mutable lists on OCaml (ListRef for append!/set-nth! mutation). Co-Authored-By: Claude Opus 4.6 (1M context) --- hosts/ocaml/bin/sx_server.ml | 51 ++++++++------------------------ hosts/ocaml/lib/sx_primitives.ml | 11 +++++++ shared/sx/ocaml_bridge.py | 11 ++++--- spec/compiler.sx | 4 +-- 4 files changed, 30 insertions(+), 47 deletions(-) diff --git a/hosts/ocaml/bin/sx_server.ml b/hosts/ocaml/bin/sx_server.ml index fe12ae5..05347b2 100644 --- a/hosts/ocaml/bin/sx_server.ml +++ b/hosts/ocaml/bin/sx_server.ml @@ -206,42 +206,6 @@ let setup_io_env env = | [key] -> io_request "ctx" [key] | _ -> raise (Eval_error "ctx: expected 1 arg")); - (* ---- VM auto-compilation ---- *) - (* After all .sx files are loaded, compile top-level lambdas to bytecode. - Called from the load handler after each file. *) - let vm_compile_count = ref 0 in - let vm_compile_env () = - if not (Hashtbl.mem env.bindings "compile") then () - else begin - let compile_fn = Hashtbl.find env.bindings "compile" in - let to_compile = Hashtbl.fold (fun name value acc -> - match value with - | Lambda lam when lam.l_name <> None -> (name, lam) :: acc - | _ -> acc - ) env.bindings [] in - List.iter (fun (name, lam) -> - (try - let quoted = List [Symbol "quote"; lam.l_body] in - let result = Sx_ref.eval_expr (List [compile_fn; quoted]) (Env env) in - match result with - | Dict d when Hashtbl.mem d "bytecode" -> - let code = Sx_vm.code_from_value result in - let globals = Hashtbl.create 256 in - Hashtbl.iter (fun k v -> Hashtbl.replace globals k v) env.bindings; - Hashtbl.iter (fun k v -> Hashtbl.replace globals k v) lam.l_closure.bindings; - let fn = NativeFn ("vm:" ^ name, fun args -> - Sx_vm.execute_closure { Sx_vm.code; name = lam.l_name } args globals) in - Hashtbl.replace env.bindings name fn; - incr vm_compile_count - | _ -> () - with _ -> () (* silently skip compilation failures *)) - ) to_compile; - if !vm_compile_count > 0 then - Printf.eprintf "[vm] Compiled %d functions to bytecode\n%!" !vm_compile_count - end - in - ignore vm_compile_env; (* suppress unused warning — called from load handler *) - bind "call-lambda" (fun args -> match args with | [fn_val; List call_args; Env e] -> @@ -859,13 +823,22 @@ let dispatch env cmd = let globals_snapshot = Hashtbl.copy env.bindings in Hashtbl.iter (fun k v -> Hashtbl.replace globals_snapshot k v) lam.l_closure.bindings; + (* VM closure with CEK fallback on error *) + let orig_lambda = Lambda lam in let fn = NativeFn ("vm:" ^ name, fun args -> - Sx_vm.execute_closure - { Sx_vm.code; name = lam.l_name } args globals_snapshot) in + try + Sx_vm.execute_closure + { Sx_vm.code; name = lam.l_name } args globals_snapshot + with _ -> + (* Fall back to CEK machine *) + Sx_ref.cek_call orig_lambda (List args)) in Hashtbl.replace env.bindings name fn; incr count | _ -> incr failed - with _ -> incr failed) + with e -> + if !failed < 5 then + Printf.eprintf "[vm] FAIL %s: %s\n%!" name (Printexc.to_string e); + incr failed) | _ -> () ) names; Printf.eprintf "[vm] Compiled %d functions (%d failed)\n%!" !count !failed; diff --git a/hosts/ocaml/lib/sx_primitives.ml b/hosts/ocaml/lib/sx_primitives.ml index 8c1fc95..0eedfd4 100644 --- a/hosts/ocaml/lib/sx_primitives.ml +++ b/hosts/ocaml/lib/sx_primitives.ml @@ -529,6 +529,17 @@ let () = match args with [Dict d] -> List (dict_keys d) | _ -> raise (Eval_error "keys: 1 dict")); register "vals" (fun args -> match args with [Dict d] -> List (dict_vals d) | _ -> raise (Eval_error "vals: 1 dict")); + register "mutable-list" (fun _args -> ListRef (ref [])); + register "set-nth!" (fun args -> + match args with + | [ListRef r; Number n; v] -> + let i = int_of_float n in + let l = !r in + r := List.mapi (fun j x -> if j = i then v else x) l; + Nil + | [List _; _; _] -> + raise (Eval_error "set-nth!: list is immutable, use ListRef") + | _ -> raise (Eval_error "set-nth!: expected (list idx val)")); register "dict-set!" (fun args -> match args with | [Dict d; String k; v] -> dict_set d k v; v diff --git a/shared/sx/ocaml_bridge.py b/shared/sx/ocaml_bridge.py index 9111fdb..da17dd5 100644 --- a/shared/sx/ocaml_bridge.py +++ b/shared/sx/ocaml_bridge.py @@ -265,12 +265,11 @@ class OcamlBridge: _logger.info("Loaded %d definitions from .sx files into OCaml kernel (%d skipped)", count, skipped) - # Auto-compile all lambdas to bytecode VM - try: - await self._send('(vm-compile)') - await self._read_until_ok(ctx=None) - except OcamlBridgeError as e: - _logger.warning("VM compilation skipped: %s", e) + # Auto-compile disabled for now — compiler needs more features + # (closures, scope ops, etc.) before it can safely replace + # live functions. Infrastructure is ready: + # await self._send('(vm-compile)') + # await self._read_until_ok(ctx=None) except Exception as e: _logger.error("Failed to load .sx files into OCaml kernel: %s", e) self._components_loaded = False # retry next time diff --git a/spec/compiler.sx b/spec/compiler.sx index 301b642..3aed1e2 100644 --- a/spec/compiler.sx +++ b/spec/compiler.sx @@ -19,7 +19,7 @@ (define make-pool (fn () - {:entries (list) + {:entries (if (primitive? "mutable-list") (mutable-list) (list)) :index {:_count 0}})) (define pool-add @@ -92,7 +92,7 @@ (define make-emitter (fn () - {:bytecode (list) ;; list of bytes + {:bytecode (if (primitive? "mutable-list") (mutable-list) (list)) :pool (make-pool)})) (define emit-byte