rose-ash/lib/kernel/eval.sx

;; lib/kernel/eval.sx — Kernel evaluator.
;;
;; The evaluator is `lookup-and-combine`: there are no hardcoded special
;; forms. Even $if / $define! / $lambda are 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}
;;     Primitive operative. FN receives (args dyn-env) — args are the
;;     UN-evaluated argument expressions, dyn-env is the calling env.
;;
;;   {:knl-tag :operative :params P :env-param EP :body B :static-env SE}
;;     User-defined operative (built by $vau). Same tag; dispatch in
;;     kernel-call-operative forks on which keys are present.
;;
;;   {:knl-tag :applicative :underlying OP}
;;     An applicative wraps an operative. Calls evaluate args first,
;;     then forward to the underlying operative.
;;
;; The env-param of a user operative may be the sentinel :knl-ignore,
;; in which case the dynamic env is not bound.
;;
;; Public API
;;   (kernel-eval EXPR ENV)                     — primary entry
;;   (kernel-combine COMBINER ARGS DYN-ENV)
;;   (kernel-call-operative OP ARGS DYN-ENV)
;;   (kernel-bind-params! ENV PARAMS ARGS)
;;   (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)
;;   (kernel-make-user-operative PARAMS EPARAM BODY STATIC-ENV)
;;   (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-make-user-operative
  (fn (params eparam body static-env) {:knl-tag :operative :static-env static-env :params params :body body :env-param eparam}))

(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")))))

(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)
        (kernel-call-operative combiner 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))))))

;; Operatives may be primitive (:impl is a host fn) or user-defined
;; (carry :params / :env-param / :body / :static-env). The dispatch
;; fork is here so kernel-combine stays small.
(define
  kernel-call-operative
  (fn
    (op args dyn-env)
    (cond
      ((dict-has? op :impl) ((get op :impl) args dyn-env))
      ((dict-has? op :body)
        (let
          ((local (kernel-extend-env (get op :static-env))))
          (kernel-bind-params! local (get op :params) args)
          (let
            ((eparam (get op :env-param)))
            (when
              (not (= eparam :knl-ignore))
              (kernel-env-bind! local eparam dyn-env)))
          (kernel-eval (get op :body) local)))
      (:else (error "kernel-call-operative: malformed operative")))))

;; Phase 3 supports a flat parameter list only — destructuring later.
(define
  kernel-bind-params!
  (fn
    (env params args)
    (cond
      ((or (nil? params) (= (length params) 0))
        (cond
          ((or (nil? args) (= (length args) 0)) nil)
          (:else (error "kernel-call: too many arguments"))))
      ((or (nil? args) (= (length args) 0))
        (error "kernel-call: too few arguments"))
      (:else
        (begin
          (kernel-env-bind! env (first params) (first args))
          (kernel-bind-params! env (rest params) (rest args)))))))

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

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