giles
5a03943b39
Two fundamental environment bugs fixed: 1. env-set! was used for both binding creation (let, define, params) and mutation (set!). Binding creation must NOT walk the scope chain — it should set on the immediate env. Only set! should walk. Fix: introduce env-bind! for all binding creation. env-set! now exclusively means "mutate existing binding, walk scope chain". Changed across spec (eval.sx, cek.sx, render.sx) and all web adapters (dom, html, sx, async, boot, orchestration, forms). 2. makeLambda/makeComponent/makeMacro/makeIsland used merge(env) to flatten the closure into a plain object, destroying the prototype chain. This meant set! inside closures couldn't reach the original binding — it modified a snapshot copy instead. Fix: store env directly as closure (no merge). The prototype chain is preserved, so set! walks up to the original scope. Tests: 499/516 passing (96.7%), up from 485/516. Fixed: define self-reference, let scope isolation, set! through closures, counter-via-closure pattern, recursive functions. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
408 lines
15 KiB
Plaintext
408 lines
15 KiB
Plaintext
;; ==========================================================================
|
|
;; adapter-sx.sx — SX wire format rendering adapter
|
|
;;
|
|
;; Serializes SX expressions for client-side rendering.
|
|
;; Component calls are NOT expanded — they're sent to the client as-is.
|
|
;; HTML tags are serialized as SX source text. Special forms are evaluated.
|
|
;;
|
|
;; Depends on:
|
|
;; render.sx — HTML_TAGS
|
|
;; eval.sx — eval-expr, trampoline, call-lambda, expand-macro
|
|
;; ==========================================================================
|
|
|
|
|
|
(define render-to-sx :effects [render]
|
|
(fn (expr (env :as dict))
|
|
(let ((result (aser expr env)))
|
|
;; aser-call already returns serialized SX strings;
|
|
;; only serialize non-string values
|
|
(if (= (type-of result) "string")
|
|
result
|
|
(serialize result)))))
|
|
|
|
(define aser :effects [render]
|
|
(fn ((expr :as any) (env :as dict))
|
|
;; Evaluate for SX wire format — serialize rendering forms,
|
|
;; evaluate control flow and function calls.
|
|
(set-render-active! true)
|
|
(let ((result
|
|
(case (type-of expr)
|
|
"number" expr
|
|
"string" expr
|
|
"boolean" expr
|
|
"nil" nil
|
|
|
|
"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 (error (str "Undefined symbol: " name))))
|
|
|
|
"keyword" (keyword-name expr)
|
|
|
|
"list"
|
|
(if (empty? expr)
|
|
(list)
|
|
(aser-list expr env))
|
|
|
|
;; Spread — emit attrs to nearest element provider
|
|
"spread" (do (emit! "element-attrs" (spread-attrs expr)) nil)
|
|
|
|
:else expr)))
|
|
;; Catch spread values from function calls and symbol lookups
|
|
(if (spread? result)
|
|
(do (emit! "element-attrs" (spread-attrs result)) nil)
|
|
result))))
|
|
|
|
|
|
(define aser-list :effects [render]
|
|
(fn ((expr :as list) (env :as dict))
|
|
(let ((head (first expr))
|
|
(args (rest expr)))
|
|
(if (not (= (type-of head) "symbol"))
|
|
(map (fn (x) (aser x env)) expr)
|
|
(let ((name (symbol-name head)))
|
|
(cond
|
|
;; Fragment — serialize children
|
|
(= name "<>")
|
|
(aser-fragment args env)
|
|
|
|
;; Component call — serialize WITHOUT expanding
|
|
(starts-with? name "~")
|
|
(aser-call name args env)
|
|
|
|
;; Lake — serialize (server-morphable slot)
|
|
(= name "lake")
|
|
(aser-call name args env)
|
|
|
|
;; Marsh — serialize (reactive server-morphable slot)
|
|
(= name "marsh")
|
|
(aser-call name args env)
|
|
|
|
;; HTML tag — serialize
|
|
(contains? HTML_TAGS name)
|
|
(aser-call name args env)
|
|
|
|
;; Special/HO forms — evaluate (produces data)
|
|
(or (special-form? name) (ho-form? name))
|
|
(aser-special name expr env)
|
|
|
|
;; Macro — expand then aser
|
|
(and (env-has? env name) (macro? (env-get env name)))
|
|
(aser (expand-macro (env-get env name) args env) env)
|
|
|
|
;; Function call — evaluate fully
|
|
:else
|
|
(let ((f (trampoline (eval-expr head env)))
|
|
(evaled-args (map (fn (a) (trampoline (eval-expr a env))) args)))
|
|
(cond
|
|
(and (callable? f) (not (lambda? f)) (not (component? f)) (not (island? f)))
|
|
(apply f evaled-args)
|
|
(lambda? f)
|
|
(trampoline (call-lambda f evaled-args env))
|
|
(component? f)
|
|
(aser-call (str "~" (component-name f)) args env)
|
|
(island? f)
|
|
(aser-call (str "~" (component-name f)) args env)
|
|
:else (error (str "Not callable: " (inspect f)))))))))))
|
|
|
|
|
|
(define aser-fragment :effects [render]
|
|
(fn ((children :as list) (env :as dict))
|
|
;; Serialize (<> child1 child2 ...) to sx source string
|
|
;; Must flatten list results (e.g. from map/filter) to avoid nested parens
|
|
(let ((parts (list)))
|
|
(for-each
|
|
(fn (c)
|
|
(let ((result (aser c env)))
|
|
(if (= (type-of result) "list")
|
|
(for-each
|
|
(fn (item)
|
|
(when (not (nil? item))
|
|
(append! parts (serialize item))))
|
|
result)
|
|
(when (not (nil? result))
|
|
(append! parts (serialize result))))))
|
|
children)
|
|
(if (empty? parts)
|
|
""
|
|
(str "(<> " (join " " parts) ")")))))
|
|
|
|
|
|
(define aser-call :effects [render]
|
|
(fn ((name :as string) (args :as list) (env :as dict))
|
|
;; Serialize (name :key val child ...) — evaluate args but keep as sx
|
|
;; Uses for-each + mutable state (not reduce) so bootstrapper emits for-loops
|
|
;; that can contain nested for-each for list flattening.
|
|
;; Separate attrs and children so emitted spread attrs go before children.
|
|
(let ((attr-parts (list))
|
|
(child-parts (list))
|
|
(skip false)
|
|
(i 0))
|
|
;; Provide scope for spread emit!
|
|
(scope-push! "element-attrs" nil)
|
|
(for-each
|
|
(fn (arg)
|
|
(if skip
|
|
(do (set! skip false)
|
|
(set! i (inc i)))
|
|
(if (and (= (type-of arg) "keyword")
|
|
(< (inc i) (len args)))
|
|
(let ((val (aser (nth args (inc i)) env)))
|
|
(when (not (nil? val))
|
|
(append! attr-parts (str ":" (keyword-name arg)))
|
|
(append! attr-parts (serialize val)))
|
|
(set! skip true)
|
|
(set! i (inc i)))
|
|
(let ((val (aser arg env)))
|
|
(when (not (nil? val))
|
|
(if (= (type-of val) "list")
|
|
(for-each
|
|
(fn (item)
|
|
(when (not (nil? item))
|
|
(append! child-parts (serialize item))))
|
|
val)
|
|
(append! child-parts (serialize val))))
|
|
(set! i (inc i))))))
|
|
args)
|
|
;; Collect emitted spread attrs — goes after explicit attrs, before children
|
|
(for-each
|
|
(fn (spread-dict)
|
|
(for-each
|
|
(fn (k)
|
|
(let ((v (dict-get spread-dict k)))
|
|
(append! attr-parts (str ":" k))
|
|
(append! attr-parts (serialize v))))
|
|
(keys spread-dict)))
|
|
(emitted "element-attrs"))
|
|
(scope-pop! "element-attrs")
|
|
(let ((parts (concat (list name) attr-parts child-parts)))
|
|
(str "(" (join " " parts) ")")))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Form classification
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(define SPECIAL_FORM_NAMES
|
|
(list "if" "when" "cond" "case" "and" "or"
|
|
"let" "let*" "lambda" "fn"
|
|
"define" "defcomp" "defmacro" "defstyle"
|
|
"defhandler" "defpage" "defquery" "defaction" "defrelation"
|
|
"begin" "do" "quote" "quasiquote"
|
|
"->" "set!" "letrec" "dynamic-wind" "defisland"
|
|
"deftype" "defeffect" "scope" "provide"))
|
|
|
|
(define HO_FORM_NAMES
|
|
(list "map" "map-indexed" "filter" "reduce"
|
|
"some" "every?" "for-each"))
|
|
|
|
(define special-form? :effects []
|
|
(fn ((name :as string))
|
|
(contains? SPECIAL_FORM_NAMES name)))
|
|
|
|
(define ho-form? :effects []
|
|
(fn ((name :as string))
|
|
(contains? HO_FORM_NAMES name)))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; aser-special — evaluate special/HO forms in aser mode
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Control flow forms evaluate conditions normally but render branches
|
|
;; through aser (serializing tags/components instead of rendering HTML).
|
|
;; Definition forms evaluate for side effects and return nil.
|
|
|
|
(define aser-special :effects [render]
|
|
(fn ((name :as string) (expr :as list) (env :as dict))
|
|
(let ((args (rest expr)))
|
|
(cond
|
|
;; if — evaluate condition, aser chosen branch
|
|
(= name "if")
|
|
(if (trampoline (eval-expr (first args) env))
|
|
(aser (nth args 1) env)
|
|
(if (> (len args) 2)
|
|
(aser (nth args 2) env)
|
|
nil))
|
|
|
|
;; when — evaluate condition, aser body if true
|
|
(= name "when")
|
|
(if (not (trampoline (eval-expr (first args) env)))
|
|
nil
|
|
(let ((result nil))
|
|
(for-each (fn (body) (set! result (aser body env)))
|
|
(rest args))
|
|
result))
|
|
|
|
;; cond — evaluate conditions, aser matching branch
|
|
(= name "cond")
|
|
(let ((branch (eval-cond args env)))
|
|
(if branch (aser branch env) nil))
|
|
|
|
;; case — evaluate match value, check each pair
|
|
(= name "case")
|
|
(let ((match-val (trampoline (eval-expr (first args) env)))
|
|
(clauses (rest args)))
|
|
(eval-case-aser match-val clauses env))
|
|
|
|
;; let / let*
|
|
(or (= name "let") (= name "let*"))
|
|
(let ((local (process-bindings (first args) env))
|
|
(result nil))
|
|
(for-each (fn (body) (set! result (aser body local)))
|
|
(rest args))
|
|
result)
|
|
|
|
;; begin / do
|
|
(or (= name "begin") (= name "do"))
|
|
(let ((result nil))
|
|
(for-each (fn (body) (set! result (aser body env))) args)
|
|
result)
|
|
|
|
;; and — short-circuit
|
|
(= name "and")
|
|
(let ((result true))
|
|
(some (fn (arg)
|
|
(set! result (trampoline (eval-expr arg env)))
|
|
(not result))
|
|
args)
|
|
result)
|
|
|
|
;; or — short-circuit
|
|
(= name "or")
|
|
(let ((result false))
|
|
(some (fn (arg)
|
|
(set! result (trampoline (eval-expr arg env)))
|
|
result)
|
|
args)
|
|
result)
|
|
|
|
;; map — evaluate function and collection, map through aser
|
|
(= name "map")
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map (fn (item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-bind! local (first (lambda-params f)) item)
|
|
(aser (lambda-body f) local))
|
|
(cek-call f (list item))))
|
|
coll))
|
|
|
|
;; map-indexed
|
|
(= name "map-indexed")
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env))))
|
|
(map-indexed (fn (i item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-bind! local (first (lambda-params f)) i)
|
|
(env-bind! local (nth (lambda-params f) 1) item)
|
|
(aser (lambda-body f) local))
|
|
(cek-call f (list i item))))
|
|
coll))
|
|
|
|
;; for-each — evaluate for side effects, aser each body
|
|
(= name "for-each")
|
|
(let ((f (trampoline (eval-expr (first args) env)))
|
|
(coll (trampoline (eval-expr (nth args 1) env)))
|
|
(results (list)))
|
|
(for-each (fn (item)
|
|
(if (lambda? f)
|
|
(let ((local (env-merge (lambda-closure f) env)))
|
|
(env-bind! local (first (lambda-params f)) item)
|
|
(append! results (aser (lambda-body f) local)))
|
|
(cek-call f (list item))))
|
|
coll)
|
|
(if (empty? results) nil results))
|
|
|
|
;; defisland — evaluate AND serialize (client needs the definition)
|
|
(= name "defisland")
|
|
(do (trampoline (eval-expr expr env))
|
|
(serialize expr))
|
|
|
|
;; Definition forms — evaluate for side effects
|
|
(or (= name "define") (= name "defcomp") (= name "defmacro")
|
|
(= name "defstyle") (= name "defhandler") (= name "defpage")
|
|
(= name "defquery") (= name "defaction") (= name "defrelation")
|
|
(= name "deftype") (= name "defeffect"))
|
|
(do (trampoline (eval-expr expr env)) nil)
|
|
|
|
;; scope — unified render-time dynamic scope
|
|
(= name "scope")
|
|
(let ((scope-name (trampoline (eval-expr (first args) env)))
|
|
(rest-args (rest args))
|
|
(scope-val nil)
|
|
(body-args nil))
|
|
;; Check for :value keyword
|
|
(if (and (>= (len rest-args) 2)
|
|
(= (type-of (first rest-args)) "keyword")
|
|
(= (keyword-name (first rest-args)) "value"))
|
|
(do (set! scope-val (trampoline (eval-expr (nth rest-args 1) env)))
|
|
(set! body-args (slice rest-args 2)))
|
|
(set! body-args rest-args))
|
|
(scope-push! scope-name scope-val)
|
|
(let ((result nil))
|
|
(for-each (fn (body) (set! result (aser body env)))
|
|
body-args)
|
|
(scope-pop! scope-name)
|
|
result))
|
|
|
|
;; provide — sugar for scope with value
|
|
(= name "provide")
|
|
(let ((prov-name (trampoline (eval-expr (first args) env)))
|
|
(prov-val (trampoline (eval-expr (nth args 1) env)))
|
|
(result nil))
|
|
(scope-push! prov-name prov-val)
|
|
(for-each (fn (body) (set! result (aser body env)))
|
|
(slice args 2))
|
|
(scope-pop! prov-name)
|
|
result)
|
|
|
|
;; Everything else — evaluate normally
|
|
:else
|
|
(trampoline (eval-expr expr env))))))
|
|
|
|
|
|
;; Helper: case dispatch for aser mode
|
|
(define eval-case-aser :effects [render]
|
|
(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"))))
|
|
(aser body env)
|
|
(if (= match-val (trampoline (eval-expr test env)))
|
|
(aser body env)
|
|
(eval-case-aser match-val (slice clauses 2) env)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Platform interface — SX wire adapter
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; From eval.sx:
|
|
;; eval-expr, trampoline, call-lambda, expand-macro
|
|
;; env-has?, env-get, env-set!, env-merge, callable?, lambda?, component?,
|
|
;; macro?, island?, primitive?, get-primitive, component-name
|
|
;; lambda-closure, lambda-params, lambda-body
|
|
;;
|
|
;; From render.sx:
|
|
;; HTML_TAGS, eval-cond, process-bindings
|
|
;;
|
|
;; From parser.sx:
|
|
;; serialize (= sx-serialize)
|
|
;;
|
|
;; From signals.sx (optional):
|
|
;; invoke
|
|
;; --------------------------------------------------------------------------
|