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:
@@ -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 ->
|
||||
|
||||
Reference in New Issue
Block a user