;; 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)))))))))