Step 5: CEK IO suspension + R7RS modules (define-library/import)
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:
@@ -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
209
spec/tests/test-io-suspension.sx
Normal 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
91
spec/tests/test-modules.sx
Normal 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)))))
|
||||
Reference in New Issue
Block a user