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

Step 5: CEK IO suspension + R7RS modules (define-library/import)

Browse Source 
Third CEK phase "io-suspended": perform suspends evaluation, host
resolves IO, cek-resume feeds result back. VM OP_PERFORM (opcode 112)
enables JIT-compiled functions to suspend. VM→CEK→suspend chain
propagates suspension across the JIT/CEK boundary via pending_cek.

R7RS define-library creates isolated environments with export control.
import checks the library registry and suspends for unknown libraries,
enabling lazy on-demand loading. Import qualifiers: only, prefix.

Server-side cek_run_with_io handles suspension by dispatching IO
requests to the Python bridge and resuming. guard composes cleanly
with perform for structured error recovery across IO boundaries.

2598/2598 tests (30 new: 15 core suspension, 3 JIT, 1 cross-boundary,
9 modules, 2 error handling). Zero regressions.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-03 18:55:43 +00:00
parent 9b8a8dd272
commit 1dd4c87d64
14 changed files with 3980 additions and 2477 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
hosts/javascript/platform.py
View File

@@ -1714,7 +1714,8 @@ PLATFORM_CEK_JS = '''
CEK_FIXUPS_JS = '''
// Override recursive cekRun with iterative loop (avoids stack overflow)
cekRun = function(state) {
while (!cekTerminal_p(state)) { state = cekStep(state); }
while (!cekTerminal_p(state) && !cekSuspended_p(state)) { state = cekStep(state); }
if (cekSuspended_p(state)) { throw new Error("IO suspension in non-IO context"); }
return cekValue(state);
};

56
hosts/ocaml/bin/run_tests.ml
View File

