Sync sx_ref.ml with bootstrap.py output

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

hosts/ocaml/lib/sx_ref.ml

@@ -8,18 +8,7 @@ open Sx_runtime
 
 (* Trampoline — forward ref, resolved after eval_expr is defined. *)
 let trampoline_fn : (value -> value) ref = ref (fun v -> v)
-(* Step limit for detecting infinite loops — 0 = unlimited *)
-let step_limit : int ref = ref 0
-let step_count : int ref = ref 0
-let trampoline v =
-  if !step_limit > 0 then begin
-    step_count := !step_count + 1;
-    if !step_count mod 1_000_000 = 0 then
-      Printf.eprintf "[trampoline] count=%d\n%!" !step_count;
-    if !step_count > !step_limit then
-      raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded (trampoline)")
-  end;
-  !trampoline_fn v
+let trampoline v = !trampoline_fn v
 
 
 
@@ -583,49 +572,13 @@ and sf_provide args env =
 and expand_macro mac raw_args env =
   (let body = (macro_body (mac)) in (if sx_truthy ((let _and = (symbol_p (body)) in if not (sx_truthy _and) then _and else (prim_call "=" [(symbol_name (body)); (String "__syntax-rules-body__")]))) then (let closure = (macro_closure (mac)) in (syntax_rules_expand ((env_get (closure) ((String "__sr-literals")))) ((env_get (closure) ((String "__sr-rules")))) (raw_args))) else (let local = (env_merge ((macro_closure (mac))) (env)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (if sx_truthy ((prim_call "<" [(nth (pair) ((Number 1.0))); (len (raw_args))])) then (nth (raw_args) ((nth (pair) ((Number 1.0))))) else Nil)))) (sx_to_list (List (List.mapi (fun i p -> let i = Number (float_of_int i) in (List [p; i])) (sx_to_list (macro_params (mac)))))); Nil)) in (let () = ignore ((if sx_truthy ((macro_rest_param (mac))) then (env_bind local (sx_to_string (macro_rest_param (mac))) (prim_call "slice" [raw_args; (len ((macro_params (mac))))])) else Nil)) in (trampoline ((eval_expr ((macro_body (mac))) (local)))))))))
 
-(* cek-step-loop — also catches CekPerformRequest from VmClosure calls
-   and converts them to proper CEK suspensions with continuation preserved.
-   NOTE: try/with wraps only cek_step, NOT the recursive call — preserving
-   tail recursion (critical for the millions of steps in large evaluations). *)
+(* cek-step-loop *)
 and cek_step_loop state =
-  (* Step check BEFORE terminal test — catches TCO thunk loops *)
-  if !step_limit > 0 then begin
-    step_count := !step_count + 1;
-    if !step_count > !step_limit then
-      raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded (pre-check)")
-  end;
-  (if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else begin
-    if !step_limit > 0 then begin
-      step_count := !step_count + 1;
-      if !step_count mod 1_000_000 = 0 then
-        Printf.eprintf "[step] count=%d limit=%d\n%!" !step_count !step_limit;
-      if !step_count > !step_limit then begin
-        Printf.eprintf "[TIMEOUT] step_count=%d exceeded limit=%d\n%!" !step_count !step_limit;
-        raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded")
-      end
-    end;
-    let next = (try cek_step (state)
-      with Sx_types.CekPerformRequest request ->
-        make_cek_suspended request (cek_env state) (cek_kont state))
-    in cek_step_loop next
-  end)
+  (if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else (cek_step_loop ((cek_step (state)))))
 
 (* cek-run *)
 and cek_run state =
-  let rec run s =
-    let final = cek_step_loop s in
-    if sx_truthy (cek_suspended_p final) then
-      match !Sx_types._cek_io_resolver with
-      | Some resolver ->
-        let request = cek_io_request final in
-        let result = resolver request final in
-        run (cek_resume final result)
-      | None ->
-        (match !Sx_types._cek_io_suspend_hook with
-         | Some hook -> hook final
-         | None -> raise (Eval_error (value_to_str (String "IO suspension in non-IO context"))))
-    else cek_value final
-  in run state
+  (let final = (cek_step_loop (state)) in (if sx_truthy ((cek_suspended_p (final))) then (raise (Eval_error (value_to_str (String "IO suspension in non-IO context")))) else (cek_value (final))))
 
 (* cek-resume *)
 and cek_resume suspended_state result' =
@@ -633,11 +586,6 @@ and cek_resume suspended_state result' =
 
 (* cek-step *)
 and cek_step state =
-  if !step_limit > 0 then begin
-    step_count := !step_count + 1;
-    if !step_count > !step_limit then
-      raise (Sx_types.Eval_error "TIMEOUT: step limit exceeded (cek_step)")
-  end;
   (if sx_truthy ((prim_call "=" [(cek_phase (state)); (String "eval")])) then (step_eval (state)) else (step_continue (state)))
 
 (* step-eval *)
