scheme: Phase 2 evaluator — env.sx third consumer + 23 tests [consumes-env]

lib/scheme/eval.sx — R7RS evaluator skeleton:
- Self-evaluating: numbers, booleans, characters, vectors, strings
- Symbol lookup: refl-env-lookup
- Lists: syntactic-operator table dispatch, else applicative call
- Table-driven syntactic ops (Phase 2 wires `quote` only; full set
  in Phase 3)
- Apply: callable host fn or scheme closure (closure stub for Phase 3)

scheme-make-env / scheme-env-bind! / etc. are THIN ALIASES for the
refl-env-* primitives from lib/guest/reflective/env.sx. No adapter
cfg needed — Scheme's lexical-scope semantics ARE the canonical
wire shape. This is the THIRD CONSUMER for env.sx after Kernel and
Tcl + Smalltalk's variant adapters; the first to use it without
any bridging code. Validates the kit handles canonical-shape
adoption with zero ceremony.

23 tests in lib/scheme/tests/eval.sx cover literals, symbol
lookup with parent-chain shadowing, quote (special form + sugar),
primitive application with nested calls, and an env-as-value
section explicitly demonstrating the kit primitives work on
Scheme envs.

85 total Scheme tests (62 parse + 23 eval).

chisel: consumes-env (third consumer for lib/guest/reflective/env.sx).

lib/scheme/eval.sx

@@ -0,0 +1,150 @@
+;; lib/scheme/eval.sx — R7RS-small evaluator (Phase 2 skeleton).
+;;
+;; The evaluator walks parsed AST applying R7RS semantics:
+;;   - numbers, booleans, characters, vectors, strings self-evaluate
+;;   - symbols look up in the lexical env
+;;   - lists with a syntactic-operator head dispatch to native handler
+;;   - lists with an applicative head: eval head + args, then call
+;;
+;; Phase 2 covers literals, symbol lookup, and `quote`. The full
+;; suite of syntactic operators (if/lambda/define/let/...) lands in
+;; Phase 3.
+;;
+;; Environment representation
+;; --------------------------
+;; Scheme is the THIRD CONSUMER for `lib/guest/reflective/env.sx`.
+;; It uses the canonical mutable wire shape `{:refl-tag :env
+;; :bindings DICT :parent ENV-OR-NIL}` directly — no adapter cfg —
+;; because Scheme's lexical-scope semantics match the kit's defaults
+;; exactly. Compare with Tcl (functional updates, level field) and
+;; Smalltalk (rich frame metadata) which DID need cfg adapters.
+;;
+;; Public API
+;;   (scheme-eval EXPR ENV)         — primary entry
+;;   (scheme-make-env)              — fresh top-level env
+;;   (scheme-extend-env P)          — child env
+;;   (scheme-env-bind! E N V)
+;;   (scheme-env-lookup E N)
+;;
+;; Consumes: lib/guest/reflective/env.sx; lib/scheme/parser.sx
+;;   (scheme-string?, scheme-char?, scheme-vector?).
+
+;; Thin wrappers over the kit. Scheme uses the canonical shape with
+;; no cfg, so these are direct aliases.
+(define scheme-make-env refl-make-env)
+(define scheme-extend-env refl-extend-env)
+(define scheme-env? refl-env?)
+(define scheme-env-bind! refl-env-bind!)
+(define scheme-env-has? refl-env-has?)
+(define scheme-env-lookup refl-env-lookup)
+
+;; ── self-evaluating values ───────────────────────────────────────
+
+(define
+  scheme-self-eval?
+  (fn
+    (v)
+    (or
+      (number? v)
+      (boolean? v)
+      (nil? v)
+      (scheme-string? v)
+      (scheme-char? v)
+      (scheme-vector? v))))
+
+;; ── syntactic-operator table ─────────────────────────────────────
+;; Each operator is a fn (args env) that returns the result of the
+;; special form. Phase 2 only handles `quote`; Phase 3 fills out the
+;; rest. The table-driven dispatch keeps the eval body small and
+;; makes new operators easy to add.
+
+(define scheme-syntactic-ops {})
+
+(define
+  scheme-define-op!
+  (fn (name handler) (dict-set! scheme-syntactic-ops name handler)))
+
+(define
+  scheme-syntactic-op?
+  (fn (name) (dict-has? scheme-syntactic-ops name)))
+
+;; quote — return arg unevaluated.
+(scheme-define-op!
+  "quote"
+  (fn
+    (args env)
+    (cond
+      ((not (= (length args) 1))
+        (error "quote: expects exactly 1 argument"))
+      (:else (first args)))))
+
+;; ── eval-args helper ─────────────────────────────────────────────
+
+(define
+  scheme-eval-args
+  (fn
+    (args env)
+    (cond
+      ((or (nil? args) (= (length args) 0)) (list))
+      (:else
+        (cons
+          (scheme-eval (first args) env)
+          (scheme-eval-args (rest args) env))))))
+
+;; ── main eval ────────────────────────────────────────────────────
+
+(define
+  scheme-eval
+  (fn
+    (expr env)
+    (cond
+      ((scheme-self-eval? expr) expr)
+      ((string? expr) (scheme-env-lookup env expr))
+      ((list? expr)
+        (cond
+          ((= (length expr) 0)
+            (error "scheme-eval: empty application"))
+          (:else
+            (let
+              ((head (first expr)) (rest-args (rest expr)))
+              (cond
+                ((and (string? head) (scheme-syntactic-op? head))
+                  ((get scheme-syntactic-ops head) rest-args env))
+                (:else
+                  (let
+                    ((proc (scheme-eval head env))
+                      (vals (scheme-eval-args rest-args env)))
+                    (scheme-apply proc vals))))))))
+      (:else (error (str "scheme-eval: unknown form: " expr))))))
+
+;; ── apply ────────────────────────────────────────────────────────
+;; Phase 2 only knows about HOST procedures (SX fns) bound in the
+;; env as primitives. Phase 3 adds Scheme `lambda` closures.
+
+(define
+  scheme-apply
+  (fn
+    (proc args)
+    (cond
+      ((callable? proc) (proc args))
+      ((and (dict? proc) (= (get proc :scm-tag) :closure))
+        (scheme-apply-closure proc args))
+      (:else (error (str "scheme-eval: not a procedure: " proc))))))
+
+;; Stub for Phase 3 — closures land then.
+(define
+  scheme-apply-closure
+  (fn (proc args) (error "scheme-eval: closures land in Phase 3")))
+
+;; Evaluate a program (sequence of forms), returning the last value.
+(define
+  scheme-eval-program
+  (fn
+    (forms env)
+    (cond
+      ((or (nil? forms) (= (length forms) 0)) nil)
+      ((= (length forms) 1) (scheme-eval (first forms) env))
+      (:else
+        (begin
+          (scheme-eval (first forms) env)
+          (scheme-eval-program (rest forms) env))))))