@@ -211,6 +211,8 @@ let make_test_env () =
| [e; Keyword k; v] -> Sx_types.env_set (uw e) k v
| _ -> raise (Eval_error "env-set!: expected env, key, value"));
bind "make-env" (fun _args -> Env (Sx_types.make_env ()));
bind "env-extend" (fun args ->
match args with
| [e] -> Env (Sx_types.env_extend (uw e))
@@ -841,6 +843,60 @@ let make_test_env () =
| [frame] -> Sx_ref.frame_type frame
| _ -> raise (Eval_error "frame-type: expected 1 arg"));
(* IO suspension primitives — inline until retranspile *)
let is_suspended state =
match get_val state (String "phase") with String "io-suspended" -> true | _ -> false in
let step_loop state =
let s = ref state in
while not (match Sx_ref.cek_terminal_p !s with Bool true -> true | _ -> false)
&& not (is_suspended !s) do
s := Sx_ref.cek_step !s
done;
!s in
bind "cek-step-loop" (fun args ->
match args with
| [state] -> step_loop state
| _ -> raise (Eval_error "cek-step-loop: expected 1 arg"));
bind "cek-resume" (fun args ->
match args with
| [state; result] ->
step_loop (Sx_ref.make_cek_value result (get_val state (String "env")) (get_val state (String "kont")))
| _ -> raise (Eval_error "cek-resume: expected 2 args"));
bind "cek-suspended?" (fun args ->
match args with
| [state] -> Bool (is_suspended state)
| _ -> raise (Eval_error "cek-suspended?: expected 1 arg"));
bind "cek-io-request" (fun args ->
match args with
| [state] -> get_val state (String "request")
| _ -> raise (Eval_error "cek-io-request: expected 1 arg"));
bind "make-cek-suspended" (fun args ->
match args with
| [req; env'; kont] ->
let d = Hashtbl.create 4 in
Hashtbl.replace d "phase" (String "io-suspended");
Hashtbl.replace d "request" req;
Hashtbl.replace d "env" env';
Hashtbl.replace d "kont" kont;
Dict d
| _ -> raise (Eval_error "make-cek-suspended: expected 3 args"));
(* --- Library registry --- *)
let lib_registry = Hashtbl.create 16 in
ignore (Sx_types.env_bind env "*library-registry*" (Dict lib_registry));
bind "library-loaded?" (fun args ->
match args with
| [spec] -> Sx_ref.library_loaded_p spec
| _ -> raise (Eval_error "library-loaded?: expected 1 arg"));
bind "library-exports" (fun args ->
match args with
| [spec] -> Sx_ref.library_exports spec
| _ -> raise (Eval_error "library-exports: expected 1 arg"));
bind "register-library" (fun args ->
match args with
| [spec; exports] -> Sx_ref.register_library spec exports
| _ -> raise (Eval_error "register-library: expected 2 args"));
(* --- Strict mode --- *)
(* *strict* is a plain value in the env, mutated via env_set by set-strict! *)
ignore (Sx_types.env_bind env "*strict*" (Bool false));

62
hosts/ocaml/bin/sx_server.ml
View File

@@ -281,6 +281,43 @@ let flush_batched_io result_str =
!final
end
(** IO-aware CEK run — handles suspension by dispatching IO requests.
When the CEK machine suspends with a perform, this function sends
the IO request to the Python bridge, resumes with the response,
and repeats until evaluation completes. *)
let cek_run_with_io state =
let s = ref state in
let is_terminal s = match Sx_ref.cek_terminal_p s with Bool true -> true | _ -> false in
let is_suspended s = match Sx_runtime.get_val s (String "phase") with String "io-suspended" -> true | _ -> false in
let rec loop () =
while not (is_terminal !s) && not (is_suspended !s) do
s := Sx_ref.cek_step !s
done;
if is_suspended !s then begin
let request = Sx_runtime.get_val !s (String "request") in
let op = match Sx_runtime.get_val request (String "op") with String s -> s | _ -> "" in
(* Extract args based on operation type *)
let args = match op with
| "import" ->
let lib = Sx_runtime.get_val request (String "library") in
[String "import"; lib]
| _ ->
let a = Sx_runtime.get_val request (String "args") in
(match a with List l -> l | _ -> [a])
in
let response = io_request op args in
s := Sx_ref.cek_resume !s response;
loop ()
end else
Sx_ref.cek_value !s
in
loop ()
(** IO-aware eval_expr — like eval_expr but handles IO suspension. *)
let _eval_expr_io expr env =
let state = Sx_ref.make_cek_state expr env (List []) in
cek_run_with_io state
(** Bind IO primitives into the environment. *)
let setup_io_env env =
let bind name fn =
@@ -798,6 +835,21 @@ let _jit_compiling = ref false (* re-entrancy guard *)
let _jit_warned : (string, bool) Hashtbl.t = Hashtbl.create 16
let rec make_vm_suspend_marker request saved_vm =
let d = Hashtbl.create 3 in
Hashtbl.replace d "__vm_suspended" (Bool true);
Hashtbl.replace d "request" request;
(* Create a resume function that continues this specific VM.
May raise VmSuspended again — caller must handle. *)
Hashtbl.replace d "resume" (NativeFn ("vm-resume", fun args ->
match args with
| [result] ->
(try Sx_vm.resume_vm saved_vm result
with Sx_vm.VmSuspended (req2, vm2) ->
make_vm_suspend_marker req2 vm2)
| _ -> raise (Eval_error "vm-resume: expected 1 arg")));
Dict d
let register_jit_hook env =
Sx_runtime._jit_try_call_fn := Some (fun f args ->
match f with
@@ -807,7 +859,10 @@ let register_jit_hook env =
(* Cached bytecode — run on VM, fall back to CEK on runtime error.
Log once per function name, then stay quiet. Don't disable. *)
(try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
with e ->
with
| Sx_vm.VmSuspended (request, saved_vm) ->
Some (make_vm_suspend_marker request saved_vm)
| e ->
let fn_name = match l.l_name with Some n -> n | None -> "?" in
if not (Hashtbl.mem _jit_warned fn_name) then begin
Hashtbl.replace _jit_warned fn_name true;
@@ -832,7 +887,10 @@ let register_jit_hook env =
| Some cl ->
l.l_compiled <- Some cl;
(try Some (Sx_vm.call_closure cl args cl.vm_env_ref)
with e ->
with
| Sx_vm.VmSuspended (request, saved_vm) ->
Some (make_vm_suspend_marker request saved_vm)
| e ->
Printf.eprintf "[jit] %s first-call fallback to CEK: %s\n%!" fn_name (Printexc.to_string e);
Hashtbl.replace _jit_warned fn_name true;
None)

7
hosts/ocaml/bootstrap.py
View File

@@ -74,10 +74,13 @@ let () = Sx_primitives._sx_trampoline_fn := !trampoline_fn
let cek_run_iterative state =
let s = ref state in
(try
while not (match cek_terminal_p !s with Bool true -> true | _ -> false) do
while not (match cek_terminal_p !s with Bool true -> true | _ -> false)
&& not (match cek_suspended_p !s with Bool true -> true | _ -> false) do
s := cek_step !s
done;
cek_value !s
(match cek_suspended_p !s with
| 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;
raise (Eval_error msg))

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

File diff suppressed because one or more lines are too long

66
hosts/ocaml/lib/sx_vm.ml
View File

@@ -26,8 +26,14 @@ type vm = {
mutable sp : int;
mutable frames : frame list;
globals : (string, value) Hashtbl.t; (* live reference to kernel env *)
mutable pending_cek : value option; (* suspended CEK state from Component/Lambda call *)
}
(** Raised when OP_PERFORM is executed. Carries the IO request dict
and a reference to the VM (which is in a resumable state:
ip past OP_PERFORM, stack ready for a result push). *)
exception VmSuspended of value * vm
(** Forward reference for JIT compilation — set after definition. *)
let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
ref (fun _ _ -> None)
@@ -49,7 +55,7 @@ let is_jit_failed cl = cl.vm_code.vc_arity = -1
let _active_vm : vm option ref = ref None
let create globals =
{ stack = Array.make 4096 Nil; sp = 0; frames = []; globals }
{ stack = Array.make 4096 Nil; sp = 0; frames = []; globals; pending_cek = None }
(** Stack ops — inlined for speed. *)
let push vm v =
@@ -128,6 +134,19 @@ let code_from_value v =
{ vc_arity = arity; vc_locals = arity + 16; vc_bytecode = bc_list; vc_constants = constants }
| _ -> { vc_arity = 0; vc_locals = 16; vc_bytecode = [||]; vc_constants = [||] }
(** Call an SX value via CEK, detecting suspension instead of erroring.
Returns the result value, or raises VmSuspended if CEK suspends.
Saves the suspended CEK state in vm.pending_cek for later resume. *)
let cek_call_or_suspend vm f args =
let a = match args with Nil -> [] | List l -> l | _ -> [args] in
let state = Sx_ref.continue_with_call f (List a) (Env (Sx_types.make_env ())) (List a) (List []) in
let final = Sx_ref.cek_step_loop state in
match Sx_runtime.get_val final (String "phase") with
| String "io-suspended" ->
vm.pending_cek <- Some final;
raise (VmSuspended (Sx_runtime.get_val final (String "request"), vm))
| _ -> Sx_ref.cek_value final
(** Execute a closure with arguments — creates a fresh VM.
Used for entry points: JIT Lambda calls, module execution, cross-boundary. *)
let rec call_closure cl args globals =
@@ -165,12 +184,11 @@ and vm_call vm f args =
not the caller's globals. Closure vars were merged at compile time. *)
(try push vm (call_closure cl args cl.vm_env_ref)
with _e ->
(* Fallback to CEK — data-dependent error, not a JIT bug.
Dedup logging happens in register_jit_hook. *)
push vm (Sx_ref.cek_call f (List args)))
(* Fallback to CEK — suspension-aware *)
push vm (cek_call_or_suspend vm f (List args)))
| Some _ ->
(* Compile failed — CEK *)
push vm (Sx_ref.cek_call f (List args))
(* Compile failed — CEK, suspension-aware *)
push vm (cek_call_or_suspend vm f (List args))
| None ->
if l.l_name <> None
then begin
@@ -180,17 +198,16 @@ and vm_call vm f args =
| Some cl ->
l.l_compiled <- Some cl;
(try push vm (call_closure cl args cl.vm_env_ref)
with _e -> push vm (Sx_ref.cek_call f (List args)))
with _e -> push vm (cek_call_or_suspend vm f (List args)))
| None ->
push vm (Sx_ref.cek_call f (List args))
push vm (cek_call_or_suspend vm f (List args))
end
else
push vm (Sx_ref.cek_call f (List args)))
push vm (cek_call_or_suspend vm f (List args)))
| Component _ | Island _ ->
(* Components use keyword-arg parsing — CEK handles this *)
(* Components use keyword-arg parsing — CEK handles this, suspension-aware *)
incr _vm_cek_count;
let result = Sx_ref.cek_call f (List args) in
push vm result
push vm (cek_call_or_suspend vm f (List args))
| _ ->
raise (Eval_error ("VM: not callable: " ^ Sx_runtime.value_to_str f))
@@ -534,6 +551,11 @@ and run vm =
| Number x -> Number (x -. 1.0)
| _ -> (Hashtbl.find Sx_primitives.primitives "dec") [v])
(* ---- IO Suspension ---- *)
| 112 (* OP_PERFORM *) ->
let request = pop vm in
raise (VmSuspended (request, vm))
| opcode ->
raise (Eval_error (Printf.sprintf "VM: unknown opcode %d at ip=%d"
opcode (frame.ip - 1)))
@@ -546,6 +568,26 @@ and run vm =
end
done
(** Resume a suspended VM by pushing the IO result and continuing.
May raise VmSuspended again if the VM hits another OP_PERFORM. *)
let resume_vm vm result =
(match vm.pending_cek with
| Some cek_state ->
(* Resume the suspended CEK evaluation first *)
vm.pending_cek <- None;
let final = Sx_ref.cek_resume cek_state result in
(match Sx_runtime.get_val final (String "phase") with
| String "io-suspended" ->
(* CEK suspended again — re-suspend the VM *)
vm.pending_cek <- Some final;
raise (VmSuspended (Sx_runtime.get_val final (String "request"), vm))
| _ ->
push vm (Sx_ref.cek_value final))
| None ->
push vm result);
run vm;
pop vm
(** Execute a compiled module (top-level bytecode). *)
let execute_module code globals =
let cl = { vm_code = code; vm_upvalues = [||]; vm_name = Some "module"; vm_env_ref = globals; vm_closure_env = None } in