@@ -738,9 +686,7 @@ and bind_import_set import_set env =
 
 (* step-sf-import *)
 and step_sf_import args env kont =
-  (if sx_truthy ((empty_p (args))) then (make_cek_value (Nil) (env) (kont)) else (let import_set = (first (args)) in let rest_sets = (rest (args)) in (let lib_spec = (let head = (if sx_truthy ((let _and = (list_p (import_set)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (import_set)))))) in if not (sx_truthy _and) then _and else (symbol_p ((first (import_set))))))) then (symbol_name ((first (import_set)))) else Nil) in (if sx_truthy ((let _or = (prim_call "=" [head; (String "only")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [head; (String "except")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [head; (String "prefix")]) in if sx_truthy _or then _or else (prim_call "=" [head; (String "rename")]))))) then (nth (import_set) ((Number 1.0))) else import_set)) in (if sx_truthy ((library_loaded_p (lib_spec))) then (let () = ignore ((bind_import_set (import_set) (env))) in (if sx_truthy ((empty_p (rest_sets))) then (make_cek_value (Nil) (env) (kont)) else (step_sf_import (rest_sets) (env) (kont)))) else (let hook_loaded = match !Sx_types._import_hook with Some hook -> hook lib_spec | None -> false in
-  if hook_loaded then (let () = ignore ((bind_import_set (import_set) (env))) in (if sx_truthy ((empty_p (rest_sets))) then (make_cek_value (Nil) (env) (kont)) else (step_sf_import (rest_sets) (env) (kont))))
-  else (make_cek_suspended ((let _d = Hashtbl.create 2 in Hashtbl.replace _d "library" lib_spec; Hashtbl.replace _d "op" (String "import"); Dict _d)) (env) ((kont_push ((make_import_frame (import_set) (rest_sets) (env))) (kont)))))))))
+  (if sx_truthy ((empty_p (args))) then (make_cek_value (Nil) (env) (kont)) else (let import_set = (first (args)) in let rest_sets = (rest (args)) in (let lib_spec = (let head = (if sx_truthy ((let _and = (list_p (import_set)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((empty_p (import_set)))))) in if not (sx_truthy _and) then _and else (symbol_p ((first (import_set))))))) then (symbol_name ((first (import_set)))) else Nil) in (if sx_truthy ((let _or = (prim_call "=" [head; (String "only")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [head; (String "except")]) in if sx_truthy _or then _or else (let _or = (prim_call "=" [head; (String "prefix")]) in if sx_truthy _or then _or else (prim_call "=" [head; (String "rename")]))))) then (nth (import_set) ((Number 1.0))) else import_set)) in (if sx_truthy ((library_loaded_p (lib_spec))) then (let () = ignore ((bind_import_set (import_set) (env))) in (if sx_truthy ((empty_p (rest_sets))) then (make_cek_value (Nil) (env) (kont)) else (step_sf_import (rest_sets) (env) (kont)))) else (make_cek_suspended ((let _d = Hashtbl.create 2 in Hashtbl.replace _d "library" lib_spec; Hashtbl.replace _d "op" (String "import"); Dict _d)) (env) ((kont_push ((make_import_frame (import_set) (rest_sets) (env))) (kont))))))))
 
 (* step-sf-perform *)
 and step_sf_perform args env kont =
@@ -949,7 +895,7 @@ and step_continue state =
 
 (* continue-with-call *)
 and continue_with_call f args env raw_args kont =
