VM auto-compile infrastructure + disable until compiler is complete
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) <noreply@anthropic.com>
This commit is contained in:
@@ -206,42 +206,6 @@ let setup_io_env env =
|
|||||||
| [key] -> io_request "ctx" [key]
|
| [key] -> io_request "ctx" [key]
|
||||||
| _ -> raise (Eval_error "ctx: expected 1 arg"));
|
| _ -> 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 ->
|
bind "call-lambda" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [fn_val; List call_args; Env e] ->
|
| [fn_val; List call_args; Env e] ->
|
||||||
@@ -859,13 +823,22 @@ let dispatch env cmd =
|
|||||||
let globals_snapshot = Hashtbl.copy env.bindings in
|
let globals_snapshot = Hashtbl.copy env.bindings in
|
||||||
Hashtbl.iter (fun k v ->
|
Hashtbl.iter (fun k v ->
|
||||||
Hashtbl.replace globals_snapshot k v) lam.l_closure.bindings;
|
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 ->
|
let fn = NativeFn ("vm:" ^ name, fun args ->
|
||||||
Sx_vm.execute_closure
|
try
|
||||||
{ Sx_vm.code; name = lam.l_name } args globals_snapshot) in
|
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;
|
Hashtbl.replace env.bindings name fn;
|
||||||
incr count
|
incr count
|
||||||
| _ -> incr failed
|
| _ -> 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;
|
) names;
|
||||||
Printf.eprintf "[vm] Compiled %d functions (%d failed)\n%!" !count !failed;
|
Printf.eprintf "[vm] Compiled %d functions (%d failed)\n%!" !count !failed;
|
||||||
|
|||||||
@@ -529,6 +529,17 @@ let () =
|
|||||||
match args with [Dict d] -> List (dict_keys d) | _ -> raise (Eval_error "keys: 1 dict"));
|
match args with [Dict d] -> List (dict_keys d) | _ -> raise (Eval_error "keys: 1 dict"));
|
||||||
register "vals" (fun args ->
|
register "vals" (fun args ->
|
||||||
match args with [Dict d] -> List (dict_vals d) | _ -> raise (Eval_error "vals: 1 dict"));
|
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 ->
|
register "dict-set!" (fun args ->
|
||||||
match args with
|
match args with
|
||||||
| [Dict d; String k; v] -> dict_set d k v; v
|
| [Dict d; String k; v] -> dict_set d k v; v
|
||||||
|
|||||||
@@ -265,12 +265,11 @@ class OcamlBridge:
|
|||||||
_logger.info("Loaded %d definitions from .sx files into OCaml kernel (%d skipped)",
|
_logger.info("Loaded %d definitions from .sx files into OCaml kernel (%d skipped)",
|
||||||
count, skipped)
|
count, skipped)
|
||||||
|
|
||||||
# Auto-compile all lambdas to bytecode VM
|
# Auto-compile disabled for now — compiler needs more features
|
||||||
try:
|
# (closures, scope ops, etc.) before it can safely replace
|
||||||
await self._send('(vm-compile)')
|
# live functions. Infrastructure is ready:
|
||||||
await self._read_until_ok(ctx=None)
|
# await self._send('(vm-compile)')
|
||||||
except OcamlBridgeError as e:
|
# await self._read_until_ok(ctx=None)
|
||||||
_logger.warning("VM compilation skipped: %s", e)
|
|
||||||
except Exception as e:
|
except Exception as e:
|
||||||
_logger.error("Failed to load .sx files into OCaml kernel: %s", e)
|
_logger.error("Failed to load .sx files into OCaml kernel: %s", e)
|
||||||
self._components_loaded = False # retry next time
|
self._components_loaded = False # retry next time
|
||||||
|
|||||||
@@ -19,7 +19,7 @@
|
|||||||
|
|
||||||
(define make-pool
|
(define make-pool
|
||||||
(fn ()
|
(fn ()
|
||||||
{:entries (list)
|
{:entries (if (primitive? "mutable-list") (mutable-list) (list))
|
||||||
:index {:_count 0}}))
|
:index {:_count 0}}))
|
||||||
|
|
||||||
(define pool-add
|
(define pool-add
|
||||||
@@ -92,7 +92,7 @@
|
|||||||
|
|
||||||
(define make-emitter
|
(define make-emitter
|
||||||
(fn ()
|
(fn ()
|
||||||
{:bytecode (list) ;; list of bytes
|
{:bytecode (if (primitive? "mutable-list") (mutable-list) (list))
|
||||||
:pool (make-pool)}))
|
:pool (make-pool)}))
|
||||||
|
|
||||||
(define emit-byte
|
(define emit-byte
|
||||||
|
|||||||
Reference in New Issue
Block a user