9
hosts/ocaml/transpiler.sx
View File

@@ -215,6 +215,15 @@
"for-each-indexed"
"cek-call"
"cek-run"
"cek-step-loop"
"cek-resume"
"cek-suspended?"
"cek-io-request"
"make-cek-suspended"
"library-name-key"
"library-loaded?"
"library-exports"
"register-library"
"sx-call"
"sx-apply"
"collect!"

1325
lib/compiler.sx
View File

File diff suppressed because it is too large Load Diff

736
shared/static/scripts/sx-browser.js
View File

File diff suppressed because it is too large Load Diff

3393
shared/static/wasm/sx_browser.bc.js
View File

File diff suppressed because one or more lines are too long

2
shared/static/wasm/sx_browser.bc.wasm.js
View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-dd795843",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-4109558c",[2,3,5]],["std_exit-10fb8830",[2]],["start-80fdb768",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-ee45eb6c",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-996ff9e3",[2,3,5]],["std_exit-10fb8830",[2]],["start-80fdb768",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new

415
spec/evaluator.sx
View File

@@ -9,22 +9,22 @@
(define make-cek-value (fn (value env kont) {:control nil :env env :kont kont :value value :phase "continue"}))
(define make-cek-suspended (fn (request env kont) {:env env :kont kont :phase "io-suspended" :request request}))
(define
cek-terminal?
(fn
(state)
(and (= (get state "phase") "continue") (empty? (get state "kont")))))
(define cek-suspended? (fn (state) (= (get state "phase") "io-suspended")))
(define cek-control (fn (s) (get s "control")))
(define cek-env (fn (s) (get s "env")))
(define cek-kont (fn (s) (get s "kont")))
(define cek-phase (fn (s) (get s "phase")))
(define cek-value (fn (s) (get s "value")))
;; ═══════════════════════════════════════════════════════════════
;; Part 2: Continuation Frames
;;
@@ -32,19 +32,25 @@
;; when the current sub-expression finishes evaluating. The kont
;; (continuation) is a list of frames, forming a reified call stack.
;; ═══════════════════════════════════════════════════════════════
(define cek-phase (fn (s) (get s "phase")))
(define cek-io-request (fn (s) (get s "request")))
(define cek-value (fn (s) (get s "value")))
(define make-if-frame (fn (then-expr else-expr env) {:else else-expr :env env :type "if" :then then-expr}))
(define make-when-frame (fn (body-exprs env) {:body body-exprs :env env :type "when"}))
(define make-begin-frame (fn (remaining env) {:env env :type "begin" :remaining remaining}))
;; Function call frames: accumulate evaluated args, then dispatch
(define make-let-frame (fn (name remaining body local) {:body body :env local :type "let" :remaining remaining :name name}))
(define make-define-frame (fn (name env has-effects effect-list) {:env env :effect-list effect-list :has-effects has-effects :type "define" :name name}))
(define make-set-frame (fn (name env) {:env env :type "set" :name name}))
;; Function call frames: accumulate evaluated args, then dispatch
(define
make-arg-frame
(fn (f evaled remaining env raw-args head-name) {:env env :head-name (or head-name nil) :evaled evaled :type "arg" :f f :remaining remaining :raw-args raw-args}))
@@ -55,6 +61,7 @@
(define make-cond-arrow-frame (fn (test-value env) {:env env :match-val test-value :type "cond-arrow"}))
;; Higher-order iteration frames
(define make-case-frame (fn (match-val remaining env) {:match-val match-val :env env :type "case" :remaining remaining}))
(define make-thread-frame (fn (remaining env) {:env env :type "thread" :remaining remaining}))
@@ -70,7 +77,6 @@
fenv)
(eval-expr (list form (list (quote quote) value)) fenv))))
;; Higher-order iteration frames
(define make-map-frame (fn (f remaining results env) {:indexed false :env env :results results :type "map" :f f :remaining remaining}))
(define make-map-indexed-frame (fn (f remaining results env) {:indexed true :env env :results results :type "map" :f f :remaining remaining}))
@@ -83,45 +89,46 @@
(define make-reduce-frame (fn (f remaining env) {:env env :type "reduce" :f f :remaining remaining}))
;; Scope/provide/context — downward data passing without env threading
(define make-for-each-frame (fn (f remaining env) {:env env :type "for-each" :f f :remaining remaining}))
(define make-some-frame (fn (f remaining env) {:env env :type "some" :f f :remaining remaining}))
(define make-every-frame (fn (f remaining env) {:env env :type "every" :f f :remaining remaining}))
;; Scope/provide/context — downward data passing without env threading
;; Delimited continuations (shift/reset)
(define make-scope-frame (fn (name remaining env) {:env env :type "scope" :remaining remaining :name name}))
(define make-provide-frame (fn (name value remaining env) {:env env :value value :type "provide" :remaining remaining :name name}))
(define make-scope-acc-frame (fn (name value remaining env) {:env env :value (or value nil) :type "scope-acc" :remaining remaining :emitted (list) :name name}))
;; Delimited continuations (shift/reset)
(define make-reset-frame (fn (env) {:env env :type "reset"}))
;; Dynamic wind + reactive signals
(define make-dict-frame (fn (remaining results env) {:env env :results results :type "dict" :remaining remaining}))
(define make-and-frame (fn (remaining env) {:env env :type "and" :remaining remaining}))
;; Undelimited continuations (call/cc)
(define make-or-frame (fn (remaining env) {:env env :type "or" :remaining remaining}))
;; Dynamic wind + reactive signals
(define
make-dynamic-wind-frame
(fn (phase body-thunk after-thunk env) {:env env :phase phase :after-thunk after-thunk :type "dynamic-wind" :body-thunk body-thunk}))
;; HO setup: staged argument evaluation for map/filter/etc.
;; Evaluates args one at a time, then dispatches to the correct
;; HO frame (map, filter, reduce) once all args are ready.
(define
make-reactive-reset-frame
(fn (env update-fn first-render?) {:first-render first-render? :update-fn update-fn :env env :type "reactive-reset"}))
;; Undelimited continuations (call/cc)
(define make-callcc-frame (fn (env) {:env env :type "callcc"}))
(define make-deref-frame (fn (env) {:env env :type "deref"}))
;; HO setup: staged argument evaluation for map/filter/etc.
;; Evaluates args one at a time, then dispatches to the correct
;; HO frame (map, filter, reduce) once all args are ready.
;; Condition system frames (handler-bind, restart-case, signal)
(define
make-ho-setup-frame
(fn (ho-type remaining-args evaled-args env) {:ho-type ho-type :env env :evaled evaled-args :type "ho-setup" :remaining remaining-args}))
@@ -142,24 +149,30 @@
(cons {:file (get frame "file") :name (get frame "name")} (kont-collect-comp-trace (rest kont)))
(kont-collect-comp-trace (rest kont)))))))
;; Condition system frames (handler-bind, restart-case, signal)
;; R7RS exception frames (raise, guard)
(define make-handler-frame (fn (handlers remaining env) {:env env :type "handler" :f handlers :remaining remaining}))
(define make-restart-frame (fn (restarts remaining env) {:env env :type "restart" :f restarts :remaining remaining}))
(define make-signal-return-frame (fn (env saved-kont) {:env env :type "signal-return" :f saved-kont}))
;; R7RS exception frames (raise, guard)
(define make-raise-eval-frame (fn (env continuable?) {:scheme continuable? :env env :type "raise-eval"}))
(define make-raise-guard-frame (fn (env saved-kont) {:env env :type "raise-guard" :remaining saved-kont}))
;; ═══════════════════════════════════════════════════════════════
;; Part 3: Continuation Stack Operations
;;
;; Searching and manipulating the kont list — finding handlers,
;; restarts, scope accumulators, and capturing delimited slices.
;; ═══════════════════════════════════════════════════════════════
(define make-signal-return-frame (fn (env saved-kont) {:env env :type "signal-return" :f saved-kont}))
(define make-raise-eval-frame (fn (env continuable?) {:scheme continuable? :env env :type "raise-eval"}))
(define make-raise-guard-frame (fn (env saved-kont) {:env env :type "raise-guard" :remaining saved-kont}))
(define make-perform-frame (fn (env) {:env env :type "perform"}))
;; Basic kont operations
(define make-vm-resume-frame (fn (resume-fn env) {:env env :type "vm-resume" :f resume-fn}))
(define make-import-frame (fn (import-set remaining-sets env) {:args import-set :env env :type "import" :remaining remaining-sets}))
(define
find-matching-handler
(fn
@@ -209,6 +222,7 @@
entry
(find-named-restart (rest restarts) name))))))
;; Capture frames up to a reset boundary — used by shift
(define
kont-find-restart
(fn
@@ -228,7 +242,6 @@
(list match frame (rest kont))))
(kont-find-restart (rest kont) name))))))
;; Basic kont operations
(define frame-type (fn (f) (get f "type")))
(define kont-push (fn (frame kont) (cons frame kont)))
@@ -237,9 +250,14 @@
(define kont-pop (fn (kont) (rest kont)))
;; ═══════════════════════════════════════════════════════════════
;; Part 4: Extension Points & Mutable State
;;
;; Custom special forms registry, render hooks, strict mode.
;; Mutable globals use set! — the transpiler emits OCaml refs.
;; ═══════════════════════════════════════════════════════════════
(define kont-empty? (fn (kont) (empty? kont)))
;; Capture frames up to a reset boundary — used by shift
(define
kont-capture-to-reset
(fn
@@ -324,12 +342,6 @@
(scan (rest k) (append captured (list frame))))))))
(scan kont (list))))
;; ═══════════════════════════════════════════════════════════════
;; Part 4: Extension Points & Mutable State
;;
;; Custom special forms registry, render hooks, strict mode.
;; Mutable globals use set! — the transpiler emits OCaml refs.
;; ═══════════════════════════════════════════════════════════════
(define *custom-special-forms* (dict))
(define
@@ -342,6 +354,43 @@
(define *render-fn* nil)
(define *library-registry* (dict))
;; ═══════════════════════════════════════════════════════════════
;; Part 5: Evaluation Utilities
;;
;; Forward-declared eval-expr, lambda/component calling, keyword
;; arg parsing, special form constructors (lambda, defcomp,
;; defmacro, quasiquote), and macro expansion.
;; ═══════════════════════════════════════════════════════════════
;; Forward declaration — redefined at end of file as CEK entry point
(define
library-name-key
(fn
(spec)
(join
"."
(map (fn (s) (if (symbol? s) (symbol-name s) (str s))) spec))))
;; Shared param binding for lambda/component calls.
;; Handles &rest collection — used by both call-lambda and continue-with-call.
(define
library-loaded?
(fn (spec) (has-key? *library-registry* (library-name-key spec))))
(define
library-exports
(fn
(spec)
(get (get *library-registry* (library-name-key spec)) "exports")))
;; Component calls: parse keyword args, bind params, TCO thunk
(define
register-library
(fn
(spec exports)
(dict-set! *library-registry* (library-name-key spec) {:exports exports})))
(define
trampoline
(fn
@@ -354,10 +403,12 @@
(trampoline (eval-expr (thunk-expr result) (thunk-env result)))
result)))))
;; Cond/case helpers
(define *strict* false)
(define set-strict! (fn (val) (set! *strict* val)))
;; Special form constructors — build state for CEK evaluation
(define *prim-param-types* nil)
(define set-prim-param-types! (fn (types) (set! *prim-param-types* types)))
@@ -457,18 +508,8 @@
(fn (i v) (list i v))
(slice args (len (or positional (list)))))))))))))
;; ═══════════════════════════════════════════════════════════════
;; Part 5: Evaluation Utilities
;;
;; Forward-declared eval-expr, lambda/component calling, keyword
;; arg parsing, special form constructors (lambda, defcomp,
;; defmacro, quasiquote), and macro expansion.
;; ═══════════════════════════════════════════════════════════════
;; Forward declaration — redefined at end of file as CEK entry point
(define eval-expr (fn (expr (env :as dict)) nil))
;; Shared param binding for lambda/component calls.
;; Handles &rest collection — used by both call-lambda and continue-with-call.
(define
bind-lambda-params
(fn
@@ -519,7 +560,6 @@
(slice params (len args))))
(make-thunk (lambda-body f) local))))
;; Component calls: parse keyword args, bind params, TCO thunk
(define
call-component
(fn
@@ -537,6 +577,7 @@
(env-bind! local "children" children))
(make-thunk (component-body comp) local))))
;; Quasiquote expansion
(define
parse-keyword-args
(fn
@@ -568,7 +609,6 @@
raw-args)
(list kwargs children))))
;; Cond/case helpers
(define
cond-scheme?
(fn
@@ -596,7 +636,6 @@
(= (type-of test) "symbol")
(or (= (symbol-name test) "else") (= (symbol-name test) ":else"))))))
;; Special form constructors — build state for CEK evaluation
(define
sf-named-let
(fn
@@ -710,6 +749,7 @@
(env-bind! env (symbol-name name-sym) comp)
comp))))
;; Macro expansion — expand then re-evaluate the result
(define
defcomp-kwarg
(fn
@@ -732,6 +772,14 @@
(range 2 end 1))
result)))
;; ═══════════════════════════════════════════════════════════════
;; Part 6: CEK Machine Core
;;
;; cek-run: trampoline loop — steps until terminal.
;; cek-step: single step — dispatches on phase (eval vs continue).
;; step-eval: evaluates control expression, pushes frames.
;; step-continue: pops a frame, processes result.
;; ═══════════════════════════════════════════════════════════════
(define
parse-comp-params
(fn
@@ -819,6 +867,12 @@
(env-bind! env (symbol-name name-sym) mac)
mac))))
;; ═══════════════════════════════════════════════════════════════
;; Part 7: Special Form Step Functions
;;
;; Each step-sf-* handles one special form in the eval phase.
;; They push frames and return new CEK states — never recurse.
;; ═══════════════════════════════════════════════════════════════
(define
parse-macro-params
(fn
@@ -847,7 +901,7 @@
params-expr)
(list params rest-param))))
;; Quasiquote expansion
;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise
(define
qq-expand
(fn
@@ -887,6 +941,9 @@
(list)
template)))))))
;; List evaluation — dispatches on head: special forms, macros,
;; higher-order forms, or function calls. This is the main
;; expression dispatcher for the CEK machine.
(define
sf-letrec
(fn
@@ -942,6 +999,7 @@
(slice body 0 (dec (len body))))
(make-thunk (last body) local))))
;; call/cc: capture entire kont as undelimited escape continuation
(define
step-sf-letrec
(fn
@@ -987,6 +1045,7 @@
(scope-pop! name)
result))))
;; Pattern matching (match form)
(define
sf-provide
(fn
@@ -1003,7 +1062,7 @@
(scope-pop! name)
result)))
;; Macro expansion — expand then re-evaluate the result
;; Condition system special forms
(define
expand-macro
(fn
@@ -1029,19 +1088,35 @@
(slice raw-args (len (macro-params mac)))))
(trampoline (eval-expr (macro-body mac) local)))))
;; ═══════════════════════════════════════════════════════════════
;; Part 6: CEK Machine Core
;;
;; cek-run: trampoline loop — steps until terminal.
;; cek-step: single step — dispatches on phase (eval vs continue).
;; step-eval: evaluates control expression, pushes frames.
;; step-continue: pops a frame, processes result.
;; ═══════════════════════════════════════════════════════════════
(define
cek-step-loop
(fn
(state)
(if
(or (cek-terminal? state) (cek-suspended? state))
state
(cek-step-loop (cek-step state)))))
(define
cek-run
(fn
(state)
(if (cek-terminal? state) (cek-value state) (cek-run (cek-step state)))))
(let
((final (cek-step-loop state)))
(if
(cek-suspended? final)
(error "IO suspension in non-IO context")
(cek-value final)))))
(define
cek-resume
(fn
(suspended-state result)
(cek-step-loop
(make-cek-value
result
(cek-env suspended-state)
(cek-kont suspended-state)))))
(define
cek-step
@@ -1108,12 +1183,6 @@
(step-eval-list expr env kont))
:else (make-cek-value expr env kont)))))
;; ═══════════════════════════════════════════════════════════════
;; Part 7: Special Form Step Functions
;;
;; Each step-sf-* handles one special form in the eval phase.
;; They push frames and return new CEK states — never recurse.
;; ═══════════════════════════════════════════════════════════════
(define
step-sf-raise
(fn
@@ -1123,7 +1192,6 @@
env
(kont-push (make-raise-eval-frame env false) kont))))
;; R7RS guard: desugars to call/cc + handler-bind with sentinel re-raise
(define
step-sf-guard
(fn
@@ -1197,9 +1265,6 @@
env
kont))))
;; List evaluation — dispatches on head: special forms, macros,
;; higher-order forms, or function calls. This is the main
;; expression dispatcher for the CEK machine.
(define
step-eval-list
(fn
@@ -1330,6 +1395,9 @@
("call/cc" (step-sf-callcc args env kont))
("call-with-current-continuation"
(step-sf-callcc args env kont))
("perform" (step-sf-perform args env kont))
("define-library" (step-sf-define-library args env kont))
("import" (step-sf-import args env kont))
(_
(cond
(has-key? *custom-special-forms* name)
@@ -1346,7 +1414,119 @@
:else (step-eval-call head args env kont)))))
(step-eval-call head args env kont))))))
;; call/cc: capture entire kont as undelimited escape continuation
(define
step-sf-define-library
(fn
(args env kont)
(let
((lib-spec (first args)) (decls (rest args)))
(let
((lib-env (env-extend (make-env)))
(exports (list))
(body-forms (list)))
(for-each
(fn
(decl)
(when
(and
(list? decl)
(not (empty? decl))
(symbol? (first decl)))
(let
((kind (symbol-name (first decl))))
(cond
(= kind "export")
(set!
exports
(append
exports
(map
(fn (s) (if (symbol? s) (symbol-name s) (str s)))
(rest decl))))
(= kind "begin")
(set! body-forms (append body-forms (rest decl)))
:else nil))))
decls)
(for-each (fn (form) (eval-expr form lib-env)) body-forms)
(let
((export-dict (dict)))
(for-each
(fn
(name)
(when
(env-has? lib-env name)
(dict-set! export-dict name (env-get lib-env name))))
exports)
(register-library lib-spec export-dict)
(make-cek-value nil env kont))))))
(define
bind-import-set
(fn
(import-set env)
(let
((head (if (and (list? import-set) (not (empty? import-set)) (symbol? (first import-set))) (symbol-name (first import-set)) nil)))
(let
((lib-spec (if (or (= head "only") (= head "except") (= head "prefix") (= head "rename")) (nth import-set 1) import-set)))
(let
((exports (library-exports lib-spec)))
(cond
(= head "only")
(for-each
(fn
(s)
(let
((id (if (symbol? s) (symbol-name s) (str s))))
(when
(has-key? exports id)
(env-bind! env id (get exports id)))))
(rest (rest import-set)))
(= head "prefix")
(let
((pfx (str (nth import-set 2))))
(for-each
(fn (key) (env-bind! env (str pfx key) (get exports key)))
(keys exports)))
:else (for-each
(fn (key) (env-bind! env key (get exports key)))
(keys exports))))))))
(define
step-sf-import
(fn
(args env kont)
(if
(empty? args)
(make-cek-value nil env kont)
(let
((import-set (first args)) (rest-sets (rest args)))
(let
((lib-spec (let ((head (if (and (list? import-set) (not (empty? import-set)) (symbol? (first import-set))) (symbol-name (first import-set)) nil))) (if (or (= head "only") (= head "except") (= head "prefix") (= head "rename")) (nth import-set 1) import-set))))
(if
(library-loaded? lib-spec)
(do
(bind-import-set import-set env)
(if
(empty? rest-sets)
(make-cek-value nil env kont)
(step-sf-import rest-sets env kont)))
(make-cek-suspended
{:library lib-spec :op "import"}
env
(kont-push (make-import-frame import-set rest-sets env) kont))))))))
(define
step-sf-perform
(fn
(args env kont)
(if
(empty? args)
(error "perform requires an IO request argument")
(make-cek-state
(first args)
env
(kont-push (make-perform-frame env) kont)))))
(define
step-sf-callcc
(fn
@@ -1405,7 +1585,7 @@
pairs)))
:else (= pattern value))))
;; Pattern matching (match form)
;; Scope/provide/context — structured downward data passing
(define
step-sf-match
(fn
@@ -1420,7 +1600,6 @@
(error (str "match: no clause matched " (inspect val)))
(make-cek-state (nth result 1) (first result) kont))))))
;; Condition system special forms
(define
step-sf-handler-bind
(fn
@@ -1513,6 +1692,7 @@
(env-bind! restart-env (first params) restart-arg))
(make-cek-state body restart-env rest-kont)))))))
;; Delimited continuations
(define
step-sf-if
(fn
@@ -1536,6 +1716,7 @@
env
(kont-push (make-when-frame (rest args) env) kont))))
;; Signal dereferencing with reactive dependency tracking
(define
step-sf-begin
(fn
@@ -1551,6 +1732,13 @@
env
(kont-push (make-begin-frame (rest args) env) kont))))))
;; ═══════════════════════════════════════════════════════════════
;; Part 8: Call Dispatch
;;
;; cek-call: invoke a function from native code (runs a nested
;; trampoline). step-eval-call: CEK-native call dispatch for
;; lambda, component, native fn, and continuations.
;; ═══════════════════════════════════════════════════════════════
(define
step-sf-let
(fn
@@ -1595,6 +1783,7 @@
(make-let-frame vname rest-bindings body local)
kont)))))))))
;; Reactive signal tracking — captures dependency continuation for re-render
(define
step-sf-define
(fn
@@ -1642,6 +1831,13 @@
env
(kont-push (make-set-frame (symbol-name (first args)) env) kont))))
;; ═══════════════════════════════════════════════════════════════
;; Part 9: Higher-Order Form Machinery
;;
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
;; argument evaluation, then dispatches to the appropriate step-ho-*.
;; ═══════════════════════════════════════════════════════════════
(define
step-sf-and
(fn
@@ -1721,7 +1917,6 @@
step-sf-lambda
(fn (args env kont) (make-cek-value (sf-lambda args env) env kont)))
;; Scope/provide/context — structured downward data passing
(define
step-sf-scope
(fn
@@ -1827,7 +2022,14 @@
env
kont))))
;; Delimited continuations
;; ═══════════════════════════════════════════════════════════════
;; Part 10: Continue Phase — Frame Dispatch
;;
;; When phase="continue", pop the top frame and process the value.
;; Each frame type has its own handling: if frames check truthiness,
;; let frames bind the value, arg frames accumulate it, etc.
;; continue-with-call handles the final function/component dispatch.
;; ═══════════════════════════════════════════════════════════════
(define
step-sf-reset
(fn
@@ -1837,6 +2039,9 @@
env
(kont-push (make-reset-frame env) kont))))
;; Final call dispatch from arg frame — all args evaluated, invoke function.
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
;; native fn (direct call), continuation (resume), callcc continuation (escape).
(define
step-sf-shift
(fn
@@ -1854,7 +2059,6 @@
(env-bind! shift-env k-name k)
(make-cek-state body shift-env rest-kont))))))
;; Signal dereferencing with reactive dependency tracking
(define
step-sf-deref
(fn
@@ -1865,11 +2069,11 @@
(kont-push (make-deref-frame env) kont))))
;; ═══════════════════════════════════════════════════════════════
;; Part 8: Call Dispatch
;; Part 11: Entry Points
;;
;; cek-call: invoke a function from native code (runs a nested
;; trampoline). step-eval-call: CEK-native call dispatch for
;; lambda, component, native fn, and continuations.
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
;; eval-expr / trampoline: top-level bindings that override the
;; forward declarations from Part 5.
;; ═══════════════════════════════════════════════════════════════
(define
cek-call
@@ -1884,7 +2088,6 @@
(cek-run (continue-with-call f a (make-env) a (list)))
:else nil))))
;; Reactive signal tracking — captures dependency continuation for re-render
(define
reactive-shift-deref
(fn
@@ -1920,13 +2123,6 @@
env
(kont-push (make-arg-frame nil (list) args env args hname) kont)))))
;; ═══════════════════════════════════════════════════════════════
;; Part 9: Higher-Order Form Machinery
;;
;; Data-first HO forms: (map coll fn) and (map fn coll) both work.
;; ho-swap-args auto-detects argument order. HoSetupFrame stages
;; argument evaluation, then dispatches to the appropriate step-ho-*.
;; ═══════════════════════════════════════════════════════════════
(define
ho-form-name?
(fn
@@ -2150,14 +2346,6 @@
(make-ho-setup-frame "for-each" (rest args) (list) env)
kont))))
;; ═══════════════════════════════════════════════════════════════
;; Part 10: Continue Phase — Frame Dispatch
;;
;; When phase="continue", pop the top frame and process the value.
;; Each frame type has its own handling: if frames check truthiness,
;; let frames bind the value, arg frames accumulate it, etc.
;; continue-with-call handles the final function/component dispatch.
;; ═══════════════════════════════════════════════════════════════
(define
step-continue
(fn
@@ -2810,14 +2998,39 @@
(get frame "env")
(list k)
rest-k)))
("vm-resume"
(let
((resume-fn (get frame "f")))
(let
((result (apply resume-fn (list value))))
(if
(and (dict? result) (get result "__vm_suspended"))
(make-cek-suspended
(get result "request")
(get frame "env")
(kont-push
(make-vm-resume-frame
(get result "resume")
(get frame "env"))
rest-k))
(make-cek-value result (get frame "env") rest-k)))))
("perform" (make-cek-suspended value (get frame "env") rest-k))
("import"
(let
((import-set (get frame "args"))
(remaining-sets (get frame "remaining"))
(fenv (get frame "env")))
(do
(bind-import-set import-set fenv)
(if
(empty? remaining-sets)
(make-cek-value nil fenv rest-k)
(step-sf-import remaining-sets fenv rest-k)))))
(_
(do
(set! *last-error-kont* rest-k)
(error (str "Unknown frame type: " ft))))))))))
;; Final call dispatch from arg frame — all args evaluated, invoke function.
;; Handles: lambda (bind params + TCO), component (keyword args + TCO),
;; native fn (direct call), continuation (resume), callcc continuation (escape).
(define
continue-with-call
(fn
@@ -2866,10 +3079,17 @@
(slice params (len args))))
(let
((jit-result (jit-try-call f args)))
(if
(cond
(nil? jit-result)
(make-cek-state (lambda-body f) local kont)
(make-cek-value jit-result local kont))))
(and (dict? jit-result) (get jit-result "__vm_suspended"))
(make-cek-suspended
(get jit-result "request")
env
(kont-push
(make-vm-resume-frame (get jit-result "resume") env)
kont))
:else (make-cek-value jit-result local kont))))
(or (component? f) (island? f))
(let
((parsed (parse-keyword-args raw-args env))
@@ -2909,13 +3129,6 @@
(make-cek-state body env kont)
(sf-case-step-loop match-val (slice clauses 2) env kont))))))))
;; ═══════════════════════════════════════════════════════════════
;; Part 11: Entry Points
;;
;; eval-expr-cek / trampoline-cek: CEK evaluation entry points.
;; eval-expr / trampoline: top-level bindings that override the
;; forward declarations from Part 5.
;; ═══════════════════════════════════════════════════════════════
(define
eval-expr-cek
(fn (expr env) (cek-run (make-cek-state expr env (list)))))

