coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix transpiler append! emit for mutable globals + run_with_io error recovery

Browse Source 
The transpiler's append! emit path didn't check ml-is-mutable-global?,
so (append! *provide-batch-queue* sub) wrote to a dead local variable
instead of the global _ref. This caused the combined test suite hang —
fire-provide-subscribers was silently broken before the local-ref shadow
removal, and now correctly modifies the global batch queue.

Also adds run_with_io error-to-raise conversion (kont_has_handler guard)
so native Eval_errors can be caught by CEK guard/handler-bind when running
through the test runner's IO-aware step loop.

2798/2800 tests pass. 2 foreign-type-checking failures remain: guard can't
catch Eval_error from native fns called through cek_run_iterative (the
handler dispatch itself uses cek_call which re-enters cek_run_iterative,
creating an infinite loop). Fix requires spec-level change: make (error)
use CEK raise instead of host-error.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-05 18:59:38 +00:00
parent b61b437ccd
commit 7f772e0f23
3 changed files with 51 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
hosts/ocaml/lib/sx_ref.ml
View File

@@ -622,7 +622,7 @@ and kont_extract_provides kont =
(* fire-provide-subscribers *)
and fire_provide_subscribers name =
(let subs = (get (!_provide_subscribers_ref) (name)) in (if sx_truthy ((let _and = subs in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((empty_p (subs)))))))) then (if sx_truthy ((prim_call ">" [!_provide_batch_depth_ref; (Number 0.0)])) then (List.iter (fun sub -> ignore ((if sx_truthy ((Bool (not (sx_truthy ((prim_call "contains?" [!_provide_batch_queue_ref; sub])))))) then (sx_append_b !_provide_batch_queue_ref sub) else Nil))) (sx_to_list subs); Nil) else (List.iter (fun sub -> ignore ((cek_call (sub) ((List [Nil]))))) (sx_to_list subs); Nil)) else Nil))
(let subs = (get (!_provide_subscribers_ref) (name)) in (if sx_truthy ((let _and = subs in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((empty_p (subs)))))))) then (if sx_truthy ((prim_call ">" [!_provide_batch_depth_ref; (Number 0.0)])) then (List.iter (fun sub -> ignore ((if sx_truthy ((Bool (not (sx_truthy ((prim_call "contains?" [!_provide_batch_queue_ref; sub])))))) then (_provide_batch_queue_ref := sx_append_b !_provide_batch_queue_ref sub; Nil) else Nil))) (sx_to_list subs); Nil) else (List.iter (fun sub -> ignore ((cek_call (sub) ((List [Nil]))))) (sx_to_list subs); Nil)) else Nil))
(* batch-begin! *)
and batch_begin_b () =
@@ -803,7 +803,7 @@ and step_sf_provide args env kont =
(* step-sf-context *)
and step_sf_context args env kont =
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let frame = (kont_find_provide (kont) (name)) in (let () = ignore ((if sx_truthy (!_bind_tracking_ref) then (if sx_truthy ((Bool (not (sx_truthy ((prim_call "contains?" [!_bind_tracking_ref; name])))))) then (sx_append_b !_bind_tracking_ref name) else Nil) else Nil)) in (make_cek_value ((let sv = (scope_peek (name)) in (if sx_truthy ((is_nil (sv))) then (if sx_truthy (frame) then (get (frame) ((String "value"))) else default_val) else sv))) (env) (kont))))
(let name = (trampoline ((eval_expr ((first (args))) (env)))) in let default_val = (if sx_truthy ((prim_call ">=" [(len (args)); (Number 2.0)])) then (trampoline ((eval_expr ((nth (args) ((Number 1.0)))) (env)))) else Nil) in let frame = (kont_find_provide (kont) (name)) in (let () = ignore ((if sx_truthy (!_bind_tracking_ref) then (if sx_truthy ((Bool (not (sx_truthy ((prim_call "contains?" [!_bind_tracking_ref; name])))))) then (_bind_tracking_ref := sx_append_b !_bind_tracking_ref name; Nil) else Nil) else Nil)) in (make_cek_value ((let sv = (scope_peek (name)) in (if sx_truthy ((is_nil (sv))) then (if sx_truthy (frame) then (get (frame) ((String "value"))) else default_val) else sv))) (env) (kont))))
(* step-sf-peek *)
and step_sf_peek args env kont =