rose-ash/lib/kernel/runtime.sx

;; lib/kernel/runtime.sx — the operative–applicative substrate and the
;; standard Kernel environment.
;;
;; Phase 3 supplied four user-visible combiners ($vau, $lambda, wrap,
;; unwrap). Phase 4 fills out the rest of the R-1RK core: $if, $define!,
;; $sequence, eval, make-environment, get-current-environment, plus
;; arithmetic, equality, list/pair, and boolean primitives — enough to
;; write factorial.
;;
;; The standard env is built by EXTENDING the base env, not replacing
;; it. So `kernel-standard-env` includes everything from `kernel-base-env`.
;;
;; Public API
;;   (kernel-base-env)       — Phase 3 combiners
;;   (kernel-standard-env)   — Phase 4 standard environment

(define
  knl-eparam-sentinel
  (fn
    (sym)
    (cond
      ((= sym "_") :knl-ignore)
      ((= sym "#ignore") :knl-ignore)
      (:else sym))))

(define
  knl-formals-ok?
  (fn
    (formals)
    (cond
      ((not (list? formals)) false)
      ((= (length formals) 0) true)
      ((string? (first formals)) (knl-formals-ok? (rest formals)))
      (:else false))))

;; ── $vau ─────────────────────────────────────────────────────────

(define
  kernel-vau-impl
  (fn
    (args dyn-env)
    (cond
      ((< (length args) 3)
        (error "$vau: expects (formals env-param body...)"))
      (:else
        (let
          ((formals (first args))
            (eparam-raw (nth args 1))
            (body-forms (rest (rest args))))
          (cond
            ((not (knl-formals-ok? formals))
              (error "$vau: formals must be a list of symbols"))
            ((not (string? eparam-raw))
              (error "$vau: env-param must be a symbol"))
            (:else
              (kernel-make-user-operative
                formals
                (knl-eparam-sentinel eparam-raw)
                body-forms
                dyn-env))))))))

(define
  kernel-vau-operative
  (kernel-make-primitive-operative kernel-vau-impl))

;; ── $lambda ──────────────────────────────────────────────────────

(define
  kernel-lambda-impl
  (fn
    (args dyn-env)
    (cond
      ((< (length args) 2)
        (error "$lambda: expects (formals body...)"))
      (:else
        (let
          ((formals (first args)) (body-forms (rest args)))
          (cond
            ((not (knl-formals-ok? formals))
              (error "$lambda: formals must be a list of symbols"))
            (:else
              (kernel-wrap
                (kernel-make-user-operative
                  formals
                  :knl-ignore
                  body-forms
                  dyn-env)))))))))

(define
  kernel-lambda-operative
  (kernel-make-primitive-operative kernel-lambda-impl))

;; ── wrap / unwrap / predicates ───────────────────────────────────

(define
  kernel-wrap-applicative
  (kernel-make-primitive-applicative
    (fn
      (args)
      (cond
        ((not (= (length args) 1))
          (error "wrap: expects exactly 1 argument"))
        (:else (kernel-wrap (first args)))))))

(define
  kernel-unwrap-applicative
  (kernel-make-primitive-applicative
    (fn
      (args)
      (cond
        ((not (= (length args) 1))
          (error "unwrap: expects exactly 1 argument"))
        (:else (kernel-unwrap (first args)))))))

(define
  kernel-operative?-applicative
  (kernel-make-primitive-applicative
    (fn (args) (kernel-operative? (first args)))))

(define
  kernel-applicative?-applicative
  (kernel-make-primitive-applicative
    (fn (args) (kernel-applicative? (first args)))))

(define
  kernel-base-env
  (fn
    ()
    (let
      ((env (kernel-make-env)))
      (kernel-env-bind! env "$vau" kernel-vau-operative)
      (kernel-env-bind! env "$lambda" kernel-lambda-operative)
      (kernel-env-bind! env "wrap" kernel-wrap-applicative)
      (kernel-env-bind! env "unwrap" kernel-unwrap-applicative)
      (kernel-env-bind! env "operative?" kernel-operative?-applicative)
      (kernel-env-bind! env "applicative?" kernel-applicative?-applicative)
      env)))