209
spec/tests/test-io-suspension.sx Normal file
View File

@@ -0,0 +1,209 @@
;; IO suspension tests — verifies perform/cek-step-loop/cek-resume
(defsuite
"io-suspend-basic"
(deftest
"perform creates suspended state"
(let
((state (cek-step-loop (make-cek-state (quote (perform {:op "test"})) (make-env) (list)))))
(assert (cek-suspended? state))
(assert (not (cek-terminal? state)))))
(deftest
"suspended state carries IO request"
(let
((state (cek-step-loop (make-cek-state (quote (perform {:service "blog" :op "query"})) (make-env) (list)))))
(let
((req (cek-io-request state)))
(assert= (get req "op") "query")
(assert= (get req "service") "blog"))))
(deftest
"cek-resume delivers result"
(let
((state (cek-step-loop (make-cek-state (quote (perform {:op "test"})) (make-env) (list)))))
(let
((final (cek-resume state 42)))
(assert (cek-terminal? final))
(assert= (cek-value final) 42))))
(deftest
"cek-resume with string result"
(let
((state (cek-step-loop (make-cek-state (quote (perform {:op "test"})) (make-env) (list)))))
(let
((final (cek-resume state "hello")))
(assert (cek-terminal? final))
(assert= (cek-value final) "hello"))))
(deftest
"cek-run errors on suspension"
(let
((result (cek-try (fn () (cek-run (make-cek-state (quote (perform {:op "test"})) (make-env) (list)))))))
(assert= (symbol-name (first result)) "error"))))
(defsuite
"io-suspend-control-flow"
(deftest
"perform inside let — result used in binding"
(let
((state (cek-step-loop (make-cek-state (quote (let ((x (perform {:op "get-value"}))) (+ x 10))) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state 32)))
(assert (cek-terminal? final))
(assert= (cek-value final) 42))))
(deftest
"perform inside if condition"
(let
((state (cek-step-loop (make-cek-state (quote (if (perform {:op "check"}) "yes" "no")) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state true)))
(assert (cek-terminal? final))
(assert= (cek-value final) "yes"))))
(deftest
"perform inside if — false branch"
(let
((state (cek-step-loop (make-cek-state (quote (if (perform {:op "check"}) "yes" "no")) (make-env) (list)))))
(let
((final (cek-resume state false)))
(assert (cek-terminal? final))
(assert= (cek-value final) "no"))))
(deftest
"sequential performs — two suspensions"
(let
((state1 (cek-step-loop (make-cek-state (quote (let ((a (perform {:op "first"}))) (let ((b (perform {:op "second"}))) (+ a b)))) (make-env) (list)))))
(assert (cek-suspended? state1))
(assert= (get (cek-io-request state1) "op") "first")
(let
((state2 (cek-resume state1 10)))
(assert (cek-suspended? state2))
(assert= (get (cek-io-request state2) "op") "second")
(let
((final (cek-resume state2 32)))
(assert (cek-terminal? final))
(assert= (cek-value final) 42)))))
(deftest
"perform inside begin — not last expr"
(let
((state (cek-step-loop (make-cek-state (quote (begin (perform {:op "side-effect"}) "done")) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state nil)))
(assert (cek-terminal? final))
(assert= (cek-value final) "done")))))
(defsuite
"io-suspend-functions"
(deftest
"perform inside lambda"
(let
((state (cek-step-loop (make-cek-state (quote ((fn (x) (+ x (perform {:op "get"}))) 10)) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state 32)))
(assert (cek-terminal? final))
(assert= (cek-value final) 42))))
(deftest
"perform result passed to function"
(let
((state (cek-step-loop (make-cek-state (quote (let ((double (fn (x) (* x 2)))) (double (perform {:op "get-val"})))) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state 21)))
(assert (cek-terminal? final))
(assert= (cek-value final) 42)))))
(defsuite
"io-suspend-values"
(deftest
"resume with nil"
(let
((state (cek-step-loop (make-cek-state (quote (perform {:op "test"})) (make-env) (list)))))
(let
((final (cek-resume state nil)))
(assert (cek-terminal? final))
(assert (nil? (cek-value final))))))
(deftest
"resume with list"
(let
((state (cek-step-loop (make-cek-state (quote (perform {:op "fetch"})) (make-env) (list)))))
(let
((final (cek-resume state (list 1 2 3))))
(assert (cek-terminal? final))
(assert= (len (cek-value final)) 3))))
(deftest
"resume with dict"
(let
((state (cek-step-loop (make-cek-state (quote (let ((result (perform {:op "query"}))) (get result "name"))) (make-env) (list)))))
(let
((final (cek-resume state {:name "alice"})))
(assert (cek-terminal? final))
(assert= (cek-value final) "alice")))))
(defsuite
"io-suspend-jit"
(deftest
"named function with perform suspends"
(let
((state (cek-step-loop (make-cek-state (quote (begin (define fetch-data (fn (key) (perform {:op "fetch" :key key}))) (fetch-data "users"))) (make-env) (list)))))
(assert (cek-suspended? state))
(assert= (get (cek-io-request state) "op") "fetch")
(let
((final (cek-resume state (list "alice" "bob"))))
(assert (cek-terminal? final))
(assert= (len (cek-value final)) 2))))
(deftest
"named function with perform and computation"
(let
((state (cek-step-loop (make-cek-state (quote (begin (define fetch-and-count (fn (key) (let ((data (perform {:op "fetch" :key key}))) (len data)))) (fetch-and-count "items"))) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state (list 1 2 3 4 5))))
(assert (cek-terminal? final))
(assert= (cek-value final) 5))))
(deftest
"two named functions with sequential performs"
(let
((state1 (cek-step-loop (make-cek-state (quote (begin (define get-name (fn () (perform {:op "get-name"}))) (define get-age (fn () (perform {:op "get-age"}))) (str (get-name) " is " (get-age) " years old"))) (make-env) (list)))))
(assert (cek-suspended? state1))
(assert= (get (cek-io-request state1) "op") "get-name")
(let
((state2 (cek-resume state1 "Alice")))
(assert (cek-suspended? state2))
(assert= (get (cek-io-request state2) "op") "get-age")
(let
((final (cek-resume state2 30)))
(assert (cek-terminal? final))
(assert= (cek-value final) "Alice is 30 years old"))))))
(defsuite
"io-suspend-cross-boundary"
(deftest
"function calling component that performs IO"
(let
((state (cek-step-loop (make-cek-state (quote (begin (defcomp ~data-loader (&key source) (perform {:op "load" :source source})) (define render (fn (src) (let ((data (~data-loader :source src))) (str "loaded: " (len data) " items")))) (render "products"))) (make-env) (list)))))
(assert (cek-suspended? state))
(assert= (get (cek-io-request state) "op") "load")
(assert= (get (cek-io-request state) "source") "products")
(let
((final (cek-resume state (list "a" "b" "c"))))
(assert (cek-terminal? final))
(assert= (cek-value final) "loaded: 3 items")))))
(defsuite
"io-suspend-error-handling"
(deftest
"guard wraps perform — normal completion"
(let
((state (cek-step-loop (make-cek-state (quote (guard (e (true (str "caught: " e))) (perform {:op "get"}))) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state "ok-result")))
(assert (cek-terminal? final))
(assert= (cek-value final) "ok-result"))))
(deftest
"perform result flows through let in guard body"
(let
((state (cek-step-loop (make-cek-state (quote (guard (e (true "error")) (let ((x (perform {:op "get"}))) (+ x 1)))) (make-env) (list)))))
(assert (cek-suspended? state))
(let
((final (cek-resume state 41)))
(assert (cek-terminal? final))
(assert= (cek-value final) 42)))))

