coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Phase 2: Remove dead tree-walk code from eval.sx

Browse Source 
eval.sx: 1272 → 846 lines (-33%). sx-browser.js: 392KB → 377KB.

Deleted (superseded by CEK step handlers in cek.sx):
- eval-list: tree-walk dispatch table
- eval-call: tree-walk function dispatch
- sf-if, sf-when, sf-cond (3 variants), sf-case (2 variants)
- sf-and, sf-or, sf-let, sf-begin, sf-quote, sf-quasiquote
- sf-thread-first, sf-set!, sf-define
- ho-map, ho-filter, ho-reduce, ho-some, ho-every, ho-for-each,
  ho-map-indexed, call-fn

Kept (still called by CEK as delegates):
- sf-lambda, sf-defcomp, sf-defisland, sf-defmacro, sf-defstyle,
  sf-deftype, sf-defeffect, sf-letrec, sf-named-let
- sf-scope, sf-provide, sf-dynamic-wind
- expand-macro, qq-expand, cond-scheme?
- call-lambda, call-component, parse-keyword-args
- Strict mode, type helpers

eval-expr is now a stub overridden by CEK fixup.
All tests unchanged: JS 747/747, Full 864/870, Python 679/679.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-15 13:28:09 +00:00
parent 9b4f735a0e
commit b4df216fae
5 changed files with 27 additions and 684 deletions
Download Patch File Download Diff File Expand all files Collapse all files

458
spec/eval.sx
View File

