giles
2d7dd7d582
Wraps all core .sx files in R7RS define-library with explicit export lists, plus (import ...) at end for backward-compatible global re-export. Libraries registered: (sx bytecode) — 83 opcode constants (sx render) — 15 tag registries + render helpers (sx signals) — 23 reactive signal primitives (sx r7rs) — 21 R7RS aliases (sx compiler) — 42 compiler functions (sx vm) — 32 VM functions (sx freeze) — 9 freeze/thaw functions (sx content) — 6 content store functions (sx callcc) — 1 call/cc wrapper (sx highlight) — 13 syntax highlighting functions (sx stdlib) — 47 stdlib functions (sx swap) — 13 swap algebra functions (sx render-trace) — 8 render trace functions (sx harness) — 21 test harness functions (sx canonical) — 12 canonical serialization functions (web adapter-html) — 13 HTML renderer functions (web adapter-sx) — 13 SX wire format functions (web engine) — 33 hypermedia engine functions (web request-handler) — 4 request handling functions (web page-helpers) — 12 page helper functions (web router) — 36 routing functions (web deps) — 19 dependency analysis functions (web orchestration) — 59 page orchestration functions Key changes: - define-library now inherits parent env (env-extend env instead of env-extend make-env) so library bodies can access platform primitives - sx_server.ml: added resolve_library_path + load_library_file for import resolution (maps library specs to file paths) - cek_run_with_io: handles "import" locally instead of sending to Python bridge 2608/2608 tests passing. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
326 lines
8.4 KiB
Plaintext
326 lines
8.4 KiB
Plaintext
|
|
|
|
(define-library (sx swap)
|
|
(export
|
|
_skip-string
|
|
_find-close
|
|
_skip-ws
|
|
_skip-token
|
|
_skip-value
|
|
_find-children-start
|
|
_scan-back
|
|
find-element-by-id
|
|
sx-swap
|
|
_extract-attr-value
|
|
find-oob-elements
|
|
strip-oob
|
|
apply-response)
|
|
(begin
|
|
|
|
(define
|
|
_skip-string
|
|
(fn
|
|
(src i)
|
|
(if
|
|
(>= i (len src))
|
|
i
|
|
(let
|
|
((ch (nth src i)))
|
|
(cond
|
|
(= ch "\\")
|
|
(_skip-string src (+ i 2))
|
|
(= ch "\"")
|
|
(+ i 1)
|
|
:else (_skip-string src (+ i 1)))))))
|
|
|
|
(define
|
|
_find-close
|
|
(fn
|
|
(src i depth in-str)
|
|
(if
|
|
(>= i (len src))
|
|
-1
|
|
(let
|
|
((ch (nth src i)))
|
|
(cond
|
|
in-str
|
|
(cond
|
|
(= ch "\\")
|
|
(_find-close src (+ i 2) depth true)
|
|
(= ch "\"")
|
|
(_find-close src (+ i 1) depth false)
|
|
:else (_find-close src (+ i 1) depth true))
|
|
(= ch "\"")
|
|
(_find-close src (+ i 1) depth true)
|
|
(= ch "(")
|
|
(_find-close src (+ i 1) (+ depth 1) false)
|
|
(= ch ")")
|
|
(if (= depth 1) i (_find-close src (+ i 1) (- depth 1) false))
|
|
:else (_find-close src (+ i 1) depth false))))))
|
|
|
|
(define
|
|
_skip-ws
|
|
(fn
|
|
(src i)
|
|
(if
|
|
(>= i (len src))
|
|
i
|
|
(let
|
|
((ch (nth src i)))
|
|
(if
|
|
(or (= ch " ") (= ch "\n") (= ch "\t") (= ch "\r"))
|
|
(_skip-ws src (+ i 1))
|
|
i)))))
|
|
|
|
(define
|
|
_skip-token
|
|
(fn
|
|
(src i)
|
|
(if
|
|
(>= i (len src))
|
|
i
|
|
(let
|
|
((ch (nth src i)))
|
|
(if
|
|
(or
|
|
(= ch " ")
|
|
(= ch "\n")
|
|
(= ch "\t")
|
|
(= ch "\r")
|
|
(= ch "(")
|
|
(= ch ")")
|
|
(= ch "\""))
|
|
i
|
|
(_skip-token src (+ i 1)))))))
|
|
|
|
(define
|
|
_skip-value
|
|
(fn
|
|
(src i)
|
|
(if
|
|
(>= i (len src))
|
|
i
|
|
(let
|
|
((ch (nth src i)))
|
|
(cond
|
|
(= ch "\"")
|
|
(_skip-string src (+ i 1))
|
|
(= ch "(")
|
|
(let
|
|
((close (_find-close src (+ i 1) 1 false)))
|
|
(if (= close -1) (len src) (+ close 1)))
|
|
:else (_skip-token src i))))))
|
|
|
|
(define
|
|
_find-children-start
|
|
(fn
|
|
(src elem-start elem-end)
|
|
(let
|
|
((after-open (+ elem-start 1)))
|
|
(let
|
|
((after-tag (_skip-token src (_skip-ws src after-open))))
|
|
(define
|
|
_skip-attrs
|
|
(fn
|
|
(j)
|
|
(let
|
|
((pos (_skip-ws src j)))
|
|
(if
|
|
(>= pos elem-end)
|
|
pos
|
|
(if
|
|
(= (nth src pos) ":")
|
|
(let
|
|
((after-kw (_skip-token src pos)))
|
|
(_skip-attrs (_skip-value src (_skip-ws src after-kw))))
|
|
pos)))))
|
|
(_skip-attrs after-tag)))))
|
|
|
|
(define
|
|
_scan-back
|
|
(fn
|
|
(src i)
|
|
(if (< i 0) -1 (if (= (nth src i) "(") i (_scan-back src (- i 1))))))
|
|
|
|
(define
|
|
find-element-by-id
|
|
(fn
|
|
(src target-id)
|
|
(let
|
|
((pattern (str ":id \"" target-id "\"")))
|
|
(let
|
|
((pos (index-of src pattern)))
|
|
(if
|
|
(= pos -1)
|
|
nil
|
|
(let
|
|
((elem-start (_scan-back src (- pos 1))))
|
|
(if
|
|
(= elem-start -1)
|
|
nil
|
|
(let
|
|
((elem-end (_find-close src (+ elem-start 1) 1 false)))
|
|
(if
|
|
(= elem-end -1)
|
|
nil
|
|
(let
|
|
((cs (_find-children-start src elem-start elem-end)))
|
|
{:end elem-end :start elem-start :children-start cs}))))))))))
|
|
|
|
(define
|
|
sx-swap
|
|
(fn
|
|
(src mode target-id new-content)
|
|
(let
|
|
((info (find-element-by-id src target-id)))
|
|
(if
|
|
(nil? info)
|
|
src
|
|
(let
|
|
((s (get info "start"))
|
|
(e (get info "end"))
|
|
(cs (get info "children-start")))
|
|
(case
|
|
mode
|
|
"innerHTML"
|
|
(str (slice src 0 cs) new-content (slice src e (len src)))
|
|
"outerHTML"
|
|
(str (slice src 0 s) new-content (slice src (+ e 1) (len src)))
|
|
"beforeend"
|
|
(str (slice src 0 e) " " new-content (slice src e (len src)))
|
|
"afterbegin"
|
|
(str (slice src 0 cs) new-content " " (slice src cs (len src)))
|
|
"beforebegin"
|
|
(str (slice src 0 s) new-content (slice src s (len src)))
|
|
"afterend"
|
|
(str
|
|
(slice src 0 (+ e 1))
|
|
new-content
|
|
(slice src (+ e 1) (len src)))
|
|
"delete"
|
|
(str (slice src 0 s) (slice src (+ e 1) (len src)))
|
|
"none"
|
|
src
|
|
:else src))))))
|
|
|
|
(define
|
|
_extract-attr-value
|
|
(fn
|
|
(src keyword-end)
|
|
(let
|
|
((val-start (_skip-ws src keyword-end)))
|
|
(if
|
|
(= (nth src val-start) "\"")
|
|
(let
|
|
((str-end (_skip-string src (+ val-start 1))))
|
|
(slice src (+ val-start 1) (- str-end 1)))
|
|
(let
|
|
((tok-end (_skip-token src val-start)))
|
|
(slice src val-start tok-end))))))
|
|
|
|
(define
|
|
find-oob-elements
|
|
(fn
|
|
(src)
|
|
(define
|
|
_scan
|
|
(fn
|
|
(from results)
|
|
(let
|
|
((rel-pos (index-of (slice src from (len src)) ":sx-swap-oob")))
|
|
(if
|
|
(= rel-pos -1)
|
|
results
|
|
(let
|
|
((abs-pos (+ from rel-pos)))
|
|
(let
|
|
((mode (_extract-attr-value src (+ abs-pos 12))))
|
|
(let
|
|
((elem-start (_scan-back src (- abs-pos 1))))
|
|
(if
|
|
(= elem-start -1)
|
|
results
|
|
(let
|
|
((elem-end (_find-close src (+ elem-start 1) 1 false)))
|
|
(if
|
|
(= elem-end -1)
|
|
results
|
|
(let
|
|
((id-pattern ":id \""))
|
|
(let
|
|
((id-pos (index-of (slice src elem-start (+ elem-end 1)) id-pattern)))
|
|
(if
|
|
(= id-pos -1)
|
|
(_scan (+ elem-end 1) results)
|
|
(let
|
|
((id-abs (+ elem-start id-pos)))
|
|
(let
|
|
((id-val (_extract-attr-value src (+ id-abs 3))))
|
|
(let
|
|
((cs (_find-children-start src elem-start elem-end)))
|
|
(let
|
|
((children-str (slice src cs elem-end)))
|
|
(_scan
|
|
(+ elem-end 1)
|
|
(append results (list {:end elem-end :mode mode :content children-str :start elem-start :id id-val}))))))))))))))))))))
|
|
(_scan 0 (list))))
|
|
|
|
(define
|
|
strip-oob
|
|
(fn
|
|
(src oob-list)
|
|
(if
|
|
(empty? oob-list)
|
|
src
|
|
(let
|
|
((sorted (reverse oob-list)))
|
|
(define
|
|
_strip
|
|
(fn
|
|
(s items)
|
|
(if
|
|
(empty? items)
|
|
s
|
|
(let
|
|
((item (first items)))
|
|
(let
|
|
((before (slice s 0 (get item "start")))
|
|
(after (slice s (+ (get item "end") 1) (len s))))
|
|
(_strip (str before after) (rest items)))))))
|
|
(_strip src sorted)))))
|
|
|
|
(define
|
|
apply-response
|
|
(fn
|
|
(page response primary-mode primary-target)
|
|
(let
|
|
((oobs (find-oob-elements response)))
|
|
(let
|
|
((main-content (strip-oob response oobs)))
|
|
(let
|
|
((result (sx-swap page primary-mode primary-target main-content)))
|
|
(do
|
|
(define
|
|
_apply-oobs
|
|
(fn
|
|
(page-acc items)
|
|
(if
|
|
(empty? items)
|
|
page-acc
|
|
(let
|
|
((oob (first items)))
|
|
(_apply-oobs
|
|
(sx-swap
|
|
page-acc
|
|
(get oob "mode")
|
|
(get oob "id")
|
|
(get oob "content"))
|
|
(rest items))))))
|
|
(_apply-oobs result oobs)))))))
|
|
|
|
|
|
)) ;; end define-library
|
|
|
|
;; Re-export to global namespace for backward compatibility
|
|
(import (sx swap))
|