kernel: Phase 4 standard env + factorial + 49 tests [shapes-reflective]

kernel-standard-env extends kernel-base-env with $if/$define!/$sequence/
$quote, reflection (eval/make-environment/get-current-environment),
binary arithmetic, comparison, list/pair, boolean primitives. Headline
test is recursive factorial (5! = 120, 10! = 3628800). Recursive sum,
length, map-add1, closures, curried arithmetic, and a $vau-using-$define!
demo also covered.

lib/kernel/runtime.sx

@@ -1,34 +1,18 @@
-;; lib/kernel/runtime.sx — the operative–applicative substrate.
+;; lib/kernel/runtime.sx — the operative–applicative substrate and the
+;; standard Kernel environment.
 ;;
-;; Builds the first user-visible operatives so Kernel programs can
-;; construct their own combiners:
+;; 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.
 ;;
-;;   $vau    — primitive operative that returns a user operative
-;;   $lambda — primitive operative; sugar for (wrap ($vau …))
-;;   wrap    — primitive applicative; wraps an operative
-;;   unwrap  — primitive applicative; extracts the underlying op
-;;
-;; In Kernel, $lambda is *defined* in terms of $vau and wrap:
-;;   ($define! $lambda
-;;     ($vau (formals . body) #ignore
-;;       (wrap (eval (list $vau formals #ignore (cons $sequence body)) env))))
-;; Phase 3 supplies it natively (single-expression body) so tests can
-;; build applicatives without a working $define!/$sequence yet. The
-;; native-then-portable migration is a Phase 4 concern.
-;;
-;; The env-param sentinel
-;; ----------------------
-;; A user operative records an `:env-param` slot. If the source said
-;; `#ignore`, the slot holds the keyword :knl-ignore and kernel-call-
-;; operative skips binding the dynamic env. The parser doesn't recognise
-;; `#ignore` yet (Phase 1 covered #t/#f only); guests must spell it
-;; `_` for now — the spelling-to-sentinel conversion lives here in
-;; knl-eparam-sentinel.
+;; 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)  — fresh env with $vau, $lambda, wrap, unwrap
-;;
-;; Consumes: lib/kernel/eval.sx (everything tagged kernel-*).
+;;   (kernel-base-env)       — Phase 3 combiners
+;;   (kernel-standard-env)   — Phase 4 standard environment
 
 (define
   knl-eparam-sentinel
@@ -39,7 +23,6 @@
       ((= sym "#ignore") :knl-ignore)
       (:else sym))))
 
-;; Validate that a formals list is a plain list of symbol names.
 (define
   knl-formals-ok?
   (fn
@@ -51,13 +34,6 @@
       (:else false))))
 
 ;; ── $vau ─────────────────────────────────────────────────────────
-;; ($vau FORMALS ENV-PARAM BODY) → user operative.
-;;
-;; FORMALS    — unevaluated list of parameter symbols.
-;; ENV-PARAM  — symbol (or `_` / `#ignore`).
-;; BODY       — single expression (Phase 3 limitation; $sequence later).
-;;
-;; The returned operative closes over the env where $vau was invoked.
 
 (define
   kernel-vau-impl
@@ -88,11 +64,6 @@
   (kernel-make-primitive-operative kernel-vau-impl))
 
 ;; ── $lambda ──────────────────────────────────────────────────────
-;; ($lambda FORMALS BODY) → user applicative.
-;;
-;; Equivalent to (wrap ($vau FORMALS #ignore BODY)) — args are evaluated
-;; before the operative body runs, and the operative ignores the dynamic
-;; environment.
 
 (define
   kernel-lambda-impl
@@ -115,7 +86,7 @@
   kernel-lambda-operative
   (kernel-make-primitive-operative kernel-lambda-impl))
 
-;; ── wrap / unwrap as Kernel applicatives ─────────────────────────
+;; ── wrap / unwrap / predicates ───────────────────────────────────
 
 (define
   kernel-wrap-applicative
@@ -137,7 +108,6 @@
           (error "unwrap: expects exactly 1 argument"))
         (:else (kernel-unwrap (first args)))))))
 
-;; Convenience predicates as applicatives too — tests want them.
 (define
   kernel-operative?-applicative
   (kernel-make-primitive-applicative
@@ -148,10 +118,6 @@
   (kernel-make-primitive-applicative
     (fn (args) (kernel-applicative? (first args)))))
 
-;; ── Base environment ─────────────────────────────────────────────
-;; A fresh env with the Phase 3 combiners bound. Standard env (Phase 4)
-;; will extend this with $if, $define!, arithmetic, list ops, etc.
-
 (define
   kernel-base-env
   (fn
@@ -165,3 +131,221 @@
       (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))))))
+
+(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))))))))
+
+;; ── 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 kernel-not-applicative (knl-unary-app "not" (fn (v) (not 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))))
+
+(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 "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-bin-app "+" (fn (a b) (+ a b))))
+      (kernel-env-bind! env "-" (knl-bin-app "-" (fn (a b) (- a b))))
+      (kernel-env-bind! env "*" (knl-bin-app "*" (fn (a b) (* a b))))
+      (kernel-env-bind! env "/" (knl-bin-app "/" (fn (a b) (/ a b))))
+      (kernel-env-bind! env "<" (knl-bin-app "<" (fn (a b) (< a b))))
+      (kernel-env-bind! env ">" (knl-bin-app ">" (fn (a b) (> a b))))
+      (kernel-env-bind! env "<=?" (knl-bin-app "<=?" (fn (a b) (<= a b))))
+      (kernel-env-bind! env ">=?" (knl-bin-app ">=?" (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 "not" kernel-not-applicative)
+      env)))