Merge lib/guest/quoting into architecture: quoting.sx + Kernel/Scheme migrations

lib/guest/reflective/quoting.sx

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

lib/kernel/runtime.sx

@@ -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 ...) ...)

lib/scheme/eval.sx

@@ -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

lib/scheme/test.sh

@@ -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"