;; ── $if / $define! / $sequence ───────────────────────────────────

(define
  kernel-if-operative
  (kernel-make-primitive-operative
    (fn
      (args dyn-env)
      (cond
        ((not (= (length args) 3))
          (error "$if: expects (condition then-expr else-expr)"))
        (:else
          (let
            ((c (kernel-eval (first args) dyn-env)))
            (if
              c
              (kernel-eval (nth args 1) dyn-env)
              (kernel-eval (nth args 2) dyn-env))))))))

(define
  kernel-define!-operative
  (kernel-make-primitive-operative
    (fn
      (args dyn-env)
      (cond
        ((not (= (length args) 2))
          (error "$define!: expects (name expr)"))
        ((not (string? (first args)))
          (error "$define!: name must be a symbol"))
        (:else
          (let
            ((v (kernel-eval (nth args 1) dyn-env)))
            (kernel-env-bind! dyn-env (first args) v)
            v))))))

(define
  kernel-sequence-operative
  (kernel-make-primitive-operative
    (fn
      (args dyn-env)
      (cond
        ((or (nil? args) (= (length args) 0)) nil)
        ((= (length args) 1) (kernel-eval (first args) dyn-env))
        (:else
          (begin
            (kernel-eval (first args) dyn-env)
            ((get kernel-sequence-operative :impl) (rest args) dyn-env)))))))

;; ── eval / make-environment / get-current-environment ───────────

(define
  kernel-quote-operative
  (kernel-make-primitive-operative
    (fn
      (args dyn-env)
      (cond
        ((not (= (length args) 1)) (error "$quote: expects 1 argument"))
        (:else (first args))))))

;; 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)
    (refl-quasi-walk-with knl-quasi-cfg form dyn-env)))