lib/scheme/tests/eval.sx

@@ -0,0 +1,162 @@
+;; lib/scheme/tests/eval.sx — exercises lib/scheme/eval.sx (Phase 2).
+
+(define scm-eval-pass 0)
+(define scm-eval-fail 0)
+(define scm-eval-fails (list))
+
+(define
+  scm-eval-test
+  (fn
+    (name actual expected)
+    (if
+      (= actual expected)
+      (set! scm-eval-pass (+ scm-eval-pass 1))
+      (begin
+        (set! scm-eval-fail (+ scm-eval-fail 1))
+        (append! scm-eval-fails {:name name :actual actual :expected expected})))))
+
+(define scm-eval-src (fn (src env) (scheme-eval (scheme-parse src) env)))
+
+;; A toy env with arithmetic + list primitives.
+(define
+  scm-test-env
+  (fn
+    ()
+    (let
+      ((env (scheme-make-env)))
+      (scheme-env-bind!
+        env
+        "+"
+        (fn (args) (+ (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "-"
+        (fn (args) (- (first args) (nth args 1))))
+      (scheme-env-bind!
+        env
+        "*"
+        (fn (args) (* (first args) (nth args 1))))
+      (scheme-env-bind! env "list" (fn (args) args))
+      env)))
+
+;; ── self-evaluating ──────────────────────────────────────────────
+(scm-eval-test
+  "lit: integer"
+  (scm-eval-src "42" (scheme-make-env))
+  42)
+(scm-eval-test "lit: float" (scm-eval-src "3.14" (scheme-make-env)) 3.14)
+(scm-eval-test "lit: #t" (scm-eval-src "#t" (scheme-make-env)) true)
+(scm-eval-test "lit: #f" (scm-eval-src "#f" (scheme-make-env)) false)
+(scm-eval-test
+  "lit: empty list"
+  (scm-eval-src "()" (scheme-make-env))
+  (list))
+(scm-eval-test
+  "lit: string"
+  (scheme-string? (scm-eval-src "\"hello\"" (scheme-make-env)))
+  true)
+(scm-eval-test
+  "lit: char"
+  (scheme-char? (scm-eval-src "#\\a" (scheme-make-env)))
+  true)
+(scm-eval-test
+  "lit: vector"
+  (scheme-vector? (scm-eval-src "#(1 2 3)" (scheme-make-env)))
+  true)
+
+;; ── symbol lookup ────────────────────────────────────────────────
+(scm-eval-test
+  "sym: bound"
+  (let
+    ((env (scheme-make-env)))
+    (scheme-env-bind! env "x" 100)
+    (scm-eval-src "x" env))
+  100)
+(scm-eval-test
+  "sym: parent chain"
+  (let
+    ((p (scheme-make-env)))
+    (scheme-env-bind! p "outer" 1)
+    (let
+      ((c (scheme-extend-env p)))
+      (scheme-env-bind! c "inner" 2)
+      (+ (scm-eval-src "outer" c) (scm-eval-src "inner" c))))
+  3)
+(scm-eval-test
+  "sym: shadowing"
+  (let
+    ((p (scheme-make-env)))
+    (scheme-env-bind! p "x" 1)
+    (let
+      ((c (scheme-extend-env p)))
+      (scheme-env-bind! c "x" 2)
+      (scm-eval-src "x" c)))
+  2)
+
+;; ── quote ────────────────────────────────────────────────────────
+(scm-eval-test
+  "quote: symbol"
+  (scm-eval-src "(quote foo)" (scheme-make-env))
+  "foo")
+(scm-eval-test
+  "quote: list"
+  (scm-eval-src "(quote (+ 1 2))" (scheme-make-env))
+  (list "+" 1 2))
+(scm-eval-test "quote: sugar 'x" (scm-eval-src "'x" (scheme-make-env)) "x")
+(scm-eval-test
+  "quote: sugar list"
+  (scm-eval-src "'(a b c)" (scheme-make-env))
+  (list "a" "b" "c"))
+(scm-eval-test
+  "quote: nested"
+  (scm-eval-src "''x" (scheme-make-env))
+  (list "quote" "x"))
+
+;; ── primitive application ────────────────────────────────────────
+(scm-eval-test "prim: +" (scm-eval-src "(+ 2 3)" (scm-test-env)) 5)
+(scm-eval-test
+  "prim: nested +"
+  (scm-eval-src "(+ (+ 1 2) (+ 3 4))" (scm-test-env))
+  10)
+(scm-eval-test
+  "prim: mixed ops"
+  (scm-eval-src "(- (* 4 5) (+ 3 2))" (scm-test-env))
+  15)
+(scm-eval-test
+  "prim: list builds SX list"
+  (scm-eval-src "(list 1 2 3)" (scm-test-env))
+  (list 1 2 3))
+(scm-eval-test
+  "prim: args eval in order"
+  (let
+    ((env (scm-test-env)))
+    (scheme-env-bind! env "a" 10)
+    (scheme-env-bind! env "b" 20)
+    (scm-eval-src "(+ a b)" env))
+  30)
+
+;; ── env-as-value (the third-consumer demonstration) ─────────────
+;; Scheme's env IS lib/guest/reflective/env.sx's canonical wire shape
+;; with no adapter cfg. Verify the kit primitives work directly.
+(scm-eval-test
+  "env: refl-env? on Scheme env"
+  (refl-env? (scheme-make-env))
+  true)
+(scm-eval-test
+  "env: lookup via kit"
+  (let
+    ((env (scheme-make-env)))
+    (refl-env-bind! env "name" "scheme")
+    (refl-env-lookup env "name"))
+  "scheme")
+(scm-eval-test
+  "env: find-frame walks parent"
+  (let
+    ((p (scheme-make-env)))
+    (refl-env-bind! p "root-binding" 99)
+    (let
+      ((c (scheme-extend-env p)))
+      (= (refl-env-find-frame c "root-binding") p)))
+  true)
+
+(define scm-eval-tests-run! (fn () {:total (+ scm-eval-pass scm-eval-fail) :passed scm-eval-pass :failed scm-eval-fail :fails scm-eval-fails}))