From e2009356986d891f289a4010a44381e4f6bd7503 Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 14 May 2026 06:47:51 +0000 Subject: [PATCH] =?UTF-8?q?scheme:=20Phase=2010=20=E2=80=94=20quasiquote?= =?UTF-8?q?=20runtime=20+=2010=20tests=20[shapes-reflective]?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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). --- lib/scheme/eval.sx | 70 ++++++++++++++++++++++++++++++++++ lib/scheme/tests/reflection.sx | 30 +++++++++++++++ 2 files changed, 100 insertions(+) diff --git a/lib/scheme/eval.sx b/lib/scheme/eval.sx index f0df7b48..fdcf01b4 100644 --- a/lib/scheme/eval.sx +++ b/lib/scheme/eval.sx @@ -334,6 +334,76 @@ (scheme-define-op! "or" (fn (args env) (scm-or-step args env))) +;; ── quasiquote (R7RS backquote runtime) ───────────────────────── +;; Walks the template form. At depth 0 (the most common case): +;; (unquote X) → (scheme-eval X env) +;; (unquote-splicing X) → spliced into surrounding list +;; (quasiquote X) → bumps depth (nested) — kept literal in +;; simple R7RS; full depth tracking only +;; when nested quasiquotes appear in practice. +;; +;; Algorithm is identical to kernel's knl-quasi-walk; the shared +;; structure is the second-consumer candidate for +;; lib/guest/reflective/quoting.sx. + +(define scm-quasi-walk + (fn (form env) + (cond + ((not (list? form)) form) + ((= (length form) 0) form) + ((and (string? (first form)) (= (first form) "unquote")) + (cond + ((not (= (length form) 2)) + (error "unquote: expects exactly 1 argument")) + (:else (scheme-eval (nth form 1) env)))) + (:else (scm-quasi-walk-list form env))))) + +(define scm-quasi-walk-list + (fn (forms env) + (cond + ((or (nil? forms) (= (length forms) 0)) (list)) + (:else + (let ((head (first forms))) + (cond + ((and (list? head) + (= (length head) 2) + (string? (first head)) + (= (first head) "unquote-splicing")) + (let ((spliced (scheme-eval (nth head 1) env))) + (cond + ((not (list? spliced)) + (error "unquote-splicing: value must be a list")) + (:else + (scm-list-concat + spliced + (scm-quasi-walk-list (rest forms) env)))))) + (:else + (cons (scm-quasi-walk head env) + (scm-quasi-walk-list (rest forms) env))))))))) + +(define scm-list-concat + (fn (xs ys) + (cond + ((or (nil? xs) (= (length xs) 0)) ys) + (:else (cons (first xs) (scm-list-concat (rest xs) ys)))))) + +(scheme-define-op! "quasiquote" + (fn (args env) + (cond + ((not (= (length args) 1)) + (error "quasiquote: expects exactly 1 argument")) + (:else (scm-quasi-walk (first args) env))))) + +;; unquote / unquote-splicing at top level (outside quasiquote) +;; are errors per R7RS. We still bind them as ops so a more useful +;; message fires than "unbound symbol". +(scheme-define-op! "unquote" + (fn (args env) + (error "unquote: only valid inside quasiquote"))) +(scheme-define-op! "unquote-splicing" + (fn (args env) + (error "unquote-splicing: only valid inside quasiquote"))) + ;; ── syntax-rules / define-syntax (Phase 6a — no ellipsis yet) ──── ;; ;; Macros are tagged values: diff --git a/lib/scheme/tests/reflection.sx b/lib/scheme/tests/reflection.sx index 2cb3410c..1603557d 100644 --- a/lib/scheme/tests/reflection.sx +++ b/lib/scheme/tests/reflection.sx @@ -97,4 +97,34 @@ "(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}))