;; $cond — multi-clause branch.
;;   ($cond (TEST1 EXPR1 ...) (TEST2 EXPR2 ...) ...)
;; Evaluates each TEST in order; first truthy one runs its EXPRs (in
;; sequence) and returns the last; if no TEST is truthy, returns nil.
;; A clause with TEST = `else` always matches (sugar for $if's default).
(define knl-cond-impl
  (fn (clauses dyn-env)
    (cond
      ((or (nil? clauses) (= (length clauses) 0)) nil)
      (:else
        (let ((clause (first clauses)))
          (cond
            ((not (list? clause))
              (error "$cond: each clause must be a list"))
            ((= (length clause) 0)
              (error "$cond: empty clause"))
            ((and (string? (first clause)) (= (first clause) "else"))
              (knl-cond-eval-body (rest clause) dyn-env))
            (:else
              (let ((test-val (kernel-eval (first clause) dyn-env)))
                (cond
                  (test-val (knl-cond-eval-body (rest clause) dyn-env))
                  (:else (knl-cond-impl (rest clauses) dyn-env)))))))))))

(define knl-cond-eval-body
  (fn (body dyn-env)
    (cond
      ((or (nil? body) (= (length body) 0)) nil)
      ((= (length body) 1) (kernel-eval (first body) dyn-env))
      (:else
        (begin
          (kernel-eval (first body) dyn-env)
          (knl-cond-eval-body (rest body) dyn-env))))))

(define kernel-cond-operative
  (kernel-make-primitive-operative
    (fn (args dyn-env) (knl-cond-impl args dyn-env))))

;; $when COND BODY... — evaluate body iff COND is truthy; else nil.
(define kernel-when-operative
  (kernel-make-primitive-operative
    (fn (args dyn-env)
      (cond
        ((< (length args) 1)
          (error "$when: expects (cond body...)"))
        (:else
          (let ((c (kernel-eval (first args) dyn-env)))
            (cond
              (c (knl-cond-eval-body (rest args) dyn-env))
              (:else nil))))))))

;; $and? — short-circuit AND. Operative (not applicative) so untaken
;; clauses are NOT evaluated. Empty $and? returns true (the identity).
(define knl-and?-impl
  (fn (args dyn-env)
    (cond
      ((or (nil? args) (= (length args) 0)) true)
      ((= (length args) 1) (kernel-eval (first args) dyn-env))
      (:else
        (let ((v (kernel-eval (first args) dyn-env)))
          (cond
            (v (knl-and?-impl (rest args) dyn-env))
            (:else v)))))))

(define kernel-and?-operative
  (kernel-make-primitive-operative knl-and?-impl))

;; $or? — short-circuit OR. Operative; untaken clauses NOT evaluated.
;; Empty $or? returns false (the identity).
(define knl-or?-impl
  (fn (args dyn-env)
    (cond
      ((or (nil? args) (= (length args) 0)) false)
      ((= (length args) 1) (kernel-eval (first args) dyn-env))
      (:else
        (let ((v (kernel-eval (first args) dyn-env)))
          (cond
            (v v)
            (:else (knl-or?-impl (rest args) dyn-env))))))))

(define kernel-or?-operative
  (kernel-make-primitive-operative knl-or?-impl))

;; $unless COND BODY... — evaluate body iff COND is falsy; else nil.
(define kernel-unless-operative
  (kernel-make-primitive-operative
    (fn (args dyn-env)
      (cond
        ((< (length args) 1)
          (error "$unless: expects (cond body...)"))
        (:else
          (let ((c (kernel-eval (first args) dyn-env)))
            (cond
              (c nil)
              (:else (knl-cond-eval-body (rest args) dyn-env)))))))))

(define kernel-quasiquote-operative
  (kernel-make-primitive-operative
    (fn (args dyn-env)
      (cond
        ((not (= (length args) 1))
          (error "$quasiquote: expects exactly 1 argument"))
        (:else (knl-quasi-walk (first args) dyn-env))))))

(define
  kernel-eval-applicative
  (kernel-make-primitive-applicative
    (fn
      (args)
      (cond
        ((not (= (length args) 2))
          (error "eval: expects (expr env)"))
        ((not (kernel-env? (nth args 1)))
          (error "eval: second arg must be a kernel env"))
        (:else (kernel-eval (first args) (nth args 1)))))))

(define
  kernel-make-environment-applicative
  (kernel-make-primitive-applicative
    (fn
      (args)
      (cond
        ((= (length args) 0) (kernel-make-env))
        ((= (length args) 1)
          (cond
            ((not (kernel-env? (first args)))
              (error "make-environment: parent must be a kernel env"))
            (:else (kernel-extend-env (first args)))))
        (:else (error "make-environment: 0 or 1 argument"))))))

;; ── arithmetic and comparison (binary; trivial to extend later) ─

(define
  kernel-get-current-env-operative
  (kernel-make-primitive-operative
    (fn
      (args dyn-env)
      (cond
        ((not (= (length args) 0))
          (error "get-current-environment: expects 0 arguments"))
        (:else dyn-env)))))

(define
  knl-bin-app
  (fn
    (name f)
    (kernel-make-primitive-applicative
      (fn
        (args)
        (cond
          ((not (= (length args) 2))
            (error (str name ": expects 2 arguments")))
          (:else (f (first args) (nth args 1))))))))

;; Variadic left-fold helper. ZERO-RES is the identity (`(+)` → 0);
;; ONE-FN handles single-arg case (`(- x)` negates; `(+ x)` returns x).
(define knl-fold-step
  (fn (f acc rest-args)
    (cond
      ((or (nil? rest-args) (= (length rest-args) 0)) acc)
      (:else
        (knl-fold-step f (f acc (first rest-args)) (rest rest-args))))))

(define knl-fold-app
  (fn (name f zero-res one-fn)
    (kernel-make-primitive-applicative
      (fn (args)
        (cond
          ((= (length args) 0) zero-res)
          ((= (length args) 1) (one-fn (first args)))
          (:else (knl-fold-step f (first args) (rest args))))))))

;; Variadic n-ary chained comparison: `(< 1 2 3)` ≡ `(< 1 2)` AND `(< 2 3)`.
(define knl-chain-step
  (fn (cmp prev rest-args)
    (cond
      ((or (nil? rest-args) (= (length rest-args) 0)) true)
      (:else
        (let ((next (first rest-args)))
          (cond
            ((cmp prev next)
              (knl-chain-step cmp next (rest rest-args)))
            (:else false)))))))

(define knl-chain-cmp
  (fn (name cmp)
    (kernel-make-primitive-applicative
      (fn (args)
        (cond
          ((< (length args) 2)
            (error (str name ": expects at least 2 arguments")))
          (:else (knl-chain-step cmp (first args) (rest args))))))))

;; ── list / pair primitives ──────────────────────────────────────

(define
  knl-unary-app
  (fn
    (name f)
    (kernel-make-primitive-applicative
      (fn
        (args)
        (cond
          ((not (= (length args) 1))
            (error (str name ": expects 1 argument")))
          (:else (f (first args))))))))

(define kernel-cons-applicative (knl-bin-app "cons" (fn (a b) (cons a b))))

(define
  kernel-car-applicative
  (knl-unary-app
    "car"
    (fn
      (xs)
      (cond
        ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
          (error "car: empty list"))
        (:else (first xs))))))

