giles
c0665ba58e
112 conversions across 19 .sx files using match, let-match, and pipe operators: match (17): type/value dispatch replacing cond/if chains - lib/vm.sx: HO form dispatch (for-each/map/filter/reduce/some/every?) - lib/tree-tools.sx: node-display, node-matches?, rename, count, replace, free-symbols - lib/types.sx: narrow-type, substitute-in-type, infer-type, resolve-type - web/engine.sx: default-trigger, resolve-target, classify-trigger - web/deps.sx: scan-refs-walk, scan-io-refs-walk let-match (89): dict destructuring replacing (get d "key") patterns - shared/page-functions.sx (20), blog/admin.sx (17), pub-api.sx (13) - events/ layouts/page/tickets/entries/forms (27 total) - specs-explorer.sx (7), federation/social.sx (3), lib/ small files (3) -> pipes (6): replacing triple-chained gets in lib/vm.sx - frame-closure → closure-code → code-bytecode chains Also: lib/vm.sx accessor upgrades (get vm "sp" → vm-sp vm throughout) 2650/2650 tests pass, zero regressions. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
328 lines
9.7 KiB
Plaintext
328 lines
9.7 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-match
|
|
{:end e :start s :children-start cs}
|
|
info
|
|
(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))
|