rose-ash/lib/kernel/eval.sx

;; lib/kernel/eval.sx — Kernel evaluator (Phase 2 skeleton).
;;
;; The evaluator is `lookup-and-combine`: there are no hardcoded special
;; forms. Even $if / $define! / $lambda will be ordinary operatives bound
;; in the standard environment (Phase 4). This file builds the dispatch
;; machinery and the operative/applicative tagged-value protocol.
;;
;; Tagged values
;; -------------
;;   {:knl-tag :env :bindings DICT :parent PARENT-OR-NIL}
;;     A first-class Kernel environment. Bindings is a mutable SX dict
;;     keyed by symbol name; parent walks up the lookup chain.
;;
;;   {:knl-tag :operative :impl FN}
;;     A primitive operative. FN receives (args dyn-env) — args are the
;;     UN-evaluated argument expressions, dyn-env is the calling env.
;;
;;   {:knl-tag :applicative :underlying OP}
;;     An applicative wraps an operative. Calls evaluate args first, then
;;     forward to the underlying operative.
;;
;; User-defined ($vau) operatives are added in Phase 3 — same tag, with
;; extra fields :params :env-param :body :static-env.
;;
;; Public API
;;   (kernel-eval EXPR ENV)                     — primary entry
;;   (kernel-combine COMBINER ARGS DYN-ENV)     — apply a combiner
;;   (kernel-make-env) / (kernel-extend-env P)
;;   (kernel-env-bind! E N V) / (kernel-env-lookup E N)
;;   (kernel-env-has? E N) / (kernel-env? V)
;;   (kernel-make-primitive-operative IMPL)
;;   (kernel-make-primitive-applicative IMPL)   — IMPL receives evaled args
;;   (kernel-wrap OP) / (kernel-unwrap APP)
;;   (kernel-operative? V) / (kernel-applicative? V) / (kernel-combiner? V)
;;
;; Consumes: lib/kernel/parser.sx (kernel-string?, kernel-string-value)

;; ── Environments — first-class, pure-SX (binding dict + parent) ──

(define kernel-env? (fn (v) (and (dict? v) (= (get v :knl-tag) :env))))

(define kernel-make-env (fn () {:parent nil :knl-tag :env :bindings {}}))

(define kernel-extend-env (fn (parent) {:parent parent :knl-tag :env :bindings {}}))

(define
  kernel-env-bind!
  (fn (env name val) (dict-set! (get env :bindings) name val) val))

(define
  kernel-env-has?
  (fn
    (env name)
    (cond
      ((nil? env) false)
      ((not (kernel-env? env)) false)
      ((dict-has? (get env :bindings) name) true)
      (:else (kernel-env-has? (get env :parent) name)))))

(define
  kernel-env-lookup
  (fn
    (env name)
    (cond
      ((nil? env) (error (str "kernel-eval: unbound symbol: " name)))
      ((not (kernel-env? env))
        (error (str "kernel-eval: corrupt env: " env)))
      ((dict-has? (get env :bindings) name) (get (get env :bindings) name))
      (:else (kernel-env-lookup (get env :parent) name)))))

;; ── Tagged-value constructors and predicates ─────────────────────

(define kernel-make-primitive-operative (fn (impl) {:impl impl :knl-tag :operative}))

(define
  kernel-operative?
  (fn (v) (and (dict? v) (= (get v :knl-tag) :operative))))

(define
  kernel-applicative?
  (fn (v) (and (dict? v) (= (get v :knl-tag) :applicative))))

(define
  kernel-combiner?
  (fn (v) (or (kernel-operative? v) (kernel-applicative? v))))

(define
  kernel-wrap
  (fn
    (op)
    (cond
      ((kernel-operative? op) {:knl-tag :applicative :underlying op})
      (:else (error "kernel-wrap: argument must be an operative")))))

(define
  kernel-unwrap
  (fn
    (app)
    (cond
      ((kernel-applicative? app) (get app :underlying))
      (:else (error "kernel-unwrap: argument must be an applicative")))))

;; A primitive applicative: sugar for (wrap (primitive-operative …)) where
;; the impl receives already-evaluated args.
(define
  kernel-make-primitive-applicative
  (fn
    (impl)
    (kernel-wrap
      (kernel-make-primitive-operative (fn (args dyn-env) (impl args))))))

;; ── The evaluator ────────────────────────────────────────────────

(define
  kernel-eval
  (fn
    (expr env)
    (cond
      ((number? expr) expr)
      ((boolean? expr) expr)
      ((nil? expr) expr)
      ((kernel-string? expr) (kernel-string-value expr))
      ((string? expr) (kernel-env-lookup env expr))
      ((list? expr)
        (cond
          ((= (length expr) 0) expr)
          (:else
            (let
              ((combiner (kernel-eval (first expr) env))
                (args (rest expr)))
              (kernel-combine combiner args env)))))
      (:else (error (str "kernel-eval: unknown form: " expr))))))

(define
  kernel-combine
  (fn
    (combiner args dyn-env)
    (cond
      ((kernel-operative? combiner) ((get combiner :impl) args dyn-env))
      ((kernel-applicative? combiner)
        (kernel-combine
          (get combiner :underlying)
          (kernel-eval-args args dyn-env)
          dyn-env))
      (:else (error (str "kernel-eval: not a combiner: " combiner))))))

(define
  kernel-eval-args
  (fn
    (args env)
    (cond
      ((or (nil? args) (= (length args) 0)) (list))
      (:else
        (cons
          (kernel-eval (first args) env)
          (kernel-eval-args (rest args) env))))))

;; Evaluate a sequence of forms in env, returning the value of the last.
(define
  kernel-eval-program
  (fn
    (forms env)
    (cond
      ((or (nil? forms) (= (length forms) 0)) nil)
      ((= (length forms) 1) (kernel-eval (first forms) env))
      (:else
        (begin
          (kernel-eval (first forms) env)
          (kernel-eval-program (rest forms) env))))))