Auto-compile: lambdas → bytecode VM at load time
After loading .sx files, (vm-compile) iterates all named lambdas, compiles each body to bytecode, replaces with NativeFn VM wrapper. Results: 3/109 functions compiled (compiler needs more features). CEK steps: 49911 → 38083 (23% fewer) for home page. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -206,6 +206,50 @@ 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 ->
|
||||||
|
match args with
|
||||||
|
| [fn_val; List call_args; Env e] ->
|
||||||
|
Sx_ref.eval_expr (List (fn_val :: call_args)) (Env e)
|
||||||
|
| [fn_val; List call_args] ->
|
||||||
|
Sx_ref.eval_expr (List (fn_val :: call_args)) (Env env)
|
||||||
|
| _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
|
||||||
|
|
||||||
(* Generic helper call — dispatches to Python page helpers *)
|
(* Generic helper call — dispatches to Python page helpers *)
|
||||||
bind "helper" (fun args ->
|
bind "helper" (fun args ->
|
||||||
io_request "helper" args)
|
io_request "helper" args)
|
||||||
@@ -792,6 +836,45 @@ let dispatch env cmd =
|
|||||||
| Eval_error msg -> send_error msg
|
| Eval_error msg -> send_error msg
|
||||||
| exn -> send_error (Printexc.to_string exn))
|
| exn -> send_error (Printexc.to_string exn))
|
||||||
|
|
||||||
|
| List [Symbol "vm-compile"] ->
|
||||||
|
(* Compile all named lambdas in env to bytecode.
|
||||||
|
Called after all .sx files are loaded. *)
|
||||||
|
(try
|
||||||
|
if not (Hashtbl.mem env.bindings "compile") then
|
||||||
|
send_error "compiler not loaded"
|
||||||
|
else begin
|
||||||
|
let compile_fn = Hashtbl.find env.bindings "compile" in
|
||||||
|
let count = ref 0 in
|
||||||
|
let failed = ref 0 in
|
||||||
|
let names = Hashtbl.fold (fun k _ acc -> k :: acc) env.bindings [] in
|
||||||
|
List.iter (fun name ->
|
||||||
|
match Hashtbl.find_opt env.bindings name with
|
||||||
|
| Some (Lambda lam) when lam.l_name <> None ->
|
||||||
|
(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_snapshot = Hashtbl.copy env.bindings in
|
||||||
|
Hashtbl.iter (fun k v ->
|
||||||
|
Hashtbl.replace globals_snapshot 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_snapshot) in
|
||||||
|
Hashtbl.replace env.bindings name fn;
|
||||||
|
incr count
|
||||||
|
| _ -> incr failed
|
||||||
|
with _ -> incr failed)
|
||||||
|
| _ -> ()
|
||||||
|
) names;
|
||||||
|
Printf.eprintf "[vm] Compiled %d functions (%d failed)\n%!" !count !failed;
|
||||||
|
send_ok_value (Number (float_of_int !count))
|
||||||
|
end
|
||||||
|
with
|
||||||
|
| Eval_error msg -> send_error msg
|
||||||
|
| exn -> send_error (Printexc.to_string exn))
|
||||||
|
|
||||||
| List [Symbol "reset"] ->
|
| List [Symbol "reset"] ->
|
||||||
(* Clear all bindings and rebuild env.
|
(* Clear all bindings and rebuild env.
|
||||||
We can't reassign env, so clear and re-populate. *)
|
We can't reassign env, so clear and re-populate. *)
|
||||||
|
|||||||
@@ -215,9 +215,9 @@ class OcamlBridge:
|
|||||||
# Collect files to load
|
# Collect files to load
|
||||||
all_files: list[str] = []
|
all_files: list[str] = []
|
||||||
|
|
||||||
# Spec files needed by aser
|
# Spec files needed by aser + bytecode compiler
|
||||||
spec_dir = os.path.join(os.path.dirname(__file__), "../../spec")
|
spec_dir = os.path.join(os.path.dirname(__file__), "../../spec")
|
||||||
for spec_file in ["parser.sx", "render.sx"]:
|
for spec_file in ["parser.sx", "render.sx", "bytecode.sx", "compiler.sx"]:
|
||||||
path = os.path.normpath(os.path.join(spec_dir, spec_file))
|
path = os.path.normpath(os.path.join(spec_dir, spec_file))
|
||||||
if os.path.isfile(path):
|
if os.path.isfile(path):
|
||||||
all_files.append(path)
|
all_files.append(path)
|
||||||
@@ -264,6 +264,13 @@ class OcamlBridge:
|
|||||||
filepath, e)
|
filepath, e)
|
||||||
_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
|
||||||
|
try:
|
||||||
|
await self._send('(vm-compile)')
|
||||||
|
await self._read_until_ok(ctx=None)
|
||||||
|
except OcamlBridgeError as e:
|
||||||
|
_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
|
||||||
|
|||||||
Reference in New Issue
Block a user