giles
e3e5d3e888
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
scheme-standard-env binds: - call/cc — primary - call-with-current-continuation — alias Implementation wraps SX's host call/cc, presenting the captured continuation k as a Scheme procedure that accepts a single value (or a list of values for multi-arg invocation). Single-shot escape semantics: when k is invoked, control jumps out of the surrounding call/cc form. Multi-shot re-entry isn't safely testable without delimited-continuation infrastructure (the captured continuation re-enters indefinitely if invoked after the call/cc returns) — deferred to a follow-up commit if needed. Tests cover: - No-escape return value - Escape past arithmetic frames - Detect/early-exit idiom over for-each - Procedure? on the captured k 220 total Scheme tests now (62 + 23 + 49 + 78 + 8).
73 lines
2.5 KiB
Plaintext
73 lines
2.5 KiB
Plaintext
;; lib/scheme/tests/control.sx — call/cc, dynamic-wind, exceptions.
|
|
|
|
(define scm-ctl-pass 0)
|
|
(define scm-ctl-fail 0)
|
|
(define scm-ctl-fails (list))
|
|
|
|
(define
|
|
scm-ctl-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! scm-ctl-pass (+ scm-ctl-pass 1))
|
|
(begin
|
|
(set! scm-ctl-fail (+ scm-ctl-fail 1))
|
|
(append! scm-ctl-fails {:name name :actual actual :expected expected})))))
|
|
|
|
(define
|
|
scm-ctl
|
|
(fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
|
|
|
|
(define
|
|
scm-ctl-all
|
|
(fn
|
|
(src)
|
|
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
|
|
|
|
;; ── call/cc — escape continuations ──────────────────────────────
|
|
;; Single-shot only: when k is invoked, control jumps out of the
|
|
;; surrounding call/cc and the result of the entire call/cc form is
|
|
;; whatever was passed to k.
|
|
|
|
(scm-ctl-test
|
|
"call/cc: no escape"
|
|
(scm-ctl "(call/cc (lambda (k) 42))")
|
|
42)
|
|
(scm-ctl-test
|
|
"call/cc: simple escape"
|
|
(scm-ctl "(call/cc (lambda (k) (+ 1 (k 42))))")
|
|
42)
|
|
(scm-ctl-test
|
|
"call/cc: escape past *"
|
|
(scm-ctl "(+ 10 (call/cc (lambda (k) (* 2 (k 5)))))")
|
|
15)
|
|
(scm-ctl-test
|
|
"call/cc: alias call-with-current-continuation"
|
|
(scm-ctl "(call-with-current-continuation (lambda (k) (k 99)))")
|
|
99)
|
|
(scm-ctl-test
|
|
"call/cc: doesn't escape if k unused"
|
|
(scm-ctl "(+ 1 (call/cc (lambda (k) (* 100 1))))")
|
|
101)
|
|
|
|
;; ── call/cc as early-exit for list search ───────────────────────
|
|
(scm-ctl-test
|
|
"call/cc: detect-via-escape"
|
|
(scm-ctl-all
|
|
"(define (detect pred xs)\n (call/cc\n (lambda (return)\n (for-each\n (lambda (x) (if (pred x) (return x) #f))\n xs)\n #f)))\n (detect (lambda (x) (> x 10)) '(1 5 7 12 20))")
|
|
12)
|
|
(scm-ctl-test
|
|
"call/cc: detect returns #f when no match"
|
|
(scm-ctl-all
|
|
"(define (detect pred xs)\n (call/cc\n (lambda (return)\n (for-each\n (lambda (x) (if (pred x) (return x) #f))\n xs)\n #f)))\n (detect (lambda (x) (> x 100)) '(1 5 7))")
|
|
false)
|
|
|
|
;; ── call/cc producing the captured k value ──────────────────────
|
|
(scm-ctl-test
|
|
"call/cc: k is a procedure"
|
|
(scm-ctl "(procedure? (call/cc (lambda (k) k)))")
|
|
true)
|
|
|
|
(define scm-ctl-tests-run! (fn () {:total (+ scm-ctl-pass scm-ctl-fail) :passed scm-ctl-pass :failed scm-ctl-fail :fails scm-ctl-fails}))
|