OCaml VM browser: safe equality, thunk trampolining, platform functions, nav pipeline
Core runtime fixes: - Safe equality (=, !=): physical equality for dicts/lambdas/signals, structural only for acyclic types. Prevents infinite loops on circular signal subscriber chains. - contains?: same safe comparison (physical first, structural for simple types) - Thunk trampolining in as_number and to_string: leaked thunks auto-resolve instead of showing <thunk> or erroring "Expected number, got thunk" - Diagnostic first error: shows actual type received Island hydration fixes: - adapter-dom.sx: skip scope-emit for spreads inside islands (was tripling classes) - schedule-idle: wrap callback to absorb requestIdleCallback deadline arg - home-stepper: remove spread-specific highlighting (all tokens same style per step) Platform functions (boot-helpers.sx): - fetch-request: 3-arg interface (config, success-fn, error-fn) with promise chain - build-request-body: form serialization for GET/POST - strip-component-scripts / extract-response-css: SX text processing - Navigation: bind-boost-link, bind-client-route-click via execute-request - Loading state: show-indicator, disable-elements, clear-loading-state - DOM extras: dom-remove, dom-attr-list (name/value pairs), dom-child-list (SX list), dom-is-active-element?, dom-is-input-element?, dom-is-child-of?, dom-on, dom-parse-html-document, dom-body-inner-html, create-script-clone - All remaining stubs: csrf-token, loaded-component-names, observe-intersection, event-source-connect/listen, with-transition, cross-origin?, etc. Navigation pipeline: - browser-push-state/replace-state: accept 1-arg (URL only) or 3-arg - boot.sx: wire popstate listener to handle-popstate - URL updates working via handle-history + pushState fix Morph debugging (WIP): - dom-child-list returns proper SX list (was JS Array) - dom-query accepts optional root element for scoped queries - Navigation fetches and renders SX responses, URL updates, but morph doesn't replace content div (investigating dom-child-list on new elements) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -13,6 +13,12 @@
|
||||
(define SVG_NS "http://www.w3.org/2000/svg")
|
||||
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
|
||||
|
||||
;; Check if we're inside an island scope.
|
||||
;; Uses scope-peek (mutable scope stack) rather than context (CEK continuation)
|
||||
;; because with-island-scope uses scope-push!, not provide.
|
||||
(define island-scope?
|
||||
(fn () (not (nil? (scope-peek "sx-island-scope")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; dom-on — dom-listen with post-render hooks
|
||||
@@ -27,7 +33,7 @@
|
||||
(dom-listen el name
|
||||
(if (lambda? handler)
|
||||
(if (= 0 (len (lambda-params handler)))
|
||||
(fn () (trampoline (call-lambda handler (list))) (run-post-render-hooks))
|
||||
(fn (_e) (trampoline (call-lambda handler (list))) (run-post-render-hooks))
|
||||
(fn (e) (trampoline (call-lambda handler (list e))) (run-post-render-hooks)))
|
||||
handler))))
|
||||
|
||||
@@ -63,7 +69,11 @@
|
||||
"dom-node" expr
|
||||
|
||||
;; Spread → emit attrs to nearest element provider, pass through for reactive-spread
|
||||
"spread" (do (emit! "element-attrs" (spread-attrs expr)) expr)
|
||||
;; Inside islands, reactive-spread handles attr application directly —
|
||||
;; skip scope emission to avoid double/triple application.
|
||||
"spread" (do (when (not (island-scope?))
|
||||
(scope-emit! "element-attrs" (spread-attrs expr)))
|
||||
expr)
|
||||
|
||||
;; Dict → empty
|
||||
"dict" (create-fragment)
|
||||
@@ -77,7 +87,7 @@
|
||||
;; Signal → reactive text in island scope, deref outside
|
||||
:else
|
||||
(if (signal? expr)
|
||||
(if (context "sx-island-scope" nil)
|
||||
(if (island-scope?)
|
||||
(reactive-text expr)
|
||||
(create-text-node (str (deref expr))))
|
||||
(create-text-node (str expr))))))
|
||||
@@ -161,7 +171,7 @@
|
||||
(render-dom-element name args env ns)
|
||||
|
||||
;; deref in island scope → reactive text node
|
||||
(and (= name "deref") (context "sx-island-scope" nil))
|
||||
(and (= name "deref") (island-scope?))
|
||||
(let ((sig-or-val (trampoline (eval-expr (first args) env))))
|
||||
(if (signal? sig-or-val)
|
||||
(reactive-text sig-or-val)
|
||||
@@ -233,7 +243,7 @@
|
||||
;; Inside island scope: reactive attribute binding.
|
||||
;; The effect tracks signal deps automatically — if none
|
||||
;; are deref'd, it fires once and never again (safe).
|
||||
(context "sx-island-scope" nil)
|
||||
(island-scope?)
|
||||
(reactive-attr el attr-name
|
||||
(fn () (trampoline (eval-expr attr-expr env))))
|
||||
;; Static attribute (outside islands)
|
||||
@@ -255,7 +265,7 @@
|
||||
(let ((child (render-to-dom arg env new-ns)))
|
||||
(cond
|
||||
;; Reactive spread: track signal deps, update attrs on change
|
||||
(and (spread? child) (context "sx-island-scope" nil))
|
||||
(and (spread? child) (island-scope?))
|
||||
(reactive-spread el (fn () (render-to-dom arg env new-ns)))
|
||||
;; Static spread: already emitted via provide, skip
|
||||
(spread? child) nil
|
||||
@@ -286,7 +296,7 @@
|
||||
val)))
|
||||
(dom-set-attr el key (str val))))))
|
||||
(keys spread-dict)))
|
||||
(emitted "element-attrs"))
|
||||
(scope-emitted "element-attrs"))
|
||||
(scope-pop! "element-attrs")
|
||||
|
||||
el)))
|
||||
@@ -396,7 +406,7 @@
|
||||
;; produce DOM nodes rather than evaluated values.
|
||||
|
||||
(define RENDER_DOM_FORMS
|
||||
(list "if" "when" "cond" "case" "let" "let*" "begin" "do"
|
||||
(list "if" "when" "cond" "case" "let" "let*" "letrec" "begin" "do"
|
||||
"define" "defcomp" "defisland" "defmacro" "defstyle"
|
||||
"map" "map-indexed" "filter" "for-each" "portal"
|
||||
"error-boundary" "scope" "provide"))
|
||||
@@ -410,7 +420,7 @@
|
||||
(cond
|
||||
;; if — reactive inside islands (re-renders when signal deps change)
|
||||
(= name "if")
|
||||
(if (context "sx-island-scope" nil)
|
||||
(if (island-scope?)
|
||||
(let ((marker (create-comment "r-if"))
|
||||
(current-nodes (list))
|
||||
(initial-result nil))
|
||||
@@ -458,7 +468,7 @@
|
||||
|
||||
;; when — reactive inside islands
|
||||
(= name "when")
|
||||
(if (context "sx-island-scope" nil)
|
||||
(if (island-scope?)
|
||||
(let ((marker (create-comment "r-when"))
|
||||
(current-nodes (list))
|
||||
(initial-result nil))
|
||||
@@ -504,7 +514,7 @@
|
||||
|
||||
;; cond — reactive inside islands
|
||||
(= name "cond")
|
||||
(if (context "sx-island-scope" nil)
|
||||
(if (island-scope?)
|
||||
(let ((marker (create-comment "r-cond"))
|
||||
(current-nodes (list))
|
||||
(initial-result nil))
|
||||
@@ -561,6 +571,30 @@
|
||||
(range 2 (len expr)))
|
||||
frag)))
|
||||
|
||||
;; letrec — pre-bind all names (nil), evaluate values, render body.
|
||||
(= name "letrec")
|
||||
(let ((bindings (nth expr 1))
|
||||
(body (slice expr 2))
|
||||
(local (env-extend env)))
|
||||
;; Phase 1: pre-bind all names to nil
|
||||
(for-each (fn (pair)
|
||||
(let ((pname (if (= (type-of (first pair)) "symbol")
|
||||
(symbol-name (first pair))
|
||||
(str (first pair)))))
|
||||
(env-bind! local pname nil)))
|
||||
bindings)
|
||||
;; Phase 2: evaluate values (all names in scope for mutual recursion)
|
||||
(for-each (fn (pair)
|
||||
(let ((pname (if (= (type-of (first pair)) "symbol")
|
||||
(symbol-name (first pair))
|
||||
(str (first pair)))))
|
||||
(env-set! local pname (trampoline (eval-expr (nth pair 1) local)))))
|
||||
bindings)
|
||||
;; Phase 3: eval non-last body exprs for side effects, render last
|
||||
(when (> (len body) 1)
|
||||
(for-each (fn (e) (trampoline (eval-expr e local))) (init body)))
|
||||
(render-to-dom (last body) local ns))
|
||||
|
||||
;; begin / do — single body: pass through. Multi: fragment.
|
||||
(or (= name "begin") (= name "do"))
|
||||
(if (= (len expr) 2)
|
||||
@@ -581,7 +615,7 @@
|
||||
;; map — reactive-list when mapping over a signal inside an island
|
||||
(= name "map")
|
||||
(let ((coll-expr (nth expr 2)))
|
||||
(if (and (context "sx-island-scope" nil)
|
||||
(if (and (island-scope?)
|
||||
(= (type-of coll-expr) "list")
|
||||
(> (len coll-expr) 1)
|
||||
(= (type-of (first coll-expr)) "symbol")
|
||||
|
||||
Reference in New Issue
Block a user