(define
  kernel-cdr-applicative
  (knl-unary-app
    "cdr"
    (fn
      (xs)
      (cond
        ((or (nil? xs) (and (list? xs) (= (length xs) 0)))
          (error "cdr: empty list"))
        (:else (rest xs))))))

(define
  kernel-list-applicative
  (kernel-make-primitive-applicative (fn (args) args)))

(define
  kernel-length-applicative
  (knl-unary-app "length" (fn (xs) (length xs))))

(define
  kernel-null?-applicative
  (knl-unary-app
    "null?"
    (fn (v) (or (nil? v) (and (list? v) (= (length v) 0))))))

;; ── boolean / equality ──────────────────────────────────────────

(define
  kernel-pair?-applicative
  (knl-unary-app
    "pair?"
    (fn (v) (and (list? v) (> (length v) 0)))))

(define knl-append-step
  (fn (xs ys)
    (cond
      ((or (nil? xs) (= (length xs) 0)) ys)
      (:else (cons (first xs) (knl-append-step (rest xs) ys))))))

(define knl-all-lists?
  (fn (xs)
    (cond
      ((or (nil? xs) (= (length xs) 0)) true)
      ((list? (first xs)) (knl-all-lists? (rest xs)))
      (:else false))))

(define knl-append-all
  (fn (lists)
    (cond
      ((or (nil? lists) (= (length lists) 0)) (list))
      ((= (length lists) 1) (first lists))
      (:else
        (knl-append-step (first lists)
                         (knl-append-all (rest lists)))))))

(define kernel-append-applicative
  (kernel-make-primitive-applicative
    (fn (args)
      (cond
        ((knl-all-lists? args) (knl-append-all args))
        (:else (error "append: all arguments must be lists"))))))

(define knl-reverse-step
  (fn (xs acc)
    (cond
      ((or (nil? xs) (= (length xs) 0)) acc)
      (:else (knl-reverse-step (rest xs) (cons (first xs) acc))))))

(define kernel-reverse-applicative
  (knl-unary-app "reverse"
    (fn (xs)
      (cond
        ((not (list? xs)) (error "reverse: argument must be a list"))
        (:else (knl-reverse-step xs (list)))))))

(define kernel-not-applicative (knl-unary-app "not" (fn (v) (not v))))

;; Type predicates (Kernel-visible). Note `string?` covers BOTH symbols
;; and string-literals in our representation (symbols are bare SX
;; strings); a `kernel-string?` applicative distinguishes the two if
;; needed.
(define kernel-number?-applicative
  (knl-unary-app "number?" (fn (v) (number? v))))
