From 4308591982952fd250ef118cbf7039499603a819 Mon Sep 17 00:00:00 2001 From: giles Date: Mon, 16 Mar 2026 09:22:57 +0000 Subject: [PATCH] Add host FFI primitives and web/lib DOM+browser libraries MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/javascript/platform.py | 86 ++++++++++ hosts/javascript/transpiler.sx | 11 ++ web/lib/browser.sx | 171 +++++++++++++++++++ web/lib/dom.sx | 294 +++++++++++++++++++++++++++++++++ 4 files changed, 562 insertions(+) create mode 100644 web/lib/browser.sx create mode 100644 web/lib/dom.sx diff --git a/hosts/javascript/platform.py b/hosts/javascript/platform.py index 9cb9750..f242aee 100644 --- a/hosts/javascript/platform.py +++ b/hosts/javascript/platform.py @@ -38,6 +38,8 @@ ADAPTER_FILES = { "parser": ("parser.sx", "parser"), "html": ("adapter-html.sx", "adapter-html"), "sx": ("adapter-sx.sx", "adapter-sx"), + "dom-lib": ("lib/dom.sx", "lib/dom (DOM library)"), + "browser-lib": ("lib/browser.sx", "lib/browser (browser API library)"), "dom": ("adapter-dom.sx", "adapter-dom"), "engine": ("engine.sx", "engine"), "orchestration": ("orchestration.sx","orchestration"), @@ -46,6 +48,9 @@ ADAPTER_FILES = { # Dependencies ADAPTER_DEPS = { + "dom-lib": [], + "browser-lib": ["dom-lib"], + "dom": ["dom-lib", "browser-lib"], "engine": ["dom"], "orchestration": ["engine", "dom"], "boot": ["dom", "engine", "orchestration", "parser"], @@ -1435,6 +1440,87 @@ PLATFORM_JS_POST = ''' function isSpecialForm(n) { return false; } function isHoForm(n) { return false; } + // ----------------------------------------------------------------------- + // Host FFI — the irreducible web platform primitives + // All DOM/browser operations are built on these in web/lib/dom.sx + // ----------------------------------------------------------------------- + PRIMITIVES["host-global"] = function(name) { + if (typeof globalThis !== "undefined" && name in globalThis) return globalThis[name]; + if (typeof window !== "undefined" && name in window) return window[name]; + return NIL; + }; + PRIMITIVES["host-get"] = function(obj, prop) { + if (obj == null || obj === NIL) return NIL; + var v = obj[prop]; + return v === undefined || v === null ? NIL : v; + }; + PRIMITIVES["host-set!"] = function(obj, prop, val) { + if (obj != null && obj !== NIL) obj[prop] = val === NIL ? null : val; + }; + PRIMITIVES["host-call"] = function() { + var obj = arguments[0], method = arguments[1]; + var args = []; + for (var i = 2; i < arguments.length; i++) { + var a = arguments[i]; + args.push(a === NIL ? null : a); + } + if (obj == null || obj === NIL) { + // Global function call + var fn = typeof globalThis !== "undefined" ? globalThis[method] : window[method]; + if (typeof fn === "function") return fn.apply(null, args); + return NIL; + } + if (typeof obj[method] === "function") { + try { return obj[method].apply(obj, args); } + catch(e) { return NIL; } + } + return NIL; + }; + PRIMITIVES["host-new"] = function() { + var name = arguments[0]; + var args = Array.prototype.slice.call(arguments, 1).map(function(a) { return a === NIL ? null : a; }); + var Ctor = typeof globalThis !== "undefined" ? globalThis[name] : window[name]; + if (typeof Ctor !== "function") return NIL; + // Support 0-4 args (covers all practical cases) + switch (args.length) { + case 0: return new Ctor(); + case 1: return new Ctor(args[0]); + case 2: return new Ctor(args[0], args[1]); + case 3: return new Ctor(args[0], args[1], args[2]); + default: return new Ctor(args[0], args[1], args[2], args[3]); + } + }; + PRIMITIVES["host-callback"] = function(fn) { + // Wrap SX function/lambda as a native JS callback + if (typeof fn === "function") return fn; + if (fn && fn._type === "lambda") { + return function() { + var a = Array.prototype.slice.call(arguments); + return cekCall(fn, a); + }; + } + return function() {}; + }; + PRIMITIVES["host-typeof"] = function(obj) { + if (obj == null || obj === NIL) return "nil"; + if (obj instanceof Element) return "element"; + if (obj instanceof Text) return "text"; + if (obj instanceof DocumentFragment) return "fragment"; + if (obj instanceof Document) return "document"; + if (obj instanceof Event) return "event"; + if (obj instanceof Promise) return "promise"; + if (obj instanceof AbortController) return "abort-controller"; + return typeof obj; + }; + PRIMITIVES["host-await"] = function(promise, callback) { + if (promise && typeof promise.then === "function") { + var cb = typeof callback === "function" ? callback : + (callback && callback._type === "lambda") ? + function(v) { return cekCall(callback, [v]); } : function() {}; + promise.then(cb); + } + }; + // processBindings and evalCond — now specced in render.sx, bootstrapped above function isDefinitionForm(name) { diff --git a/hosts/javascript/transpiler.sx b/hosts/javascript/transpiler.sx index 3c8764d..90f82c9 100644 --- a/hosts/javascript/transpiler.sx +++ b/hosts/javascript/transpiler.sx @@ -98,6 +98,17 @@ "*render-check*" "_renderCheck" "*render-fn*" "_renderFn" "is-else-clause?" "isElseClause" + "host-global" "hostGlobal" + "host-get" "hostGet" + "host-set!" "hostSet" + "host-call" "hostCall" + "host-new" "hostNew" + "host-callback" "hostCallback" + "host-typeof" "hostTypeof" + "host-await" "hostAwait" + "dom-document" "domDocument" + "dom-window" "domWindow" + "dom-head" "domHead" "*batch-depth*" "_batchDepth" "*batch-queue*" "_batchQueue" "*store-registry*" "_storeRegistry" diff --git a/web/lib/browser.sx b/web/lib/browser.sx new file mode 100644 index 0000000..f2ee4fb --- /dev/null +++ b/web/lib/browser.sx @@ -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"))) diff --git a/web/lib/dom.sx b/web/lib/dom.sx new file mode 100644 index 0000000..427a2f7 --- /dev/null +++ b/web/lib/dom.sx @@ -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)))