VM upvalues + HO primitives + 40 tests (36 pass, 4 fail)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-03-19 20:41:23 +00:00
parent 1bb40415a8
commit e7da397f8e
5 changed files with 432 additions and 8 deletions

View File

@@ -214,6 +214,16 @@ let setup_io_env env =
Sx_ref.eval_expr (List (fn_val :: call_args)) (Env env)
| _ -> raise (Eval_error "call-lambda: expected (fn args env?)"));
(* Register HO forms as callable NativeFn — the CEK machine handles them
as special forms, but the VM needs them as callable values in globals. *)
let ho_via_cek name =
bind name (fun args ->
Sx_ref.eval_expr (List (Symbol name :: args)) (Env env))
in
List.iter ho_via_cek [
"map"; "map-indexed"; "filter"; "reduce"; "some"; "every?"; "for-each";
];
(* Generic helper call — dispatches to Python page helpers *)
bind "helper" (fun args ->
io_request "helper" args)
@@ -626,6 +636,14 @@ let make_server_env () =
(* IO primitives *)
setup_io_env env;
(* Initialize trampoline ref so HO primitives (map, filter, etc.)
can call SX lambdas. Must be done here (not sx_runtime.ml)
because Sx_ref is only available at the binary level. *)
Sx_primitives._sx_trampoline_fn := (fun v ->
match v with
| Thunk (body, closure_env) -> Sx_ref.eval_expr body (Env closure_env)
| other -> other);
env
@@ -733,7 +751,7 @@ let dispatch env cmd =
(try
ignore (env_bind env "expand-components?" (NativeFn ("expand-components?", fun _args -> Bool true)));
(* Enable batch IO mode *)
io_batch_mode := true; Sx_ref._cek_steps := 0;
io_batch_mode := true;
io_queue := [];
io_counter := 0;
let exprs = Sx_parser.parse_all src in
@@ -758,8 +776,8 @@ let dispatch env cmd =
(* Flush batched IO: send requests, receive responses, replace placeholders *)
let final = flush_batched_io result_str in
let t2 = Unix.gettimeofday () in
Printf.eprintf "[aser-slot] eval=%.1fs io_flush=%.1fs batched=%d result=%d chars cek_steps=%d\n%!"
(t1 -. t0) (t2 -. t1) n_batched (String.length final) !Sx_ref._cek_steps;
Printf.eprintf "[aser-slot] eval=%.1fs io_flush=%.1fs batched=%d result=%d chars\n%!"
(t1 -. t0) (t2 -. t1) n_batched (String.length final);
send (Printf.sprintf "(ok-raw %s)" final)
with
| Eval_error msg ->