(define kernel-string?-applicative
  (knl-unary-app "string?" (fn (v) (string? v))))
(define kernel-list?-applicative
  (knl-unary-app "list?" (fn (v) (list? v))))
(define kernel-boolean?-applicative
  (knl-unary-app "boolean?" (fn (v) (boolean? v))))
(define kernel-symbol?-applicative
  (knl-unary-app "symbol?" (fn (v) (string? v))))

(define kernel-eq?-applicative (knl-bin-app "eq?" (fn (a b) (= a b))))

;; ── the standard environment ────────────────────────────────────

(define
  kernel-equal?-applicative
  (knl-bin-app "equal?" (fn (a b) (= a b))))

;; ── List combinators: map / filter / reduce ─────────────────────
;; These re-enter the evaluator on each element, so they use the
;; with-env applicative constructor.

;; When the combiner is an applicative, we MUST unwrap before calling
;; — otherwise kernel-combine will re-evaluate the already-evaluated
;; element values (and crash if an element is itself a list).
(define knl-apply-op
  (fn (combiner)
    (cond
      ((kernel-applicative? combiner) (kernel-unwrap combiner))
      (:else combiner))))

(define knl-map-step
  (fn (fn-val xs dyn-env)
    (let ((op (knl-apply-op fn-val)))
      (knl-map-walk op xs dyn-env))))

(define knl-map-walk
  (fn (op xs dyn-env)
    (cond
      ((or (nil? xs) (= (length xs) 0)) (list))
      (:else
        (cons (kernel-combine op (list (first xs)) dyn-env)
              (knl-map-walk op (rest xs) dyn-env))))))

(define kernel-map-applicative
  (kernel-make-primitive-applicative-with-env
    (fn (args dyn-env)
      (cond
        ((not (= (length args) 2))
          (error "map: expects (fn list)"))
        ((not (kernel-combiner? (first args)))
          (error "map: first arg must be a combiner"))
        ((not (list? (nth args 1)))
          (error "map: second arg must be a list"))
        (:else (knl-map-step (first args) (nth args 1) dyn-env))))))

(define knl-filter-step
  (fn (pred xs dyn-env)
    (knl-filter-walk (knl-apply-op pred) xs dyn-env)))

(define knl-filter-walk
  (fn (op xs dyn-env)
    (cond
      ((or (nil? xs) (= (length xs) 0)) (list))
      (:else
        (let ((keep? (kernel-combine op (list (first xs)) dyn-env)))
          (cond
            (keep?
              (cons (first xs) (knl-filter-walk op (rest xs) dyn-env)))
            (:else (knl-filter-walk op (rest xs) dyn-env))))))))

(define kernel-filter-applicative
  (kernel-make-primitive-applicative-with-env
    (fn (args dyn-env)
      (cond
        ((not (= (length args) 2))
          (error "filter: expects (pred list)"))
        ((not (kernel-combiner? (first args)))
          (error "filter: first arg must be a combiner"))
        ((not (list? (nth args 1)))
          (error "filter: second arg must be a list"))
        (:else (knl-filter-step (first args) (nth args 1) dyn-env))))))

(define knl-reduce-step
  (fn (fn-val xs acc dyn-env)
    (knl-reduce-walk (knl-apply-op fn-val) xs acc dyn-env)))

(define knl-reduce-walk
  (fn (op xs acc dyn-env)
    (cond
      ((or (nil? xs) (= (length xs) 0)) acc)
      (:else
        (knl-reduce-walk
          op
          (rest xs)
          (kernel-combine op (list acc (first xs)) dyn-env)
          dyn-env)))))

