Implement sx-swap pure tree rewriting and fix handler test infrastructure
Write lib/sx-swap.sx — string-level SX scanner that finds elements by :id and applies swap operations (innerHTML, outerHTML, beforeend, afterbegin, beforebegin, afterend, delete, none). Includes OOB extraction via find-oob-elements/strip-oob/apply-response for out-of-band targeted swaps. Fix &rest varargs bug in test-handlers.sx helper mock — fn doesn't support &rest, so change to positional (name a1 a2) with nil defaults. Fix into branch, add run-handler sx-expr unwrapping. Add missing primitives to run_tests.ml: scope-peek, callable?, make-sx-expr, sx-expr-source, sx-expr?, spread?, call-lambda. These unblock aser-based handler evaluation in tests. Add algebraic integration tests (test-swap-integration.sx) demonstrating the sx1 ⊕(mode,target) sx2 = sx3 pattern with real handler execution. 1219 → 1330 passing tests (+111). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
300
lib/sx-swap.sx
Normal file
300
lib/sx-swap.sx
Normal file
@@ -0,0 +1,300 @@
|
||||
(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)))))))
|
||||
Reference in New Issue
Block a user