-  (if sx_truthy ((parameter_p (f))) then (let uid = (parameter_uid (f)) in let frame = (kont_find_provide (kont) (uid)) in (make_cek_value ((if sx_truthy (frame) then (get (frame) ((String "value"))) else (parameter_default (f)))) (env) (kont))) else (if sx_truthy ((callcc_continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let captured = (callcc_continuation_data (f)) in (make_cek_value (arg) (env) (captured))) else (if sx_truthy ((continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let cont_data = (continuation_data (f)) in (let captured = (get (cont_data) ((String "captured"))) in (let result' = (cek_run ((make_cek_value (arg) (env) (captured)))) in (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_lambda (f)))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_component (f)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_island (f)))))))))) then (let result' = (sx_apply_cek f args) in (if sx_truthy ((Bool (is_eval_error result'))) then (make_cek_value ((get (result') ((String "message")))) (env) ((kont_push ((make_raise_eval_frame (env) ((Bool false)))) (kont)))) else (if sx_truthy ((let _and = (dict_p (result')) in if not (sx_truthy _and) then _and else (get (result') ((String "__vm_suspended"))))) then (make_cek_suspended ((get (result') ((String "request")))) (env) ((kont_push ((make_vm_resume_frame ((get (result') ((String "resume")))) (env))) (kont)))) else (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((is_lambda (f))) then (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (env)) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((bind_lambda_params (params) (args) (local))))))) then (let () = ignore ((if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else Nil)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil))) else Nil)) in (let jit_result = (jit_try_call (f) (args)) in (if sx_truthy ((jit_skip_p (jit_result))) then (make_cek_state ((lambda_body (f))) (local) (kont)) else (if sx_truthy ((let _and = (dict_p (jit_result)) in if not (sx_truthy _and) then _and else (get (jit_result) ((String "__vm_suspended"))))) then (make_cek_suspended ((get (jit_result) ((String "request")))) (env) ((kont_push ((make_vm_resume_frame ((get (jit_result) ((String "resume")))) (env))) (kont)))) else (make_cek_value (jit_result) (local) (kont))))))) else (if sx_truthy ((let _or = (is_component (f)) in if sx_truthy _or then _or else (is_island (f)))) then (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (f))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (f))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (f))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_cek_state ((component_body (f))) (local) ((kont_push ((make_comp_trace_frame ((component_name (f))) ((component_file (f))))) (kont))))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Not callable: "); (inspect (f))])))))))))))
+  (if sx_truthy ((parameter_p (f))) then (let uid = (parameter_uid (f)) in let frame = (kont_find_provide (kont) (uid)) in (make_cek_value ((if sx_truthy (frame) then (get (frame) ((String "value"))) else (parameter_default (f)))) (env) (kont))) else (if sx_truthy ((callcc_continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let captured = (callcc_continuation_data (f)) in (make_cek_value (arg) (env) (captured))) else (if sx_truthy ((continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let cont_data = (continuation_data (f)) in (let captured = (get (cont_data) ((String "captured"))) in (let result' = (cek_run ((make_cek_value (arg) (env) (captured)))) in (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_lambda (f)))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_component (f)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_island (f)))))))))) then (let result' = (sx_apply_cek (f) (args)) in (if sx_truthy ((Bool (is_eval_error result'))) then (make_cek_value ((get (result') ((String "message")))) (env) ((kont_push ((make_raise_eval_frame (env) ((Bool false)))) (kont)))) else (if sx_truthy ((let _and = (dict_p (result')) in if not (sx_truthy _and) then _and else (get (result') ((String "__vm_suspended"))))) then (make_cek_suspended ((get (result') ((String "request")))) (env) ((kont_push ((make_vm_resume_frame ((get (result') ((String "resume")))) (env))) (kont)))) else (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((is_lambda (f))) then (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (env)) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((bind_lambda_params (params) (args) (local))))))) then (let () = ignore ((if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else Nil)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil))) else Nil)) in (let jit_result = (jit_try_call (f) (args)) in (if sx_truthy ((jit_skip_p (jit_result))) then (make_cek_state ((lambda_body (f))) (local) (kont)) else (if sx_truthy ((let _and = (dict_p (jit_result)) in if not (sx_truthy _and) then _and else (get (jit_result) ((String "__vm_suspended"))))) then (make_cek_suspended ((get (jit_result) ((String "request")))) (env) ((kont_push ((make_vm_resume_frame ((get (jit_result) ((String "resume")))) (env))) (kont)))) else (make_cek_value (jit_result) (local) (kont))))))) else (if sx_truthy ((let _or = (is_component (f)) in if sx_truthy _or then _or else (is_island (f)))) then (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (f))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (f))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (f))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_cek_state ((component_body (f))) (local) ((kont_push ((make_comp_trace_frame ((component_name (f))) ((component_file (f))))) (kont))))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Not callable: "); (inspect (f))])))))))))))
 
 (* sf-case-step-loop *)
 and sf_case_step_loop match_val clauses env kont =
@@ -987,15 +933,7 @@ let cek_run_iterative state =
       s := cek_step !s
     done;
     (match cek_suspended_p !s with
-     | Bool true ->
-       (* Propagate IO suspension so the outer handler
-          (value_to_js wrapper or _cek_eval_lambda_ref) can drive it.
-          Without this, perform inside nested eval_expr contexts
-          (e.g. event handler → trampoline → eval_expr) gets swallowed.
-          Use _cek_io_suspend_hook if set; otherwise fall back to error. *)
-       (match !Sx_types._cek_io_suspend_hook with
-        | Some hook -> hook !s
-        | None -> raise (Eval_error "IO suspension in non-IO context"))
+     | Bool true -> raise (Eval_error "IO suspension in non-IO context")
      | _ -> cek_value !s)
   with Eval_error msg ->
     _last_error_kont_ref := cek_kont !s;