;; (apply COMBINER ARGS-LIST) — call COMBINER with the elements of
;; ARGS-LIST as arguments. The Kernel canonical use: turn a constructed
;; list of values into a function call. We skip the applicative's
;; auto-eval step (via unwrap) because ARGS-LIST is already values, not
;; expressions; for a bare operative, we pass through directly.
(define kernel-apply-applicative
  (kernel-make-primitive-applicative-with-env
    (fn (args dyn-env)
      (cond
        ((not (= (length args) 2))
          (error "apply: expects (combiner args-list)"))
        ((not (kernel-combiner? (first args)))
          (error "apply: first arg must be a combiner"))
        ((not (list? (nth args 1)))
          (error "apply: second arg must be a list"))
        (:else
          (let ((op (cond
                      ((kernel-applicative? (first args))
                        (kernel-unwrap (first args)))
                      (:else (first args)))))
            (kernel-combine op (nth args 1) dyn-env)))))))

(define kernel-reduce-applicative
  (kernel-make-primitive-applicative-with-env
    (fn (args dyn-env)
      (cond
        ((not (= (length args) 3))
          (error "reduce: expects (fn init list)"))
        ((not (kernel-combiner? (first args)))
          (error "reduce: first arg must be a combiner"))
        ((not (list? (nth args 2)))
          (error "reduce: third arg must be a list"))
        (:else
          (knl-reduce-step (first args) (nth args 2)
                           (nth args 1) dyn-env))))))

;; ── Encapsulations: Kernel's opaque-type idiom ──────────────────
;;
;; (make-encapsulation-type) → (encapsulator predicate decapsulator)
;;
;; Each call returns three applicatives over a fresh family identity.
;; - (encapsulator V) → an opaque wrapper around V.
;; - (predicate V)    → true iff V was wrapped by THIS family.
;; - (decapsulator W) → the inner value; errors on wrong family.
;;
;; Family identity is a fresh empty dict; SX compares dicts by reference,
;; so two `(make-encapsulation-type)` calls return distinct families.
;;
;; Pattern usage (Phase 5 lacks destructuring, so accessors are explicit):
;;   ($define! triple (make-encapsulation-type))
;;   ($define! wrap-promise   (car  triple))
;;   ($define! promise?       (car  (cdr triple)))
;;   ($define! unwrap-promise (car  (cdr (cdr triple))))

(define kernel-make-encap-type-impl
  (fn (args)
    (cond
      ((not (= (length args) 0))
        (error "make-encapsulation-type: expects 0 arguments"))
      (:else
        (let ((family {}))
          (let ((encap
                  (kernel-make-primitive-applicative
                    (fn (vargs)
                      (cond
                        ((not (= (length vargs) 1))
                          (error "encapsulator: expects 1 argument"))
                        (:else
                          {:knl-tag :encap
                           :family family
                           :value (first vargs)})))))
                (pred
                  (kernel-make-primitive-applicative
                    (fn (vargs)
                      (cond
                        ((not (= (length vargs) 1))
                          (error "predicate: expects 1 argument"))
                        (:else
                          (let ((v (first vargs)))
                            (and (dict? v)
                                 (= (get v :knl-tag) :encap)
                                 (= (get v :family) family))))))))
                (decap
                  (kernel-make-primitive-applicative
                    (fn (vargs)
                      (cond
                        ((not (= (length vargs) 1))
                          (error "decapsulator: expects 1 argument"))
                        (:else
                          (let ((v (first vargs)))
                            (cond
                              ((not (and (dict? v)
                                         (= (get v :knl-tag) :encap)))
                                (error "decapsulator: not an encapsulation"))
                              ((not (= (get v :family) family))
                                (error "decapsulator: wrong family"))
                              (:else (get v :value))))))))))
            (list encap pred decap)))))))

(define kernel-make-encap-type-applicative
  (kernel-make-primitive-applicative kernel-make-encap-type-impl))

