Step 5p6 lazy loading + Step 6b VM transpilation prep
Lazy module loading (Step 5 piece 6 completion): - Add define-library wrappers + import declarations to 13 source .sx files - compile-modules.js generates module-manifest.json with dependency graph - compile-modules.js strips define-library/import before bytecode compilation (VM doesn't handle these as special forms) - sx-platform.js replaces hardcoded 24-file loadWebStack() with manifest-driven recursive loader — only downloads modules the page needs - Result: 12 modules loaded (was 24), zero errors, zero warnings - Fallback to full load if manifest missing VM transpilation prep (Step 6b): - Refactor lib/vm.sx: 20 accessor functions replace raw dict access - Factor out collect-n-from-stack, collect-n-pairs, pad-n-nils helpers - bootstrap_vm.py: transpiles 9 VM logic functions to OCaml - sx_vm_ref.ml: proof that vm.sx transpiles (preamble has stubs) Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1,3 +1,10 @@
|
||||
(import (sx dom))
|
||||
(import (sx render))
|
||||
|
||||
(define-library (web adapter-dom)
|
||||
(export SVG_NS MATH_NS island-scope? contains-deref? dom-on render-to-dom render-dom-list render-dom-element render-dom-component render-dom-fragment render-dom-raw render-dom-unknown-component RENDER_DOM_FORMS render-dom-form? dispatch-render-form render-lambda-dom render-dom-island render-dom-lake render-dom-marsh reactive-text reactive-attr reactive-spread reactive-fragment render-list-item extract-key reactive-list bind-input *use-cek-reactive* enable-cek-reactive! cek-reactive-text cek-reactive-attr render-dom-portal render-dom-error-boundary)
|
||||
(begin
|
||||
|
||||
(define SVG_NS "http://www.w3.org/2000/svg")
|
||||
|
||||
(define MATH_NS "http://www.w3.org/1998/Math/MathML")
|
||||
@@ -1336,3 +1343,9 @@
|
||||
((fallback-dom (if (nil? fallback-fn) (let ((el (dom-create-element "div" nil))) (dom-set-attr el "class" "sx-render-error") (dom-set-attr el "style" "color:red;font-size:0.875rem;padding:0.5rem;border:1px solid red;border-radius:0.25rem;margin:0.5rem 0;") (dom-set-text-content el (str "Render error: " err)) el) (if (lambda? fallback-fn) (render-lambda-dom fallback-fn (list err retry-fn) env ns) (render-to-dom (apply fallback-fn (list err retry-fn)) env ns)))))
|
||||
(dom-append container fallback-dom)))))))
|
||||
container)))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (web adapter-dom))
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
|
||||
|
||||
(import (sx render))
|
||||
|
||||
(define-library (web adapter-html)
|
||||
(export
|
||||
render-to-html
|
||||
|
||||
@@ -1,5 +1,7 @@
|
||||
|
||||
|
||||
(import (web boot-helpers))
|
||||
|
||||
(define-library (web adapter-sx)
|
||||
(export
|
||||
render-to-sx
|
||||
|
||||
13
web/boot.sx
13
web/boot.sx
@@ -1,3 +1,16 @@
|
||||
(import (sx dom))
|
||||
(import (sx bytecode))
|
||||
(import (sx browser))
|
||||
(import (web boot-helpers))
|
||||
(import (web adapter-dom))
|
||||
(import (sx signals))
|
||||
(import (sx signals-web))
|
||||
(import (web router))
|
||||
(import (web page-helpers))
|
||||
(import (web orchestration))
|
||||
|
||||
(import (sx render))
|
||||
|
||||
(define
|
||||
HEAD_HOIST_SELECTOR
|
||||
"meta, title, link[rel='canonical'], script[type='application/ld+json']")
|
||||
|
||||
@@ -1,5 +1,9 @@
|
||||
|
||||
|
||||
(import (web boot-helpers))
|
||||
(import (sx dom))
|
||||
(import (sx browser))
|
||||
|
||||
(define-library (web engine)
|
||||
(export
|
||||
ENGINE_VERBS
|
||||
|
||||
@@ -1,3 +1,7 @@
|
||||
(define-library (sx harness-reactive)
|
||||
(export assert-signal-value assert-signal-has-subscribers assert-signal-no-subscribers assert-signal-subscriber-count simulate-signal-set! simulate-signal-swap! assert-computed-dep-count assert-computed-depends-on count-effect-runs make-test-signal assert-batch-coalesces)
|
||||
(begin
|
||||
|
||||
(define
|
||||
assert-signal-value
|
||||
:effects ()
|
||||
@@ -108,3 +112,9 @@
|
||||
expected-notify-count
|
||||
" notifications, got "
|
||||
notify-count)))))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (sx harness-reactive))
|
||||
|
||||
@@ -1,3 +1,7 @@
|
||||
(define-library (sx harness-web)
|
||||
(export mock-element mock-set-text! mock-append-child! mock-set-attr! mock-get-attr mock-add-listener! simulate-click simulate-input simulate-event assert-text assert-attr assert-class assert-no-class assert-child-count assert-event-fired assert-no-event event-fire-count make-web-harness is-renderable? is-render-leak? assert-renderable render-body-audit assert-render-body-clean mock-render mock-render-fragment assert-single-render-root assert-tag)
|
||||
(begin
|
||||
|
||||
(define
|
||||
mock-element
|
||||
:effects ()
|
||||
@@ -318,3 +322,9 @@
|
||||
(assert
|
||||
(= (get el "tag") expected-tag)
|
||||
(str "Expected <" expected-tag "> but got <" (get el "tag") ">"))))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (sx harness-web))
|
||||
|
||||
@@ -1,3 +1,11 @@
|
||||
(import (sx dom))
|
||||
(import (sx browser))
|
||||
(import (web adapter-dom))
|
||||
|
||||
(define-library (web boot-helpers)
|
||||
(export _sx-bound-prefix mark-processed! is-processed? clear-processed! callable? to-kebab sx-load-components call-expr base-env get-render-env merge-envs sx-render-with-env parse-env-attr store-env-attr resolve-mount-target remove-head-element set-sx-comp-cookie clear-sx-comp-cookie log-parse-error loaded-component-names csrf-token validate-for-request build-request-body abort-previous-target abort-previous track-controller track-controller-target new-abort-controller abort-signal apply-optimistic revert-optimistic dom-has-attr? show-indicator disable-elements clear-loading-state abort-error? promise-catch fetch-request fetch-location fetch-and-restore fetch-preload fetch-streaming dom-parse-html-document dom-body-inner-html create-script-clone cross-origin? browser-scroll-to with-transition event-source-connect event-source-listen bind-boost-link bind-boost-form bind-client-route-click sw-post-message try-parse-json strip-component-scripts extract-response-css sx-render sx-hydrate sx-process-scripts select-from-container children-to-fragment select-html-from-doc register-io-deps resolve-page-data parse-sx-data try-eval-content try-async-eval-content try-rerender-page execute-action bind-preload persist-offline-data retrieve-offline-data)
|
||||
(begin
|
||||
|
||||
(define _sx-bound-prefix "_sxBound")
|
||||
|
||||
(define
|
||||
@@ -764,3 +772,9 @@
|
||||
(define persist-offline-data (fn () nil))
|
||||
|
||||
(define retrieve-offline-data (fn () nil))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (web boot-helpers))
|
||||
|
||||
@@ -1,3 +1,7 @@
|
||||
(define-library (sx browser)
|
||||
(export browser-location-href browser-location-pathname browser-location-origin browser-same-origin? url-pathname browser-push-state browser-replace-state browser-reload browser-navigate local-storage-get local-storage-set local-storage-remove set-timeout set-interval clear-timeout clear-interval request-animation-frame fetch-request new-abort-controller controller-signal controller-abort promise-then promise-resolve promise-delayed browser-confirm browser-prompt browser-media-matches? json-parse log-info log-warn console-log now-ms schedule-idle set-cookie get-cookie)
|
||||
(begin
|
||||
|
||||
(define
|
||||
browser-location-href
|
||||
(fn () (host-get (host-get (dom-window) "location") "href")))
|
||||
@@ -219,3 +223,9 @@
|
||||
"match"
|
||||
(host-new "RegExp" (str "(?:^|;\\s*)" name "=([^;]*)")))))
|
||||
(if match (host-call nil "decodeURIComponent" (host-get match 1)) nil))))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (sx browser))
|
||||
|
||||
@@ -1,3 +1,7 @@
|
||||
(define-library (sx dom)
|
||||
(export dom-document dom-window dom-body dom-head dom-create-element create-text-node create-fragment create-comment dom-append dom-prepend dom-insert-before dom-insert-after dom-remove dom-is-active-element? dom-is-input-element? dom-is-child-of? dom-attr-list dom-remove-child dom-replace-child dom-clone dom-query dom-query-all dom-query-by-id dom-closest dom-matches? dom-get-attr dom-set-attr dom-remove-attr dom-has-attr? dom-add-class dom-remove-class dom-has-class? dom-text-content dom-set-text-content dom-inner-html dom-set-inner-html dom-outer-html dom-insert-adjacent-html dom-get-style dom-set-style dom-get-prop dom-set-prop dom-tag-name dom-node-type dom-node-name dom-id dom-parent dom-first-child dom-next-sibling dom-child-list dom-is-fragment? dom-child-nodes dom-remove-children-after dom-focus dom-parse-html dom-listen dom-add-listener dom-dispatch event-detail prevent-default stop-propagation event-modifier-key? element-value error-message dom-get-data dom-set-data dom-append-to-head set-document-title)
|
||||
(begin
|
||||
|
||||
(define dom-document (fn () (host-global "document")))
|
||||
|
||||
(define dom-window (fn () (host-global "window")))
|
||||
@@ -414,3 +418,9 @@
|
||||
(define
|
||||
set-document-title
|
||||
(fn (title) (host-set! (dom-document) "title" title)))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (sx dom))
|
||||
|
||||
@@ -1,3 +1,7 @@
|
||||
(define-library (sx hypersx)
|
||||
(export hsx-indent hsx-sym-name hsx-kw-name hsx-is-element? hsx-is-component? hsx-extract-css hsx-tag-str hsx-atom hsx-inline hsx-attrs-str hsx-children sx->hypersx-node sx->hypersx)
|
||||
(begin
|
||||
|
||||
(define hsx-indent (fn (depth) (let ((result "")) (for-each (fn (_) (set! result (str result " "))) (range 0 depth)) result)))
|
||||
|
||||
(define hsx-sym-name (fn (node) (if (= (type-of node) "symbol") (symbol-name node) nil)))
|
||||
@@ -23,3 +27,9 @@
|
||||
(define sx->hypersx-node (fn (node depth) (let ((pad (hsx-indent depth))) (cond (nil? node) (str pad "nil") (not (list? node)) (str pad (hsx-atom node)) (empty? node) (str pad "()") :else (let ((hd (hsx-sym-name (first node)))) (cond (= hd "str") (str pad (hsx-inline node)) (= hd "deref") (str pad (hsx-inline node)) (= hd "reset!") (str pad (hsx-inline node)) (= hd "swap!") (str pad (hsx-inline node)) (= hd "signal") (str pad (hsx-inline node)) (or (= hd "defcomp") (= hd "defisland")) (str pad hd " " (sx-serialize (nth node 1)) " " (sx-serialize (nth node 2)) "\n" (sx->hypersx-node (last node) (+ depth 1))) (= hd "when") (str pad "when " (hsx-inline (nth node 1)) "\n" (join "\n" (map (fn (c) (sx->hypersx-node c (+ depth 1))) (slice node 2)))) (= hd "if") (let ((test (nth node 1)) (then-b (nth node 2)) (else-b (if (> (len node) 3) (nth node 3) nil))) (if (and (not (list? then-b)) (or (nil? else-b) (not (list? else-b)))) (str pad "if " (hsx-inline test) " " (hsx-atom then-b) (if else-b (str " " (hsx-atom else-b)) "")) (str pad "if " (hsx-inline test) "\n" (sx->hypersx-node then-b (+ depth 1)) (if else-b (str "\n" pad "else\n" (sx->hypersx-node else-b (+ depth 1))) "")))) (or (= hd "let") (= hd "letrec") (= hd "let*")) (let ((binds (nth node 1)) (body (slice node 2))) (str pad hd " " (join ", " (map (fn (b) (if (and (list? b) (>= (len b) 2)) (str (sx-serialize (first b)) " = " (hsx-inline (nth b 1))) (sx-serialize b))) (if (and (list? binds) (not (empty? binds)) (list? (first binds))) binds (list binds)))) "\n" (join "\n" (map (fn (b) (sx->hypersx-node b (+ depth 1))) body)))) (and (= hd "map") (= (len node) 3) (list? (nth node 1)) (= (hsx-sym-name (first (nth node 1))) "fn")) (let ((fn-node (nth node 1)) (coll (nth node 2))) (str pad "map " (hsx-inline coll) " -> " (sx-serialize (nth fn-node 1)) "\n" (sx->hypersx-node (last fn-node) (+ depth 1)))) (and (= hd "for-each") (= (len node) 3) (list? (nth node 1)) (= (hsx-sym-name (first (nth node 1))) "fn")) (let ((fn-node (nth node 1)) (coll (nth node 2))) (str pad "for " (sx-serialize (nth fn-node 1)) " in " (hsx-inline coll) "\n" (sx->hypersx-node (last fn-node) (+ depth 1)))) (hsx-is-element? hd) (let ((css (hsx-extract-css (rest node)))) (hsx-children (str pad (hsx-tag-str hd css) (hsx-attrs-str (get css "attrs"))) (get css "children") depth)) (hsx-is-component? hd) (let ((css (hsx-extract-css (rest node)))) (hsx-children (str pad hd (hsx-attrs-str (get css "attrs"))) (get css "children") depth)) :else (str pad (sx-serialize node))))))))
|
||||
|
||||
(define sx->hypersx (fn (tree) (join "\n\n" (map (fn (expr) (sx->hypersx-node expr 0)) tree))))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (sx hypersx))
|
||||
|
||||
@@ -1,5 +1,11 @@
|
||||
|
||||
|
||||
(import (web boot-helpers))
|
||||
(import (sx dom))
|
||||
(import (sx browser))
|
||||
(import (web adapter-dom))
|
||||
(import (web engine))
|
||||
|
||||
(define-library (web orchestration)
|
||||
(export
|
||||
_preload-cache
|
||||
|
||||
@@ -1,3 +1,10 @@
|
||||
(import (sx dom))
|
||||
(import (sx browser))
|
||||
|
||||
(define-library (sx signals-web)
|
||||
(export with-marsh-scope dispose-marsh-scope emit-event on-event bridge-event resource)
|
||||
(begin
|
||||
|
||||
;; ==========================================================================
|
||||
;; web/signals.sx — Web platform signal extensions
|
||||
;;
|
||||
@@ -79,3 +86,9 @@
|
||||
(fn (err)
|
||||
(reset! state (dict "loading" false "data" nil "error" err))))
|
||||
state)))
|
||||
|
||||
|
||||
))
|
||||
|
||||
;; Re-export to global env
|
||||
(import (sx signals-web))
|
||||
|
||||
Reference in New Issue
Block a user