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

reflective: extract quoting.sx — Kernel + Scheme share quasiquote walker
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
Details

Browse Source 
lib/guest/reflective/quoting.sx — quasiquote walker with adapter cfg.
Three forms:
- refl-quasi-walk-with CFG FORM ENV       (top-level)
- refl-quasi-walk-list-with CFG FORMS ENV (list walker, splice-aware)
- refl-quasi-list-concat XS YS            (pure-SX helper)

Adapter cfg keys:
- :unquote-name           — string keyword ("$unquote" or "unquote")
- :unquote-splicing-name  — string keyword
- :eval                   — fn (form env) → value

The shared algorithm is identical in Kernel and Scheme; the only
divergences are the keyword names (`$unquote` vs `unquote`) and
which host evaluator runs at unquote points (`kernel-eval` vs
`scheme-eval`). Both surface through the cfg.

Migrations:
- lib/kernel/runtime.sx: knl-quasi-walk reduces to a 3-line wrapper
  that builds knl-quasi-cfg and delegates. Removed knl-quasi-walk-
  list + knl-list-concat (~40 LoC) — now provided by the kit.
- lib/scheme/eval.sx: scm-quasi-walk reduces to a 3-line wrapper
  around scm-quasi-cfg. Removed scm-quasi-walk-list + scm-list-
  concat. scm-collect-exports (module impl) was a hidden consumer
  of scm-list-concat — rewired to refl-quasi-list-concat.

lib/scheme/test.sh — loads lib/guest/reflective/quoting.sx before
lib/scheme/parser.sx so the kit is available when eval.sx loads.

Both consumers' tests green:
- Kernel: 322 tests across 7 suites
- Scheme: 296 tests across 9 suites

**Second reflective-kit extraction landed.** The kit-extraction
playbook from env.sx and class-chain.sx — adapter-cfg pattern from
lib/guest/match.sx, same algorithm bridges different keyword names —
works again on a third structurally different problem (quasiquote
walking). The cumulative extraction story: env.sx → class-chain.sx
→ quoting.sx, three independent kits, all using the same pattern.

`evaluator.sx` (the other deferred candidate the Scheme port
unlocked) is NOT extracted — the genuinely shared content is too
thin (one helper for closure-capturing interaction-environment).
The eval-protocol is more about API surface than algorithm.
Documented as a non-extraction.
This commit is contained in:
giles
2026-05-14 07:54:15 +00:00
parent 26112f1003
commit 818e68a2f8
4 changed files with 99 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

77
lib/guest/reflective/quoting.sx Normal file
View File

@@ -0,0 +1,77 @@
;; lib/guest/reflective/quoting.sx — quasiquote walker.
;;
;; Extracted from Kernel's `knl-quasi-walk` and Scheme's `scm-quasi-walk`,
;; which differ only in:
;; - the unquote keyword name (Kernel: "$unquote" / "$unquote-splicing";
;; Scheme: "unquote" / "unquote-splicing")
;; - the host evaluator function (`kernel-eval` vs `scheme-eval`)
;;
;; Algorithm is identical. Adapter cfg parameterises the two
;; language-specific knobs.
;;
;; Adapter cfg keys
;; ----------------
;; :unquote-name — string, name of the unquote keyword
;; :unquote-splicing-name — string, name of the splice keyword
;; :eval — fn (form env) → value
;;
;; Public API
;; (refl-quasi-walk-with CFG FORM ENV)
;; Top-level walker. Returns FORM with unquotes evaluated in ENV.
;;
;; (refl-quasi-walk-list-with CFG FORMS ENV)
;; Walks a list of forms, splicing unquote-splicing results inline.
;;
;; (refl-quasi-list-concat XS YS)
;; Pure-SX list append (no host append/append! needed).
(define
refl-quasi-list-concat
(fn
(xs ys)
(cond
((or (nil? xs) (= (length xs) 0)) ys)
(:else (cons (first xs) (refl-quasi-list-concat (rest xs) ys))))))
(define
refl-quasi-walk-with
(fn
(cfg form env)
(cond
((not (list? form)) form)
((= (length form) 0) form)
((and (string? (first form)) (= (first form) (get cfg :unquote-name)))
(cond
((not (= (length form) 2))
(error
(str (get cfg :unquote-name) ": expects exactly 1 argument")))
(:else ((get cfg :eval) (nth form 1) env))))
(:else (refl-quasi-walk-list-with cfg form env)))))
(define
refl-quasi-walk-list-with
(fn
(cfg 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) (get cfg :unquote-splicing-name)))
(let
((spliced ((get cfg :eval) (nth head 1) env)))
(cond
((not (list? spliced))
(error
(str
(get cfg :unquote-splicing-name)
": value must be a list")))
(:else
(refl-quasi-list-concat
spliced
(refl-quasi-walk-list-with cfg (rest forms) env))))))
(:else
(cons
(refl-quasi-walk-with cfg head env)
(refl-quasi-walk-list-with cfg (rest forms) env)))))))))

