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

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

hosts/ocaml/bin/sx_server.ml

@@ -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 ->

hosts/ocaml/lib/sx_primitives.ml

@@ -7,6 +7,12 @@ open Sx_types
 
 let primitives : (string, value list -> value) Hashtbl.t = Hashtbl.create 128
 
+(** Forward refs for calling SX functions from primitives (breaks cycle). *)
+let _sx_call_fn : (value -> value list -> value) ref =
+  ref (fun _ _ -> raise (Eval_error "sx_call not initialized"))
+let _sx_trampoline_fn : (value -> value) ref =
+  ref (fun v -> v)
+
 let register name fn = Hashtbl.replace primitives name fn
 
 let is_primitive name = Hashtbl.mem primitives name
@@ -590,4 +596,34 @@ let () =
       List.iter (fun (k, v) -> dict_set d k v) pairs;
       Dict d
     | _ -> raise (Eval_error "spread-attrs: 1 spread"));
+
+  (* Higher-order forms as callable primitives — used by the VM.
+     The CEK machine handles these as special forms with dedicated frames;
+     the VM needs them as plain callable values. *)
+  (* Call any SX callable — handles NativeFn, Lambda (via trampoline), VM closures *)
+  let call_any f args =
+    match f with
+    | NativeFn (_, fn) -> fn args
+    | _ -> !_sx_trampoline_fn (!_sx_call_fn f args)
+  in
+  register "map" (fun args ->
+    match args with
+    | [f; (List items | ListRef { contents = items })] ->
+      List (List.map (fun x -> call_any f [x]) items)
+    | _ -> raise (Eval_error "map: expected (fn list)"));
+  register "filter" (fun args ->
+    match args with
+    | [f; (List items | ListRef { contents = items })] ->
+      List (List.filter (fun x -> sx_truthy (call_any f [x])) items)
+    | _ -> raise (Eval_error "filter: expected (fn list)"));
+  register "for-each" (fun args ->
+    match args with
+    | [f; (List items | ListRef { contents = items })] ->
+      List.iter (fun x -> ignore (call_any f [x])) items; Nil
+    | _ -> raise (Eval_error "for-each: expected (fn list)"));
+  register "reduce" (fun args ->
+    match args with
+    | [f; init; (List items | ListRef { contents = items })] ->
+      List.fold_left (fun acc x -> call_any f [acc; x]) init items
+    | _ -> raise (Eval_error "reduce: expected (fn init list)"));
   ()

hosts/ocaml/lib/sx_ref.ml

@@ -23,14 +23,12 @@ let _prim_param_types_ref = ref Nil
 (* === Transpiled from evaluator (frames + eval + CEK) === *)
 
 (* make-cek-state *)
-let _cek_steps = ref 0
-
 let rec make_cek_state control env kont =
-  (incr _cek_steps; CekState { cs_control = control; cs_env = env; cs_kont = kont; cs_phase = "eval"; cs_value = Nil })
+  (CekState { cs_control = control; cs_env = env; cs_kont = kont; cs_phase = "eval"; cs_value = Nil })
 
 (* make-cek-value *)
 and make_cek_value value env kont =
-  (incr _cek_steps; CekState { cs_control = Nil; cs_env = env; cs_kont = kont; cs_phase = "continue"; cs_value = value })
+  (CekState { cs_control = Nil; cs_env = env; cs_kont = kont; cs_phase = "continue"; cs_value = value })
 
 (* cek-terminal? *)
 and cek_terminal_p state =

hosts/ocaml/lib/sx_runtime.ml

@@ -46,12 +46,15 @@ let sx_call f args =
   | Lambda l ->
     let local = Sx_types.env_extend l.l_closure in
     List.iter2 (fun p a -> ignore (Sx_types.env_bind local p a)) l.l_params args;
-    (* Return the body + env for the trampoline to evaluate *)
     Thunk (l.l_body, local)
   | Continuation (k, _) ->
     k (match args with x :: _ -> x | [] -> Nil)
   | _ -> raise (Eval_error ("Not callable: " ^ inspect f))
 
+(* Initialize forward ref so primitives can call SX functions *)
+let () = Sx_primitives._sx_call_fn := sx_call
+(* Trampoline ref is set by sx_ref.ml after it's loaded *)
+
 (** Apply a function to a list of args. *)
 let sx_apply f args_list =
   sx_call f (sx_to_list args_list)