giles
e200935698
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 26s
eval.sx adds quasiquote / unquote / unquote-splicing as syntactic operators with the canonical R7RS walker: - (quasiquote X) — top-level entry to scm-quasi-walk - (unquote X) — at depth-0, evaluates X in env - (unquote-splicing X) — inside a list, splices X's list value - Reader-macro sugar: `X / ,X / ,@X work via Phase 1 parser Algorithm identical to lib/kernel/runtime.sx's knl-quasi-walk: - Walk template recursively - Non-list: pass through - ($unquote/unquote X) head form: eval X - Inside a list, ($unquote-splicing/unquote-splicing X) head: eval X, splice list into surrounding context - Otherwise: recurse on each element No depth-tracking yet — nested quasiquotes are not properly handled (matches Kernel's deferred state). 10 tests: plain atom/list, unquote substitution, splicing at start/middle/end, nested list with unquote, unquote evaluates expression, error on non-list splice, error on bare unquote. **Second consumer for lib/guest/reflective/quoting.sx unlocked.** Both Kernel and Scheme have structurally identical walkers; the extraction would parameterise just the unquote/splicing keyword names (Kernel uses $unquote / $unquote-splicing; Scheme uses unquote / unquote-splicing — pure cfg, no algorithmic change). 280 total Scheme tests (62+23+49+78+25+20+13+10). Three reflective-kit extractions unlocked in this Scheme port: - env.sx — Phase 2 (consumed directly, third overall consumer) - evaluator.sx — Phase 7 (second consumer via eval/interaction-env) - quoting.sx — Phase 10 (second consumer via scm-quasi-walk) The kit extractions themselves remain follow-on commits when desired. hygiene.sx still awaits a real second consumer (Scheme phase 6c with scope-set algorithm).
131 lines
4.5 KiB
Plaintext
131 lines
4.5 KiB
Plaintext
;; lib/scheme/tests/reflection.sx — Phase 7 reflective primitives.
|
|
|
|
(define scm-ref-pass 0)
|
|
(define scm-ref-fail 0)
|
|
(define scm-ref-fails (list))
|
|
|
|
(define
|
|
scm-ref-test
|
|
(fn
|
|
(name actual expected)
|
|
(if
|
|
(= actual expected)
|
|
(set! scm-ref-pass (+ scm-ref-pass 1))
|
|
(begin
|
|
(set! scm-ref-fail (+ scm-ref-fail 1))
|
|
(append! scm-ref-fails {:name name :actual actual :expected expected})))))
|
|
|
|
(define
|
|
scm-ref
|
|
(fn (src) (scheme-eval (scheme-parse src) (scheme-standard-env))))
|
|
|
|
(define
|
|
scm-ref-all
|
|
(fn
|
|
(src)
|
|
(scheme-eval-program (scheme-parse-all src) (scheme-standard-env))))
|
|
|
|
;; ── eval ─────────────────────────────────────────────────────────
|
|
|
|
(scm-ref-test
|
|
"eval: arithmetic"
|
|
(scm-ref "(eval '(+ 1 2 3) (interaction-environment))")
|
|
6)
|
|
(scm-ref-test
|
|
"eval: nested"
|
|
(scm-ref "(eval '(* (+ 1 2) (- 5 1)) (interaction-environment))")
|
|
12)
|
|
(scm-ref-test
|
|
"eval: constructed form"
|
|
(scm-ref "(eval (list '+ 10 20) (interaction-environment))")
|
|
30)
|
|
(scm-ref-test
|
|
"eval: variable reference"
|
|
(scm-ref-all "(define x 42) (eval 'x (interaction-environment))")
|
|
42)
|
|
|
|
;; ── interaction-environment ─────────────────────────────────────
|
|
|
|
(scm-ref-test
|
|
"interaction-environment: is an env"
|
|
(scm-ref "(environment? (interaction-environment))")
|
|
true)
|
|
(scm-ref-test
|
|
"interaction-environment: define persists"
|
|
(scm-ref-all
|
|
"(define ie (interaction-environment))\n (eval '(define stashed 99) ie)\n (eval 'stashed ie)")
|
|
99)
|
|
(scm-ref-test
|
|
"interaction-environment: same env across calls"
|
|
(scm-ref-all
|
|
"(define a (interaction-environment))\n (define b (interaction-environment))\n (eqv? a b)")
|
|
true)
|
|
|
|
;; ── null-environment ────────────────────────────────────────────
|
|
|
|
(scm-ref-test
|
|
"null-environment: is an env"
|
|
(scm-ref "(environment? (null-environment 7))")
|
|
true)
|
|
(scm-ref-test
|
|
"null-environment: has no + binding"
|
|
(scm-ref-all
|
|
"(define ne (null-environment 7))\n (guard (e (else 'unbound)) (eval '+ ne))")
|
|
"unbound")
|
|
|
|
;; ── scheme-report-environment ───────────────────────────────────
|
|
|
|
(scm-ref-test
|
|
"scheme-report-environment: is an env"
|
|
(scm-ref "(environment? (scheme-report-environment 7))")
|
|
true)
|
|
(scm-ref-test
|
|
"scheme-report-environment: has +"
|
|
(scm-ref "(eval '(+ 1 2) (scheme-report-environment 7))")
|
|
3)
|
|
(scm-ref-test
|
|
"scheme-report-environment: distinct from interaction"
|
|
(scm-ref-all
|
|
"(define ie (interaction-environment))\n (define re (scheme-report-environment 7))\n (eval '(define only-in-ie 1) ie)\n (guard (e (else 'unbound)) (eval 'only-in-ie re))")
|
|
"unbound")
|
|
|
|
;; ── eval with explicit env for sandboxing ──────────────────────
|
|
|
|
(scm-ref-test
|
|
"eval: sandbox with null-environment"
|
|
(scm-ref-all
|
|
"(define sandbox (null-environment 7))\n (guard (e (else 'unbound))\n (eval '(+ 1 1) sandbox))")
|
|
"unbound")
|
|
|
|
;; ── quasiquote / unquote / unquote-splicing ─────────────────────
|
|
(scm-ref-test "qq: plain atom"
|
|
(scm-ref "`hello") "hello")
|
|
(scm-ref-test "qq: plain list"
|
|
(scm-ref "`(a b c)") (list "a" "b" "c"))
|
|
(scm-ref-test "qq: unquote substitutes value"
|
|
(scm-ref-all "(define x 42) `(a ,x b)")
|
|
(list "a" 42 "b"))
|
|
(scm-ref-test "qq: unquote-splicing splices list"
|
|
(scm-ref-all "(define xs '(1 2 3)) `(a ,@xs b)")
|
|
(list "a" 1 2 3 "b"))
|
|
(scm-ref-test "qq: splice at start"
|
|
(scm-ref-all "(define xs '(1 2)) `(,@xs c)")
|
|
(list 1 2 "c"))
|
|
(scm-ref-test "qq: splice at end"
|
|
(scm-ref-all "(define xs '(9 8)) `(a b ,@xs)")
|
|
(list "a" "b" 9 8))
|
|
(scm-ref-test "qq: nested list with unquote"
|
|
(scm-ref-all "(define x 5) `(a (b ,x) c)")
|
|
(list "a" (list "b" 5) "c"))
|
|
(scm-ref-test "qq: unquote evaluates expression"
|
|
(scm-ref "`(a ,(+ 1 2) b)")
|
|
(list "a" 3 "b"))
|
|
(scm-ref-test "qq: error on splicing non-list"
|
|
(scm-ref-all
|
|
"(define x 42) (guard (e (else 'raised)) `(a ,@x b))")
|
|
"raised")
|
|
(scm-ref-test "qq: bare unquote at top level errors"
|
|
(scm-ref "(guard (e (else 'raised)) (unquote 5))") "raised")
|
|
|
|
(define scm-ref-tests-run! (fn () {:total (+ scm-ref-pass scm-ref-fail) :passed scm-ref-pass :failed scm-ref-fail :fails scm-ref-fails}))
|