Merge lib/guest/quoting into architecture: quoting.sx + Kernel/Scheme migrations
This commit is contained in:
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)))))))))
|
||||
Reference in New Issue
Block a user