50
lib/kernel/runtime.sx
View File

@@ -194,48 +194,18 @@
((not (= (length args) 1)) (error "$quote: expects 1 argument"))
(:else (first args))))))
;; Quasiquote: walks the template, evaluating `$unquote` forms in the
;; dynamic env and splicing `$unquote-splicing` list results.
;; Kernel-side adapter for lib/guest/reflective/quoting.sx.
;; Kernel uses $unquote / $unquote-splicing (dollar-prefixed) and the
;; host-level kernel-eval as the evaluator. The walker algorithm
;; itself is shared with Scheme via the kit.
(define knl-quasi-cfg
{:unquote-name "$unquote"
:unquote-splicing-name "$unquote-splicing"
:eval (fn (form env) (kernel-eval form env))})
(define knl-quasi-walk
(fn (form dyn-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 (kernel-eval (nth form 1) dyn-env))))
(:else (knl-quasi-walk-list form dyn-env)))))
(define knl-quasi-walk-list
(fn (forms dyn-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 (kernel-eval (nth head 1) dyn-env)))
(cond
((not (list? spliced))
(error "$unquote-splicing: value must be a list"))
(:else
(knl-list-concat
spliced
(knl-quasi-walk-list (rest forms) dyn-env))))))
(:else
(cons (knl-quasi-walk head dyn-env)
(knl-quasi-walk-list (rest forms) dyn-env)))))))))
(define knl-list-concat
(fn (xs ys)
(cond
((or (nil? xs) (= (length xs) 0)) ys)
(:else (cons (first xs) (knl-list-concat (rest xs) ys))))))
(refl-quasi-walk-with knl-quasi-cfg form dyn-env)))
;; $cond — multi-clause branch.
;; ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)

50
lib/scheme/eval.sx
View File

@@ -346,46 +346,18 @@
;; structure is the second-consumer candidate for
;; lib/guest/reflective/quoting.sx.
;; Scheme-side adapter for lib/guest/reflective/quoting.sx. Scheme
;; uses the bare unquote / unquote-splicing keywords and scheme-eval
;; as the host evaluator. Walker algorithm shared with Kernel via
;; the kit.
(define scm-quasi-cfg
{:unquote-name "unquote"
:unquote-splicing-name "unquote-splicing"
:eval (fn (form env) (scheme-eval form env))})
(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))))))
(refl-quasi-walk-with scm-quasi-cfg form env)))
(scheme-define-op! "quasiquote"
(fn (args env)
@@ -614,7 +586,7 @@
((and (list? form) (>= (length form) 1)
(string? (first form)) (= (first form) "export"))
(scm-collect-exports (rest forms)
(scm-list-concat acc (rest form))))
(refl-quasi-list-concat acc (rest form))))
(:else (scm-collect-exports (rest forms) acc))))))))
(define scm-run-library-body

1
lib/scheme/test.sh
View File

@@ -41,6 +41,7 @@ emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1));
{
emit_load "lib/guest/lex.sx"
emit_load "lib/guest/reflective/env.sx"
emit_load "lib/guest/reflective/quoting.sx"
emit_load "lib/scheme/parser.sx"
emit_load "lib/scheme/eval.sx"
emit_load "lib/scheme/runtime.sx"