;; ── Hygiene: $let, $define-in!, make-environment ────────────────
;;
;; Kernel-on-SX is hygienic *by default* because user-defined operatives
;; (Phase 3) bind their formals + any $define! in a CHILD env extending
;; the operative's static-env, never the dyn-env. The caller's env is
;; only mutated when code explicitly says so (e.g. `(eval expr env-arg)`).
;;
;; Phase 6 adds two helpers that make the property easy to lean on:
;;
;;   ($let ((NAME EXPR) ...) BODY)
;;     Evaluates each EXPR in the calling env, binds NAME in a fresh
;;     child env, evaluates BODY in that child env. NAMES don't leak.
;;
;;   ($define-in! ENV NAME EXPR)
;;     Binds NAME=value-of-EXPR in the *specified* env, not the dyn-env.
;;     Useful for operatives that need to mutate a sandbox env without
;;     touching their caller's env.
;;
;; Shutt's full scope-set / frame-stamp hygiene (lifted symbols carrying
;; provenance markers so introduced bindings can shadow without
;; capturing) is research-grade and not implemented here. Notes for
;; `lib/guest/reflective/hygiene.sx` candidate API below the std env.

(define knl-bind-let-vals!
  (fn (local bindings dyn-env)
    (cond
      ((or (nil? bindings) (= (length bindings) 0)) nil)
      (:else
        (let ((b (first bindings)))
          (cond
            ((not (and (list? b) (= (length b) 2)))
              (error "$let: each binding must be (name expr)"))
            ((not (string? (first b)))
              (error "$let: binding name must be a symbol"))
            (:else
              (begin
                (kernel-env-bind! local
                                  (first b)
                                  (kernel-eval (nth b 1) dyn-env))
                (knl-bind-let-vals! local (rest bindings) dyn-env)))))))))

(define kernel-let-operative
  (kernel-make-primitive-operative
    (fn (args dyn-env)
      (cond
        ((< (length args) 2)
          (error "$let: expects (bindings body...)"))
        ((not (list? (first args)))
          (error "$let: bindings must be a list"))
        (:else
          (let ((local (kernel-extend-env dyn-env)))
            (knl-bind-let-vals! local (first args) dyn-env)
            (knl-eval-body (rest args) local)))))))

;; $let* — sequential let. Each binding sees prior names in scope.
;; Implemented by nesting envs one per binding; the body runs in the
;; innermost env, so later bindings shadow earlier ones if names repeat.
(define knl-let*-step
  (fn (bindings env body-forms)
    (cond
      ((or (nil? bindings) (= (length bindings) 0))
        (knl-eval-body body-forms env))
      (:else
        (let ((b (first bindings)))
          (cond
            ((not (and (list? b) (= (length b) 2)))
              (error "$let*: each binding must be (name expr)"))
            ((not (string? (first b)))
              (error "$let*: binding name must be a symbol"))
            (:else
              (let ((child (kernel-extend-env env)))
                (kernel-env-bind! child
                                  (first b)
                                  (kernel-eval (nth b 1) env))
                (knl-let*-step (rest bindings) child body-forms)))))))))

(define kernel-let*-operative
  (kernel-make-primitive-operative
    (fn (args dyn-env)
      (cond
        ((< (length args) 2)
          (error "$let*: expects (bindings body...)"))
        ((not (list? (first args)))
          (error "$let*: bindings must be a list"))
        (:else
          (knl-let*-step (first args) dyn-env (rest args)))))))

(define kernel-define-in!-operative
  (kernel-make-primitive-operative
    (fn (args dyn-env)
      (cond
        ((not (= (length args) 3))
          (error "$define-in!: expects (env-expr name expr)"))
        ((not (string? (nth args 1)))
          (error "$define-in!: name must be a symbol"))
        (:else
          (let ((target (kernel-eval (first args) dyn-env)))
            (cond
              ((not (kernel-env? target))
                (error "$define-in!: first arg must evaluate to an env"))
              (:else
                (let ((v (kernel-eval (nth args 2) dyn-env)))
                  (kernel-env-bind! target (nth args 1) v)
                  v)))))))))

