rose-ash/lib/scheme/eval.sx

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