91
spec/tests/test-modules.sx Normal file
View File

@@ -0,0 +1,91 @@
;; R7RS module system tests — define-library / import
(defsuite
"define-library-basic"
(deftest
"define and import a library"
(define-library
(test math)
(export add square)
(begin
(define add (fn (a b) (+ a b)))
(define square (fn (x) (* x x)))))
(import (test math))
(assert= (add 3 4) 7)
(assert= (square 5) 25))
(deftest
"library isolation — internal not exported"
(define-library
(test internal)
(export public-fn)
(begin
(define helper (fn (x) (* x 2)))
(define public-fn (fn (x) (helper (+ x 1))))))
(import (test internal))
(assert= (public-fn 5) 12))
(deftest
"multiple libraries"
(define-library
(test greet)
(export greet)
(begin (define greet (fn (name) (str "Hello, " name "!")))))
(define-library
(test format)
(export shout)
(begin (define shout (fn (s) (upper s)))))
(import (test greet))
(import (test format))
(assert= (greet "world") "Hello, world!")
(assert= (shout "hello") "HELLO")))
(defsuite
"import-qualifiers"
(deftest
"import with only"
(define-library
(test utils)
(export inc dec double)
(begin
(define inc (fn (x) (+ x 1)))
(define dec (fn (x) (- x 1)))
(define double (fn (x) (* x 2)))))
(import (only (test utils) inc double))
(assert= (inc 5) 6)
(assert= (double 5) 10))
(deftest
"import with prefix"
(define-library
(test prefixed)
(export value)
(begin (define value 42)))
(import (prefix (test prefixed) tp:))
(assert= tp:value 42)))
(defsuite
"library-registry"
(deftest
"library-loaded? returns true after define"
(define-library (test check) (export x) (begin (define x 1)))
(assert (library-loaded? (quote (test check)))))
(deftest
"library-loaded? returns false for unknown"
(assert (not (library-loaded? (quote (nonexistent lib)))))))
(defsuite
"import-suspension"
(deftest
"import of unknown library suspends"
(let
((state (cek-step-loop (make-cek-state (quote (import (remote data))) (make-env) (list)))))
(assert (cek-suspended? state))
(assert= (get (cek-io-request state) "op") "import")))
(deftest
"import suspension resumes after library registered"
(let
((state (cek-step-loop (make-cek-state (quote (begin (import (lazy lib)) (get-value))) (make-env) (list)))))
(assert (cek-suspended? state))
(register-library (quote (lazy lib)) {:get-value (fn () 42)})
(let
((final (cek-resume state nil)))
(assert (cek-terminal? final))
(assert= (cek-value final) 42)))))