rose-ash/lib/kernel/runtime.sx

;; lib/kernel/runtime.sx — the operative–applicative substrate.
;;
;; Builds the first user-visible operatives so Kernel programs can
;; construct their own combiners:
;;
;;   $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.
;;
;; Public API
;;   (kernel-base-env)  — fresh env with $vau, $lambda, wrap, unwrap
;;
;; Consumes: lib/kernel/eval.sx (everything tagged kernel-*).

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

;; Validate that a formals list is a plain list of symbol names.
(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 ─────────────────────────────────────────────────────────
;; ($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
  (fn
    (args dyn-env)
    (cond
      ((not (= (length args) 3))
        (error "$vau: expects (formals env-param body)"))
      (:else
        (let
          ((formals (first args))
            (eparam-raw (nth args 1))
            (body (nth args 2)))
          (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
                dyn-env))))))))

(define
  kernel-vau-operative
  (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
  (fn
    (args dyn-env)
    (cond
      ((not (= (length args) 2))
        (error "$lambda: expects (formals body)"))
      (:else
        (let
          ((formals (first args)) (body (nth args 1)))
          (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 dyn-env)))))))))

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

;; ── wrap / unwrap as Kernel applicatives ─────────────────────────

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

;; Convenience predicates as applicatives too — tests want them.
(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)))))

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