(define
  kernel-standard-env
  (fn
    ()
    (let
      ((env (kernel-base-env)))
      (kernel-env-bind! env "$if" kernel-if-operative)
      (kernel-env-bind! env "$define!" kernel-define!-operative)
      (kernel-env-bind! env "$sequence" kernel-sequence-operative)
      (kernel-env-bind! env "$quote"    kernel-quote-operative)
      (kernel-env-bind! env "$quasiquote" kernel-quasiquote-operative)
      (kernel-env-bind! env "$cond"   kernel-cond-operative)
      (kernel-env-bind! env "$when"   kernel-when-operative)
      (kernel-env-bind! env "$unless" kernel-unless-operative)
      (kernel-env-bind! env "$and?"   kernel-and?-operative)
      (kernel-env-bind! env "$or?"    kernel-or?-operative)
      (kernel-env-bind! env "eval" kernel-eval-applicative)
      (kernel-env-bind!
        env
        "make-environment"
        kernel-make-environment-applicative)
      (kernel-env-bind!
        env
        "get-current-environment"
        kernel-get-current-env-operative)
      (kernel-env-bind! env "+"
        (knl-fold-app "+" (fn (a b) (+ a b)) 0 (fn (x) x)))
      (kernel-env-bind! env "-"
        (knl-fold-app "-" (fn (a b) (- a b)) 0 (fn (x) (- 0 x))))
      (kernel-env-bind! env "*"
        (knl-fold-app "*" (fn (a b) (* a b)) 1 (fn (x) x)))
      (kernel-env-bind! env "/"
        (knl-fold-app "/" (fn (a b) (/ a b)) 1 (fn (x) (/ 1 x))))
      (kernel-env-bind! env "<"   (knl-chain-cmp "<"   (fn (a b) (< a b))))
      (kernel-env-bind! env ">"   (knl-chain-cmp ">"   (fn (a b) (> a b))))
      (kernel-env-bind! env "<=?" (knl-chain-cmp "<=?" (fn (a b) (<= a b))))
      (kernel-env-bind! env ">=?" (knl-chain-cmp ">=?" (fn (a b) (>= a b))))
      (kernel-env-bind! env "=?" kernel-eq?-applicative)
      (kernel-env-bind! env "equal?" kernel-equal?-applicative)
      (kernel-env-bind! env "eq?" kernel-eq?-applicative)
      (kernel-env-bind! env "cons" kernel-cons-applicative)
      (kernel-env-bind! env "car" kernel-car-applicative)
      (kernel-env-bind! env "cdr" kernel-cdr-applicative)
      (kernel-env-bind! env "list" kernel-list-applicative)
      (kernel-env-bind! env "length" kernel-length-applicative)
      (kernel-env-bind! env "null?" kernel-null?-applicative)
      (kernel-env-bind! env "pair?" kernel-pair?-applicative)
      (kernel-env-bind! env "map"    kernel-map-applicative)
      (kernel-env-bind! env "filter" kernel-filter-applicative)
      (kernel-env-bind! env "reduce" kernel-reduce-applicative)
      (kernel-env-bind! env "apply"   kernel-apply-applicative)
      (kernel-env-bind! env "append"  kernel-append-applicative)
      (kernel-env-bind! env "reverse" kernel-reverse-applicative)
      (kernel-env-bind! env "number?"  kernel-number?-applicative)
      (kernel-env-bind! env "string?"  kernel-string?-applicative)
      (kernel-env-bind! env "list?"    kernel-list?-applicative)
      (kernel-env-bind! env "boolean?" kernel-boolean?-applicative)
      (kernel-env-bind! env "symbol?"  kernel-symbol?-applicative)
      (kernel-env-bind! env "not" kernel-not-applicative)
      (kernel-env-bind! env "make-encapsulation-type"
                            kernel-make-encap-type-applicative)
      (kernel-env-bind! env "$let"         kernel-let-operative)
      (kernel-env-bind! env "$let*"        kernel-let*-operative)
      (kernel-env-bind! env "$define-in!"  kernel-define-in!-operative)
      env)))