Add host FFI primitives and web/lib DOM+browser libraries
Introduce 8 irreducible host FFI primitives that replace 40+ native DOM
and browser primitives:
host-global — access global object (window/document)
host-get — read property from host object
host-set! — write property on host object
host-call — call method on host object
host-new — construct host object
host-callback — wrap SX function as host callback
host-typeof — check host object type
host-await — await host promise
All DOM and browser operations are now expressible as SX library
functions built on these 8 primitives:
web/lib/dom.sx — createElement, querySelector, appendChild,
setAttribute, addEventListener, classList, etc.
web/lib/browser.sx — localStorage, history, fetch, setTimeout,
promises, console, matchMedia, etc.
The existing native implementations remain as fallback — the library
versions shadow them in transpiled code. Incremental migration: callers
don't change, only the implementation moves from out-of-band to in-band.
JS 957+1080, Python 744, OCaml 952 — zero regressions.
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
171
web/lib/browser.sx
Normal file
171
web/lib/browser.sx
Normal file
@@ -0,0 +1,171 @@
|
||||
;; ==========================================================================
|
||||
;; browser.sx — Browser API library functions
|
||||
;;
|
||||
;; Location, history, storage, cookies, timers, fetch — all expressed
|
||||
;; using the host FFI primitives. Library functions, not primitives.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Location & navigation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define browser-location-href
|
||||
(fn ()
|
||||
(host-get (host-get (dom-window) "location") "href")))
|
||||
|
||||
(define browser-location-pathname
|
||||
(fn ()
|
||||
(host-get (host-get (dom-window) "location") "pathname")))
|
||||
|
||||
(define browser-location-origin
|
||||
(fn ()
|
||||
(host-get (host-get (dom-window) "location") "origin")))
|
||||
|
||||
(define browser-same-origin?
|
||||
(fn (url)
|
||||
(starts-with? url (browser-location-origin))))
|
||||
|
||||
(define browser-push-state
|
||||
(fn (state title url)
|
||||
(host-call (host-get (dom-window) "history") "pushState" state title url)))
|
||||
|
||||
(define browser-replace-state
|
||||
(fn (state title url)
|
||||
(host-call (host-get (dom-window) "history") "replaceState" state title url)))
|
||||
|
||||
(define browser-reload
|
||||
(fn ()
|
||||
(host-call (host-get (dom-window) "location") "reload")))
|
||||
|
||||
(define browser-navigate
|
||||
(fn (url)
|
||||
(host-set! (host-get (dom-window) "location") "href" url)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Storage
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define local-storage-get
|
||||
(fn (key)
|
||||
(host-call (host-get (dom-window) "localStorage") "getItem" key)))
|
||||
|
||||
(define local-storage-set
|
||||
(fn (key val)
|
||||
(host-call (host-get (dom-window) "localStorage") "setItem" key val)))
|
||||
|
||||
(define local-storage-remove
|
||||
(fn (key)
|
||||
(host-call (host-get (dom-window) "localStorage") "removeItem" key)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Timers
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define set-timeout
|
||||
(fn (fn-val ms)
|
||||
(host-call (dom-window) "setTimeout" (host-callback fn-val) ms)))
|
||||
|
||||
(define set-interval
|
||||
(fn (fn-val ms)
|
||||
(host-call (dom-window) "setInterval" (host-callback fn-val) ms)))
|
||||
|
||||
(define clear-timeout
|
||||
(fn (id)
|
||||
(host-call (dom-window) "clearTimeout" id)))
|
||||
|
||||
(define clear-interval
|
||||
(fn (id)
|
||||
(host-call (dom-window) "clearInterval" id)))
|
||||
|
||||
(define request-animation-frame
|
||||
(fn (fn-val)
|
||||
(host-call (dom-window) "requestAnimationFrame" (host-callback fn-val))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Fetch
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define fetch-request
|
||||
(fn (url opts)
|
||||
(host-call (dom-window) "fetch" url opts)))
|
||||
|
||||
(define new-abort-controller
|
||||
(fn ()
|
||||
(host-new "AbortController")))
|
||||
|
||||
(define controller-signal
|
||||
(fn (controller)
|
||||
(host-get controller "signal")))
|
||||
|
||||
(define controller-abort
|
||||
(fn (controller)
|
||||
(host-call controller "abort")))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Promises
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define promise-then
|
||||
(fn (p on-resolve on-reject)
|
||||
(let ((cb-resolve (host-callback on-resolve))
|
||||
(cb-reject (if on-reject (host-callback on-reject) nil)))
|
||||
(if cb-reject
|
||||
(host-call (host-call p "then" cb-resolve) "catch" cb-reject)
|
||||
(host-call p "then" cb-resolve)))))
|
||||
|
||||
(define promise-resolve
|
||||
(fn (val)
|
||||
(host-call (host-global "Promise") "resolve" val)))
|
||||
|
||||
(define promise-delayed
|
||||
(fn (ms val)
|
||||
(host-new "Promise" (host-callback
|
||||
(fn (resolve)
|
||||
(set-timeout (fn () (host-call resolve "call" nil val)) ms))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Dialogs & media
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define browser-confirm
|
||||
(fn (msg) (host-call (dom-window) "confirm" msg)))
|
||||
|
||||
(define browser-prompt
|
||||
(fn (msg default)
|
||||
(host-call (dom-window) "prompt" msg default)))
|
||||
|
||||
(define browser-media-matches?
|
||||
(fn (query)
|
||||
(host-get (host-call (dom-window) "matchMedia" query) "matches")))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; JSON
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define json-parse
|
||||
(fn (s)
|
||||
(host-call (host-global "JSON") "parse" s)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Console
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define log-info
|
||||
(fn (msg)
|
||||
(host-call (host-global "console") "log" (str "[sx] " msg))))
|
||||
|
||||
(define log-warn
|
||||
(fn (msg)
|
||||
(host-call (host-global "console") "warn" (str "[sx] " msg))))
|
||||
|
||||
(define now-ms
|
||||
(fn ()
|
||||
(host-call (host-global "Date") "now")))
|
||||
294
web/lib/dom.sx
Normal file
294
web/lib/dom.sx
Normal file
@@ -0,0 +1,294 @@
|
||||
;; ==========================================================================
|
||||
;; dom.sx — DOM library functions
|
||||
;;
|
||||
;; All DOM operations expressed using the host FFI primitives:
|
||||
;; host-get — read property from host object
|
||||
;; host-set! — write property on host object
|
||||
;; host-call — call method on host object
|
||||
;; host-new — construct host object
|
||||
;; host-global — access global (window/document/etc.)
|
||||
;; host-callback — wrap SX function as host callback
|
||||
;; host-typeof — check host object type
|
||||
;;
|
||||
;; These are LIBRARY FUNCTIONS — portable, auditable, in-band SX.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Globals
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-document (fn () (host-global "document")))
|
||||
(define dom-window (fn () (host-global "window")))
|
||||
(define dom-body (fn () (host-get (dom-document) "body")))
|
||||
(define dom-head (fn () (host-get (dom-document) "head")))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Node creation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-create-element
|
||||
(fn (tag)
|
||||
(host-call (dom-document) "createElement" tag)))
|
||||
|
||||
(define create-text-node
|
||||
(fn (s)
|
||||
(host-call (dom-document) "createTextNode" s)))
|
||||
|
||||
(define create-fragment
|
||||
(fn ()
|
||||
(host-call (dom-document) "createDocumentFragment")))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Tree manipulation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-append
|
||||
(fn (parent child)
|
||||
(when (and parent child)
|
||||
(host-call parent "appendChild" child))))
|
||||
|
||||
(define dom-prepend
|
||||
(fn (parent child)
|
||||
(when (and parent child)
|
||||
(host-call parent "prepend" child))))
|
||||
|
||||
(define dom-insert-before
|
||||
(fn (parent child ref)
|
||||
(when (and parent child)
|
||||
(host-call parent "insertBefore" child ref))))
|
||||
|
||||
(define dom-remove-child
|
||||
(fn (parent child)
|
||||
(when (and parent child)
|
||||
(host-call parent "removeChild" child))))
|
||||
|
||||
(define dom-replace-child
|
||||
(fn (parent new-child old-child)
|
||||
(when (and parent new-child old-child)
|
||||
(host-call parent "replaceChild" new-child old-child))))
|
||||
|
||||
(define dom-clone
|
||||
(fn (node deep)
|
||||
(host-call node "cloneNode" (if (nil? deep) true deep))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Queries
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-query
|
||||
(fn (sel)
|
||||
(host-call (dom-document) "querySelector" sel)))
|
||||
|
||||
(define dom-query-all
|
||||
(fn (root sel)
|
||||
(if (nil? sel)
|
||||
;; Single arg: query document
|
||||
(host-call (dom-document) "querySelectorAll" root)
|
||||
;; Two args: query within root
|
||||
(host-call root "querySelectorAll" sel))))
|
||||
|
||||
(define dom-query-by-id
|
||||
(fn (id)
|
||||
(host-call (dom-document) "getElementById" id)))
|
||||
|
||||
(define dom-closest
|
||||
(fn (el sel)
|
||||
(when el (host-call el "closest" sel))))
|
||||
|
||||
(define dom-matches?
|
||||
(fn (el sel)
|
||||
(if (and el (host-get el "matches"))
|
||||
(host-call el "matches" sel)
|
||||
false)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Attributes
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-get-attr
|
||||
(fn (el name)
|
||||
(if (and el (host-get el "getAttribute"))
|
||||
(let ((v (host-call el "getAttribute" name)))
|
||||
(if (nil? v) nil v))
|
||||
nil)))
|
||||
|
||||
(define dom-set-attr
|
||||
(fn (el name val)
|
||||
(when (and el (host-get el "setAttribute"))
|
||||
(host-call el "setAttribute" name val))))
|
||||
|
||||
(define dom-remove-attr
|
||||
(fn (el name)
|
||||
(when (and el (host-get el "removeAttribute"))
|
||||
(host-call el "removeAttribute" name))))
|
||||
|
||||
(define dom-has-attr?
|
||||
(fn (el name)
|
||||
(if (and el (host-get el "hasAttribute"))
|
||||
(host-call el "hasAttribute" name)
|
||||
false)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Classes
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-add-class
|
||||
(fn (el cls)
|
||||
(when el
|
||||
(host-call (host-get el "classList") "add" cls))))
|
||||
|
||||
(define dom-remove-class
|
||||
(fn (el cls)
|
||||
(when el
|
||||
(host-call (host-get el "classList") "remove" cls))))
|
||||
|
||||
(define dom-has-class?
|
||||
(fn (el cls)
|
||||
(if el
|
||||
(host-call (host-get el "classList") "contains" cls)
|
||||
false)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Content
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-text-content
|
||||
(fn (el) (host-get el "textContent")))
|
||||
|
||||
(define dom-set-text-content
|
||||
(fn (el val) (host-set! el "textContent" val)))
|
||||
|
||||
(define dom-inner-html
|
||||
(fn (el) (host-get el "innerHTML")))
|
||||
|
||||
(define dom-set-inner-html
|
||||
(fn (el val) (host-set! el "innerHTML" val)))
|
||||
|
||||
(define dom-outer-html
|
||||
(fn (el) (host-get el "outerHTML")))
|
||||
|
||||
(define dom-insert-adjacent-html
|
||||
(fn (el position html)
|
||||
(host-call el "insertAdjacentHTML" position html)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Style & properties
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-get-style
|
||||
(fn (el prop)
|
||||
(host-get (host-get el "style") prop)))
|
||||
|
||||
(define dom-set-style
|
||||
(fn (el prop val)
|
||||
(host-call (host-get el "style") "setProperty" prop val)))
|
||||
|
||||
(define dom-get-prop
|
||||
(fn (el name) (host-get el name)))
|
||||
|
||||
(define dom-set-prop
|
||||
(fn (el name val) (host-set! el name val)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Node info
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-tag-name
|
||||
(fn (el)
|
||||
(if el (lower (or (host-get el "tagName") "")) "")))
|
||||
|
||||
(define dom-node-type
|
||||
(fn (el) (host-get el "nodeType")))
|
||||
|
||||
(define dom-node-name
|
||||
(fn (el) (host-get el "nodeName")))
|
||||
|
||||
(define dom-id
|
||||
(fn (el) (host-get el "id")))
|
||||
|
||||
(define dom-parent
|
||||
(fn (el) (host-get el "parentNode")))
|
||||
|
||||
(define dom-first-child
|
||||
(fn (el) (host-get el "firstChild")))
|
||||
|
||||
(define dom-next-sibling
|
||||
(fn (el) (host-get el "nextSibling")))
|
||||
|
||||
(define dom-child-list
|
||||
(fn (el)
|
||||
(if el
|
||||
(host-call (host-global "Array") "from" (host-get el "childNodes"))
|
||||
(list))))
|
||||
|
||||
(define dom-is-fragment?
|
||||
(fn (el) (= (host-get el "nodeType") 11)))
|
||||
|
||||
(define dom-focus
|
||||
(fn (el) (when el (host-call el "focus"))))
|
||||
|
||||
(define dom-parse-html
|
||||
(fn (html)
|
||||
(let ((parser (host-new "DOMParser"))
|
||||
(doc (host-call parser "parseFromString" html "text/html")))
|
||||
(host-get (host-get doc "body") "childNodes"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Events
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-listen
|
||||
(fn (el event-name handler)
|
||||
(let ((cb (host-callback handler)))
|
||||
(host-call el "addEventListener" event-name cb)
|
||||
;; Return cleanup function
|
||||
(fn () (host-call el "removeEventListener" event-name cb)))))
|
||||
|
||||
(define dom-dispatch
|
||||
(fn (el event-name detail)
|
||||
(let ((evt (host-new "CustomEvent" event-name
|
||||
(dict "detail" detail "bubbles" true))))
|
||||
(host-call el "dispatchEvent" evt))))
|
||||
|
||||
(define event-detail
|
||||
(fn (evt) (host-get evt "detail")))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; DOM data storage
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-get-data
|
||||
(fn (el key)
|
||||
(let ((store (host-get el "__sx_data")))
|
||||
(if store (host-get store key) nil))))
|
||||
|
||||
(define dom-set-data
|
||||
(fn (el key val)
|
||||
(when (not (host-get el "__sx_data"))
|
||||
(host-set! el "__sx_data" (dict)))
|
||||
(host-set! (host-get el "__sx_data") key val)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Head manipulation
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dom-append-to-head
|
||||
(fn (el)
|
||||
(when (dom-head)
|
||||
(host-call (dom-head) "appendChild" el))))
|
||||
|
||||
(define set-document-title
|
||||
(fn (title)
|
||||
(host-set! (dom-document) "title" title)))
|
||||
Reference in New Issue
Block a user