@@ -152,158 +152,29 @@
;; --------------------------------------------------------------------------
;; 3. Core evaluator
;; 3. Core evaluator — stub (overridden by CEK in fixups)
;; --------------------------------------------------------------------------
;;
;; eval-expr and trampoline are defined as stubs here so the transpiler
;; creates the variable declarations. The CEK fixups override them with:
;; eval-expr = (expr, env) → cek-run(make-cek-state(expr, env, []))
;; trampoline = (val) → if thunk? then eval-expr(thunk-expr, thunk-env) else val
;; All evaluation goes through the CEK machine.
(define eval-expr
(fn (expr (env :as dict))
(case (type-of expr)
;; --- literals pass through ---
"number" expr
"string" expr
"boolean" expr
"nil" nil
;; --- symbol lookup ---
"symbol"
(let ((name (symbol-name expr)))
(cond
(env-has? env name) (env-get env name)
(primitive? name) (get-primitive name)
(= name "true") true
(= name "false") false
(= name "nil") nil
:else (do (debug-log "Undefined symbol:" name "primitive?:" (primitive? name))
(error (str "Undefined symbol: " name)))))
;; --- keyword → its string name ---
"keyword" (keyword-name expr)
;; --- dict literal ---
"dict"
(map-dict (fn (k v) (trampoline (eval-expr v env))) expr)
;; --- list = call or special form ---
"list"
(if (empty? expr)
(list)
(eval-list expr env))
;; --- anything else passes through ---
:else expr)))
;; Stub — overridden by CEK fixup before any code runs.
;; If this executes, CEK fixup failed to load.
(error "eval-expr: CEK fixup not loaded")))
;; --------------------------------------------------------------------------
;; 4. List evaluation — dispatch on head
;; --------------------------------------------------------------------------
(define eval-list
(fn (expr (env :as dict))
(let ((head (first expr))
(args (rest expr)))
;; If head isn't a symbol, lambda, or list → treat as data list
(if (not (or (= (type-of head) "symbol")
(= (type-of head) "lambda")
(= (type-of head) "list")))
(map (fn (x) (trampoline (eval-expr x env))) expr)
;; Head is a symbol — check special forms, then function call
(if (= (type-of head) "symbol")
(let ((name (symbol-name head)))
(cond
;; Special forms
(= name "if") (sf-if args env)
(= name "when") (sf-when args env)
(= name "cond") (sf-cond args env)
(= name "case") (sf-case args env)
(= name "and") (sf-and args env)
(= name "or") (sf-or args env)
(= name "let") (sf-let args env)
(= name "let*") (sf-let args env)
(= name "letrec") (sf-letrec args env)
(= name "lambda") (sf-lambda args env)
(= name "fn") (sf-lambda args env)
(= name "define") (sf-define args env)
(= name "defcomp") (sf-defcomp args env)
(= name "defisland") (sf-defisland args env)
(= name "defmacro") (sf-defmacro args env)
(= name "defstyle") (sf-defstyle args env)
(= name "defhandler") (sf-defhandler args env)
(= name "defpage") (sf-defpage args env)
(= name "defquery") (sf-defquery args env)
(= name "defaction") (sf-defaction args env)
(= name "deftype") (sf-deftype args env)
(= name "defeffect") (sf-defeffect args env)
(= name "begin") (sf-begin args env)
(= name "do") (sf-begin args env)
(= name "quote") (sf-quote args env)
(= name "quasiquote") (sf-quasiquote args env)
(= name "->") (sf-thread-first args env)
(= name "set!") (sf-set! args env)
(= name "reset") (sf-reset args env)
(= name "shift") (sf-shift args env)
(= name "dynamic-wind") (sf-dynamic-wind args env)
(= name "scope") (sf-scope args env)
(= name "provide") (sf-provide args env)
;; Higher-order forms
(= name "map") (ho-map args env)
(= name "map-indexed") (ho-map-indexed args env)
(= name "filter") (ho-filter args env)
(= name "reduce") (ho-reduce args env)
(= name "some") (ho-some args env)
(= name "every?") (ho-every args env)
(= name "for-each") (ho-for-each args env)
;; Macro expansion
(and (env-has? env name) (macro? (env-get env name)))
(let ((mac (env-get env name)))
(make-thunk (expand-macro mac args env) env))
;; Render expression — delegate to active adapter (only when rendering).
(and (render-active?) (is-render-expr? expr))
(render-expr expr env)
;; Fall through to function call
:else (eval-call head args env)))
;; Head is lambda or list — evaluate as function call
(eval-call head args env))))))
;; [REMOVED] Section 4: Tree-walk eval-list dispatch table — superseded by CEK step-eval-list
;; --------------------------------------------------------------------------
;; 5. Function / lambda / component call
;; --------------------------------------------------------------------------
(define eval-call
(fn (head (args :as list) (env :as dict))
(let ((f (trampoline (eval-expr head env)))
(evaluated-args (map (fn (a) (trampoline (eval-expr a env))) args)))
(cond
;; Native callable (primitive function)
(and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f)))
(do
;; Strict mode: check arg types before dispatch
(when (and *strict* (= (type-of head) "symbol"))
(strict-check-args (symbol-name head) evaluated-args))
(apply f evaluated-args))
;; Lambda
(lambda? f)
(call-lambda f evaluated-args env)
;; Component
(component? f)
(call-component f args env)
;; Island (reactive component) — same calling convention
(island? f)
(call-component f args env)
:else (error (str "Not callable: " (inspect f)))))))
;; [REMOVED] eval-call — superseded by CEK continue-with-call
(define call-lambda
(fn ((f :as lambda) (args :as list) (caller-env :as dict))
@@ -376,159 +247,16 @@
;; --------------------------------------------------------------------------
;; 6. Special forms
;; --------------------------------------------------------------------------
(define sf-if
(fn ((args :as list) (env :as dict))
(let ((condition (trampoline (eval-expr (first args) env))))
(if (and condition (not (nil? condition)))
(make-thunk (nth args 1) env)
(if (> (len args) 2)
(make-thunk (nth args 2) env)
nil)))))
;; [REMOVED] sf-if, sf-when, sf-cond, sf-case, sf-and, sf-or, sf-let
;; — all superseded by CEK step handlers in cek.sx
(define sf-when
(fn ((args :as list) (env :as dict))
(let ((condition (trampoline (eval-expr (first args) env))))
(if (and condition (not (nil? condition)))
(do
;; Evaluate all but last for side effects
(for-each
(fn (e) (trampoline (eval-expr e env)))
(slice args 1 (dec (len args))))
;; Last is tail position
(make-thunk (last args) env))
nil))))
;; cond-scheme? — check if ALL clauses are 2-element lists (scheme-style).
;; Checking only the first arg is ambiguous — (nil? x) is a 2-element
;; function call, not a scheme clause ((test body)).
;; cond-scheme? — still needed by CEK's step-sf-cond
(define cond-scheme?
(fn ((clauses :as list))
(every? (fn (c) (and (= (type-of c) "list") (= (len c) 2)))
clauses)))
(define sf-cond
(fn ((args :as list) (env :as dict))
(if (cond-scheme? args)
(sf-cond-scheme args env)
(sf-cond-clojure args env))))
(define sf-cond-scheme
(fn ((clauses :as list) (env :as dict))
(if (empty? clauses)
nil
(let ((clause (first clauses))
(test (first clause))
(body (nth clause 1)))
(if (or (and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else")))
(and (= (type-of test) "keyword")
(= (keyword-name test) "else")))
(make-thunk body env)
(if (trampoline (eval-expr test env))
(make-thunk body env)
(sf-cond-scheme (rest clauses) env)))))))
(define sf-cond-clojure
(fn ((clauses :as list) (env :as dict))
(if (< (len clauses) 2)
nil
(let ((test (first clauses))
(body (nth clauses 1)))
(if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
(and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else"))))
(make-thunk body env)
(if (trampoline (eval-expr test env))
(make-thunk body env)
(sf-cond-clojure (slice clauses 2) env)))))))
(define sf-case
(fn ((args :as list) (env :as dict))
(let ((match-val (trampoline (eval-expr (first args) env)))
(clauses (rest args)))
(sf-case-loop match-val clauses env))))
(define sf-case-loop
(fn (match-val (clauses :as list) (env :as dict))
(if (< (len clauses) 2)
nil
(let ((test (first clauses))
(body (nth clauses 1)))
(if (or (and (= (type-of test) "keyword") (= (keyword-name test) "else"))
(and (= (type-of test) "symbol")
(or (= (symbol-name test) "else")
(= (symbol-name test) ":else"))))
(make-thunk body env)
(if (= match-val (trampoline (eval-expr test env)))
(make-thunk body env)
(sf-case-loop match-val (slice clauses 2) env)))))))
(define sf-and
(fn ((args :as list) (env :as dict))
(if (empty? args)
true
(let ((val (trampoline (eval-expr (first args) env))))
(if (not val)
val
(if (= (len args) 1)
val
(sf-and (rest args) env)))))))
(define sf-or
(fn ((args :as list) (env :as dict))
(if (empty? args)
false
(let ((val (trampoline (eval-expr (first args) env))))
(if val
val
(sf-or (rest args) env))))))
(define sf-let
(fn ((args :as list) (env :as dict))
;; Detect named let: (let name ((x 0) ...) body)
;; If first arg is a symbol, delegate to sf-named-let.
(if (= (type-of (first args)) "symbol")
(sf-named-let args env)
(let ((bindings (first args))
(body (rest args))
(local (env-extend env)))
;; Parse bindings — support both ((name val) ...) and (name val name val ...)
(if (and (= (type-of (first bindings)) "list")
(= (len (first bindings)) 2))
;; Scheme-style
(for-each
(fn (binding)
(let ((vname (if (= (type-of (first binding)) "symbol")
(symbol-name (first binding))
(first binding))))
(env-bind! local vname (trampoline (eval-expr (nth binding 1) local)))))
bindings)
;; Clojure-style
(let ((i 0))
(reduce
(fn (acc pair-idx)
(let ((vname (if (= (type-of (nth bindings (* pair-idx 2))) "symbol")
(symbol-name (nth bindings (* pair-idx 2)))
(nth bindings (* pair-idx 2))))
(val-expr (nth bindings (inc (* pair-idx 2)))))
(env-bind! local vname (trampoline (eval-expr val-expr local)))))
nil
(range 0 (/ (len bindings) 2)))))
;; Evaluate body — last expression in tail position
(for-each
(fn (e) (trampoline (eval-expr e local)))
(slice body 0 (dec (len body))))
(make-thunk (last body) local)))))
;; Named let: (let name ((x 0) (y 1)) body...)
;; Desugars to a self-recursive lambda called with initial values.
@@ -595,37 +323,6 @@
(make-lambda param-names body env))))
(define sf-define
(fn ((args :as list) (env :as dict))
;; Detect :effects keyword: (define name :effects [...] value)
(let ((name-sym (first args))
(has-effects (and (>= (len args) 4)
(= (type-of (nth args 1)) "keyword")
(= (keyword-name (nth args 1)) "effects")))
(val-idx (if (and (>= (len args) 4)
(= (type-of (nth args 1)) "keyword")
(= (keyword-name (nth args 1)) "effects"))
3 1))
(value (trampoline (eval-expr (nth args val-idx) env))))
(when (and (lambda? value) (nil? (lambda-name value)))
(set-lambda-name! value (symbol-name name-sym)))
(env-bind! env (symbol-name name-sym) value)
;; Store effect annotation if declared
(when has-effects
(let ((effects-raw (nth args 2))
(effect-list (if (= (type-of effects-raw) "list")
(map (fn (e) (if (= (type-of e) "symbol")
(symbol-name e) (str e)))
effects-raw)
(list (str effects-raw))))
(effect-anns (if (env-has? env "*effect-annotations*")
(env-get env "*effect-annotations*")
(dict))))
(dict-set! effect-anns (symbol-name name-sym) effect-list)
(env-bind! env "*effect-annotations*" effect-anns)))
value)))
(define sf-defcomp
(fn ((args :as list) (env :as dict))
;; (defcomp ~name (params) [:affinity :client|:server] body)
@@ -855,26 +552,6 @@
nil)))
(define sf-begin
(fn ((args :as list) (env :as dict))
(if (empty? args)
nil
(do
(for-each
(fn (e) (trampoline (eval-expr e env)))
(slice args 0 (dec (len args))))
(make-thunk (last args) env)))))
(define sf-quote
(fn ((args :as list) (env :as dict))
(if (empty? args) nil (first args))))
(define sf-quasiquote
(fn ((args :as list) (env :as dict))
(qq-expand (first args) env)))
(define qq-expand
(fn (template (env :as dict))
(if (not (= (type-of template) "list"))
@@ -900,41 +577,6 @@
template)))))))
(define sf-thread-first
(fn ((args :as list) (env :as dict))
(let ((val (trampoline (eval-expr (first args) env))))
(reduce
(fn (result form)
(if (= (type-of form) "list")
(let ((f (trampoline (eval-expr (first form) env)))
(rest-args (map (fn (a) (trampoline (eval-expr a env)))
(rest form)))
(all-args (cons result rest-args)))
(cond
(and (callable? f) (not (lambda? f)))
(apply f all-args)
(lambda? f)
(trampoline (call-lambda f all-args env))
:else (error (str "-> form not callable: " (inspect f)))))
(let ((f (trampoline (eval-expr form env))))
(cond
(and (callable? f) (not (lambda? f)))
(f result)
(lambda? f)
(trampoline (call-lambda f (list result) env))
:else (error (str "-> form not callable: " (inspect f)))))))
val
(rest args)))))
(define sf-set!
(fn ((args :as list) (env :as dict))
(let ((name (symbol-name (first args)))
(value (trampoline (eval-expr (nth args 1) env))))
(env-set! env name value)
value)))
;; --------------------------------------------------------------------------
;; 6c. letrec — mutually recursive local bindings
;; --------------------------------------------------------------------------
@@ -1098,75 +740,7 @@
(trampoline (eval-expr (macro-body mac) local)))))
;; --------------------------------------------------------------------------
;; 7. Higher-order forms
;; --------------------------------------------------------------------------
;; call-fn: unified caller for HO forms — handles both Lambda and native callable
(define call-fn
(fn (f (args :as list) (env :as dict))
(cond
(lambda? f) (trampoline (call-lambda f args env))
(callable? f) (apply f args)
:else (error (str "Not callable in HO form: " (inspect f))))))
(define ho-map
(fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(map (fn (item) (call-fn f (list item) env)) coll))))
(define ho-map-indexed
(fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(map-indexed
(fn (i item) (call-fn f (list i item) env))
coll))))
(define ho-filter
(fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(filter
(fn (item) (call-fn f (list item) env))
coll))))
(define ho-reduce
(fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env)))
(init (trampoline (eval-expr (nth args 1) env)))
(coll (trampoline (eval-expr (nth args 2) env))))
(reduce
(fn (acc item) (call-fn f (list acc item) env))
init
coll))))
(define ho-some
(fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(some
(fn (item) (call-fn f (list item) env))
coll))))
(define ho-every
(fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(every?
(fn (item) (call-fn f (list item) env))
coll))))
(define ho-for-each
(fn ((args :as list) (env :as dict))
(let ((f (trampoline (eval-expr (first args) env)))
(coll (trampoline (eval-expr (nth args 1) env))))
(for-each
(fn (item) (call-fn f (list item) env))
coll))))
;; [REMOVED] Section 7: Tree-walk HO forms — superseded by CEK step-ho-* in cek.sx
;; --------------------------------------------------------------------------
;; 8. Primitives — pure functions available in all targets