Compare commits
2 Commits
loops/sche
...
lib/guest/
| Author | SHA1 | Date | |
|---|---|---|---|
| 90cd0f8f6f | |||
| 818e68a2f8 |
77
lib/guest/reflective/quoting.sx
Normal file
77
lib/guest/reflective/quoting.sx
Normal 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)))))))))
|
||||||
@@ -194,48 +194,18 @@
|
|||||||
((not (= (length args) 1)) (error "$quote: expects 1 argument"))
|
((not (= (length args) 1)) (error "$quote: expects 1 argument"))
|
||||||
(:else (first args))))))
|
(:else (first args))))))
|
||||||
|
|
||||||
;; Quasiquote: walks the template, evaluating `$unquote` forms in the
|
;; Kernel-side adapter for lib/guest/reflective/quoting.sx.
|
||||||
;; dynamic env and splicing `$unquote-splicing` list results.
|
;; 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
|
(define knl-quasi-walk
|
||||||
(fn (form dyn-env)
|
(fn (form dyn-env)
|
||||||
(cond
|
(refl-quasi-walk-with knl-quasi-cfg form dyn-env)))
|
||||||
((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))))))
|
|
||||||
|
|
||||||
;; $cond — multi-clause branch.
|
;; $cond — multi-clause branch.
|
||||||
;; ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)
|
;; ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)
|
||||||
|
|||||||
@@ -346,46 +346,18 @@
|
|||||||
;; structure is the second-consumer candidate for
|
;; structure is the second-consumer candidate for
|
||||||
;; lib/guest/reflective/quoting.sx.
|
;; 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
|
(define scm-quasi-walk
|
||||||
(fn (form env)
|
(fn (form env)
|
||||||
(cond
|
(refl-quasi-walk-with scm-quasi-cfg form env)))
|
||||||
((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"
|
(scheme-define-op! "quasiquote"
|
||||||
(fn (args env)
|
(fn (args env)
|
||||||
@@ -614,7 +586,7 @@
|
|||||||
((and (list? form) (>= (length form) 1)
|
((and (list? form) (>= (length form) 1)
|
||||||
(string? (first form)) (= (first form) "export"))
|
(string? (first form)) (= (first form) "export"))
|
||||||
(scm-collect-exports (rest forms)
|
(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))))))))
|
(:else (scm-collect-exports (rest forms) acc))))))))
|
||||||
|
|
||||||
(define scm-run-library-body
|
(define scm-run-library-body
|
||||||
|
|||||||
@@ -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/lex.sx"
|
||||||
emit_load "lib/guest/reflective/env.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/parser.sx"
|
||||||
emit_load "lib/scheme/eval.sx"
|
emit_load "lib/scheme/eval.sx"
|
||||||
emit_load "lib/scheme/runtime.sx"
|
emit_load "lib/scheme/runtime.sx"
|
||||||
|
|||||||
@@ -87,10 +87,13 @@ The whole interesting thing: there are no special forms hardcoded in the evaluat
|
|||||||
- [x] Bridge to SX's hygienic macro story; extends proposed `lib/guest/reflective/` with `$let` and `$define-in!` hygiene primitives.
|
- [x] Bridge to SX's hygienic macro story; extends proposed `lib/guest/reflective/` with `$let` and `$define-in!` hygiene primitives.
|
||||||
- [x] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings.
|
- [x] Tests: write an operative that introduces a binding and verify it doesn't shadow caller's same-named bindings.
|
||||||
|
|
||||||
### Phase 7 — Propose `lib/guest/reflective/` *[env.sx EXTRACTED 2026-05-12; other five still pending]*
|
### Phase 7 — Propose `lib/guest/reflective/` *[env.sx + quoting.sx EXTRACTED; class-chain.sx also extracted; evaluator.sx declined]*
|
||||||
- [x] Identified reusable env-reification + dispatch primitives across Phases 2–6. Consolidated API surface below as four candidate files: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`.
|
- [x] Identified reusable env-reification + dispatch primitives across Phases 2–6. Consolidated API surface below as four candidate files: `env.sx`, `combiner.sx`, `evaluator.sx`, `hygiene.sx`.
|
||||||
- [x] Second consumer found for **`env.sx`**: Tcl's `uplevel`/`upvar` machinery (`lib/tcl/runtime.sx`). Same scope-chain semantics, divergent only in mutable-vs-functional update — bridged via adapter-cfg pattern from `lib/guest/match.sx`. Extraction landed on branch `lib/tcl/uplevel` (see `plans/lib-guest-reflective.md`).
|
- [x] Second consumer found for **`env.sx`**: Tcl's `uplevel`/`upvar` machinery (`lib/tcl/runtime.sx`). Bridged via adapter-cfg pattern. Extraction on branch `lib/tcl/uplevel`. Third consumer: Smalltalk frame, then Scheme. (Three live consumers.)
|
||||||
- [ ] Second consumers still needed for `combiner.sx`, `evaluator.sx`, `hygiene.sx`, `quoting.sx`, `short-circuit.sx` — all five wait for a language with operative/applicative semantics (Scheme, CL fexpr extension, Maru).
|
- [x] Bonus: **`class-chain.sx`** extracted from Smalltalk + CLOS method dispatch (not on the original six-file list, but the same chiselling discipline surfaced it). Branch `lib/guest/method-chain`.
|
||||||
|
- [x] Second consumer found for **`quoting.sx`**: Scheme's `scm-quasi-walk` (`lib/scheme/eval.sx`). Algorithm identical to Kernel's `knl-quasi-walk`; only the unquote keyword name and host evaluator differ. Bridged via adapter cfg with `:unquote-name`/`:unquote-splicing-name`/`:eval`. Extraction on branch `lib/guest/quoting`.
|
||||||
|
- [x] **`evaluator.sx` extraction declined.** The genuinely shared content between Kernel's `(get-current-environment, make-environment, eval)` triple and Scheme's `(interaction-environment, null-environment/scheme-report-environment, eval)` is *protocol/API surface*, not algorithm. Each consumer has language-specific binding semantics. The only common helper would be a closure-capturing `make-self-returning-env-fn` (~5 lines), too thin for its own kit. The protocol itself stays documented below but does not become a `lib/guest/reflective/evaluator.sx` file.
|
||||||
|
- [ ] Second consumers still needed for `combiner.sx`, `hygiene.sx`, `short-circuit.sx`. `combiner.sx` and `short-circuit.sx` require a fexpr-having language (Maru, Klisp, CL-fexpr extension) — Scheme is not a fit. `hygiene.sx` is the deferred research-grade scope-set work; Scheme's Phase 6c would be the second consumer when it lands.
|
||||||
|
|
||||||
**Phase 7 status (updated 2026-05-12):** `env.sx` has been extracted and is live at `lib/guest/reflective/env.sx` on branch `lib/tcl/uplevel`. Both consumers (Kernel and Tcl) pass their full test suites unchanged (Kernel 322/322, Tcl 427/427). The remaining five candidate files stay documented-only until their respective second consumers materialise. Candidate second consumers in priority order: Candidate second consumers in priority order:
|
**Phase 7 status (updated 2026-05-12):** `env.sx` has been extracted and is live at `lib/guest/reflective/env.sx` on branch `lib/tcl/uplevel`. Both consumers (Kernel and Tcl) pass their full test suites unchanged (Kernel 322/322, Tcl 427/427). The remaining five candidate files stay documented-only until their respective second consumers materialise. Candidate second consumers in priority order: Candidate second consumers in priority order:
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user