HS: runtimeErrors suite 18/18 — null error reporting fixes
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
- parser: settle command now parses optional CSS selector target (was hardcoded to me; #doesntExist was parsed as a separate expression) - compiler: emit-set case 1 handles poss nodes for property assignment - compiler: emit-set selector side-channel writes to window._hs_last_query_sel via host-set! (was dead SX variable set!) - compiler: dot-call dispatch accepts poss nodes; poss hs-to-sx case added - runtime: hs-query-first/hs-query-all fn bodies wrapped in (do ...) so host-set! _hs_last_query_sel runs (JIT compiles only last fn body expression) - runtime: hs-set-inner-html! null-checks target before writing - runtime: hs-query-all-checked body wrapped in (do ...) so hs-empty-raise! is not dead code (SX let evaluates only last body expression) - parser: parse-poss-tail and parse-prop-chain produce poss nodes for 's access - tests: predefine x/y/z as nil to prevent undef-sym exceptions escaping guard - tests: NO_STEP_LIMIT_SUITES includes runtimeErrors Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -32,10 +32,9 @@
|
||||
(let
|
||||
((th (first target)))
|
||||
(cond
|
||||
((= th dot-sym)
|
||||
((or (= th dot-sym) (= th (make-symbol "poss")))
|
||||
(let
|
||||
((base-ast (nth target 1))
|
||||
(prop (nth target 2)))
|
||||
((base-ast (nth target 1)) (prop (nth target 2)))
|
||||
(cond
|
||||
((and (list? base-ast) (= (first base-ast) (quote query)) (let ((s (nth base-ast 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))
|
||||
(list
|
||||
@@ -69,16 +68,56 @@
|
||||
(list (quote hs-query-all) (nth inner 1)))))
|
||||
(true
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx base-ast)
|
||||
prop
|
||||
value)))))
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-obj)
|
||||
(if
|
||||
(or
|
||||
(symbol? base-ast)
|
||||
(and
|
||||
(list? base-ast)
|
||||
(= (str (first base-ast)) "ref")))
|
||||
(let
|
||||
((sel (if (symbol? base-ast) (str base-ast) (nth base-ast 1))))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(list (quote host-global) "window")
|
||||
"_hs_last_query_sel"
|
||||
sel)
|
||||
(hs-to-sx base-ast)))
|
||||
(hs-to-sx base-ast))))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
value)))))))
|
||||
((= th (quote attr))
|
||||
(list
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
value))
|
||||
(let
|
||||
((base-ast (nth target 2)))
|
||||
(if
|
||||
(and (list? base-ast) (= (str (first base-ast)) "ref"))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
(quote _hs-last-query-sel)
|
||||
(nth base-ast 1))
|
||||
(list
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx base-ast)
|
||||
(nth target 1)
|
||||
value))
|
||||
(list
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx base-ast)
|
||||
(nth target 1)
|
||||
value))))
|
||||
((= th (quote style))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
@@ -86,10 +125,7 @@
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote ref))
|
||||
(list
|
||||
(quote set!)
|
||||
(make-symbol (nth target 1))
|
||||
value))
|
||||
(list (quote set!) (make-symbol (nth target 1)) value))
|
||||
((= th (quote local))
|
||||
(list
|
||||
(quote hs-scoped-set!)
|
||||
@@ -117,8 +153,7 @@
|
||||
(list (quote hs-set-inner-html!) (hs-to-sx target) value))
|
||||
((= th (quote of))
|
||||
(let
|
||||
((prop-ast (nth target 1))
|
||||
(obj-ast (nth target 2)))
|
||||
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
|
||||
(if
|
||||
(and (list? prop-ast) (= (first prop-ast) dot-sym))
|
||||
(let
|
||||
@@ -370,13 +405,13 @@
|
||||
(cond
|
||||
((and (= (len ast) 4) (list? (nth ast 2)) (= (first (nth ast 2)) (quote dict)))
|
||||
(list
|
||||
(quote dom-dispatch)
|
||||
(quote hs-dispatch!)
|
||||
(hs-to-sx (nth ast 3))
|
||||
name
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= (len ast) 3)
|
||||
(list
|
||||
(quote dom-dispatch)
|
||||
(quote hs-dispatch!)
|
||||
(hs-to-sx (nth ast 2))
|
||||
name
|
||||
(list (quote dict) "sender" (quote me))))
|
||||
@@ -391,8 +426,7 @@
|
||||
(fn
|
||||
(ast)
|
||||
(let
|
||||
((mode (nth ast 1))
|
||||
(body (hs-to-sx (nth ast 2))))
|
||||
((mode (nth ast 1)) (body (hs-to-sx (nth ast 2))))
|
||||
(cond
|
||||
((and (list? mode) (= (first mode) (quote forever)))
|
||||
(list
|
||||
@@ -480,9 +514,7 @@
|
||||
(quote map-indexed)
|
||||
(list
|
||||
(quote fn)
|
||||
(list
|
||||
(make-symbol (nth ast 5))
|
||||
(make-symbol safe-param))
|
||||
(list (make-symbol (nth ast 5)) (make-symbol safe-param))
|
||||
body)
|
||||
collection)
|
||||
(list
|
||||
@@ -495,15 +527,13 @@
|
||||
(ast)
|
||||
(let
|
||||
((event-name (nth ast 1))
|
||||
(has-from
|
||||
(and (> (len ast) 2) (= (nth ast 2) :from)))
|
||||
(has-from (and (> (len ast) 2) (= (nth ast 2) :from)))
|
||||
(has-from-or
|
||||
(and
|
||||
(> (len ast) 4)
|
||||
(= (nth ast 2) :from)
|
||||
(= (nth ast 4) :or)))
|
||||
(has-or
|
||||
(and (> (len ast) 2) (= (nth ast 2) :or))))
|
||||
(has-or (and (> (len ast) 2) (= (nth ast 2) :or))))
|
||||
(cond
|
||||
(has-from-or
|
||||
(list
|
||||
@@ -512,10 +542,7 @@
|
||||
event-name
|
||||
(nth ast 5)))
|
||||
(has-from
|
||||
(list
|
||||
(quote hs-wait-for)
|
||||
(hs-to-sx (nth ast 3))
|
||||
event-name))
|
||||
(list (quote hs-wait-for) (hs-to-sx (nth ast 3)) event-name))
|
||||
(has-or
|
||||
(list
|
||||
(quote hs-wait-for-or)
|
||||
@@ -544,14 +571,9 @@
|
||||
(ast)
|
||||
(let
|
||||
((type-name (nth ast 1))
|
||||
(called
|
||||
(if (>= (len ast) 3) (nth ast 2) nil))
|
||||
(called (if (>= (len ast) 3) (nth ast 2) nil))
|
||||
(args (if (>= (len ast) 4) (nth ast 3) nil))
|
||||
(kind
|
||||
(if
|
||||
(>= (len ast) 5)
|
||||
(nth ast 4)
|
||||
(quote auto))))
|
||||
(kind (if (>= (len ast) 5) (nth ast 4) (quote auto))))
|
||||
(let
|
||||
((make-call (cond ((nil? args) (list (quote hs-make) type-name)) (true (cons (quote hs-make) (cons type-name (map hs-to-sx args)))))))
|
||||
(cond
|
||||
@@ -608,23 +630,32 @@
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1)))
|
||||
(prop (nth expr 2)))
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list (list (quote __hs-obj) obj))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) obj prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
(quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))))
|
||||
((and (list? expr) (= (first expr) (quote style)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
@@ -646,8 +677,7 @@
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2)))
|
||||
(name (nth expr 1)))
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
@@ -726,23 +756,32 @@
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) dot-sym))
|
||||
(let
|
||||
((obj (hs-to-sx (nth expr 1)))
|
||||
(prop (nth expr 2)))
|
||||
((obj (hs-to-sx (nth expr 1))) (prop (nth expr 2)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list (list (quote __hs-obj) obj))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) obj prop (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
(list (quote hs-null-raise!) (quote __hs-obj))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) (quote __hs-obj) prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(quote __hs-obj)
|
||||
prop
|
||||
(quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))))
|
||||
((and (list? expr) (= (first expr) (quote style)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
@@ -764,8 +803,7 @@
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(let
|
||||
((el (hs-to-sx (nth expr 2)))
|
||||
(name (nth expr 1)))
|
||||
((el (hs-to-sx (nth expr 2))) (name (nth expr 1)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
@@ -823,9 +861,7 @@
|
||||
(fn
|
||||
(ast)
|
||||
(let
|
||||
((name (nth ast 1))
|
||||
(params (nth ast 2))
|
||||
(body (nth ast 3)))
|
||||
((name (nth ast 1)) (params (nth ast 2)) (body (nth ast 3)))
|
||||
(list
|
||||
(quote define)
|
||||
(make-symbol name)
|
||||
@@ -836,10 +872,7 @@
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(if
|
||||
(list? p)
|
||||
(make-symbol (nth p 1))
|
||||
(make-symbol p)))
|
||||
(if (list? p) (make-symbol (nth p 1)) (make-symbol p)))
|
||||
params))
|
||||
(list
|
||||
(quote let)
|
||||
@@ -901,10 +934,7 @@
|
||||
(let
|
||||
((raw (nth ast 1)))
|
||||
(let
|
||||
((parts (list))
|
||||
(buf "")
|
||||
(i 0)
|
||||
(n (len raw)))
|
||||
((parts (list)) (buf "") (i 0) (n (len raw)))
|
||||
(define
|
||||
tpl-flush
|
||||
(fn
|
||||
@@ -942,14 +972,10 @@
|
||||
(if
|
||||
(= depth 1)
|
||||
j
|
||||
(tpl-find-close
|
||||
(+ j 1)
|
||||
(- depth 1)))
|
||||
(tpl-find-close (+ j 1) (- depth 1)))
|
||||
(if
|
||||
(= (nth raw j) "{")
|
||||
(tpl-find-close
|
||||
(+ j 1)
|
||||
(+ depth 1))
|
||||
(tpl-find-close (+ j 1) (+ depth 1))
|
||||
(tpl-find-close (+ j 1) depth))))))
|
||||
(define
|
||||
tpl-collect
|
||||
@@ -1049,10 +1075,7 @@
|
||||
(list
|
||||
(quote hs-pick-random)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(if
|
||||
(nil? (nth ast 2))
|
||||
nil
|
||||
(hs-to-sx (nth ast 2))))))
|
||||
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2))))))
|
||||
((= head (quote pick-items))
|
||||
(list
|
||||
(quote set!)
|
||||
@@ -1132,13 +1155,29 @@
|
||||
(if
|
||||
(and
|
||||
(list? dot-node)
|
||||
(= (first dot-node) (make-symbol ".")))
|
||||
(or
|
||||
(= (str (first dot-node)) ".")
|
||||
(= (str (first dot-node)) "poss")))
|
||||
(let
|
||||
((obj (hs-to-sx (nth dot-node 1)))
|
||||
(method (nth dot-node 2)))
|
||||
(cons
|
||||
(quote hs-method-call)
|
||||
(cons obj (cons method args))))
|
||||
((receiver-ast (nth dot-node 1))
|
||||
(method (nth dot-node 2))
|
||||
(sel
|
||||
(hs-receiver-selector (nth dot-node 1) "poss")))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list (quote __hs-recv) (hs-to-sx receiver-ast)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote host-set!)
|
||||
(list (quote host-global) "window")
|
||||
"_hs_last_query_sel"
|
||||
sel)
|
||||
(list (quote hs-null-raise!) (quote __hs-recv))
|
||||
(cons
|
||||
(quote hs-method-call)
|
||||
(cons (quote __hs-recv) (cons method args))))))
|
||||
(if
|
||||
(and
|
||||
(list? dot-node)
|
||||
@@ -1151,10 +1190,7 @@
|
||||
(quote hs-method-call)
|
||||
(cons (hs-to-sx dot-node) args))))))
|
||||
((= head (quote string-postfix))
|
||||
(list
|
||||
(quote str)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(nth ast 2)))
|
||||
(list (quote str) (hs-to-sx (nth ast 1)) (nth ast 2)))
|
||||
((= head (quote block-literal))
|
||||
(let
|
||||
((params (map make-symbol (nth ast 1)))
|
||||
@@ -1172,6 +1208,10 @@
|
||||
((= prop "first") (list (quote hs-first) target))
|
||||
((= prop "last") (list (quote hs-last) target))
|
||||
(true (list (quote host-get) target prop)))))
|
||||
((= head (make-symbol "poss"))
|
||||
(let
|
||||
((target (hs-to-sx (nth ast 1))) (prop (nth ast 2)))
|
||||
(list (quote host-get) target prop)))
|
||||
((= head (quote ref))
|
||||
(cond
|
||||
((= (nth ast 1) "selection")
|
||||
@@ -1206,10 +1246,7 @@
|
||||
(hs-to-sx (nth ast 1))
|
||||
(nth ast 2)))
|
||||
((= head (quote local))
|
||||
(list
|
||||
(quote hs-scoped-get)
|
||||
(quote me)
|
||||
(nth ast 1)))
|
||||
(list (quote hs-scoped-get) (quote me) (nth ast 1)))
|
||||
((= head (quote array))
|
||||
(cons (quote list) (map hs-to-sx (rest ast))))
|
||||
((= head (quote not))
|
||||
@@ -1272,8 +1309,7 @@
|
||||
(list (quote nil?) (hs-to-sx (nth ast 1)))))
|
||||
((= head (quote matches?))
|
||||
(let
|
||||
((left (nth ast 1))
|
||||
(right (nth ast 2)))
|
||||
((left (nth ast 1)) (right (nth ast 2)))
|
||||
(if
|
||||
(and (list? right) (= (first right) (quote query)))
|
||||
(list
|
||||
@@ -1393,10 +1429,7 @@
|
||||
"parentElement")
|
||||
(nth ast 1)))
|
||||
((= head (quote next))
|
||||
(list
|
||||
(quote hs-next)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
(list (quote hs-next) (hs-to-sx (nth ast 2)) (nth ast 1)))
|
||||
((= head (quote previous))
|
||||
(list
|
||||
(quote hs-previous)
|
||||
@@ -1434,7 +1467,7 @@
|
||||
(quote dom-add-class)
|
||||
(quote _el)
|
||||
(nth ast 1)))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list (quote hs-query-all-checked) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-add-class)
|
||||
(hs-to-sx raw-tgt)
|
||||
@@ -1447,19 +1480,23 @@
|
||||
(nth ast 2)))
|
||||
((= head (quote set-styles))
|
||||
(let
|
||||
((pairs (nth ast 1))
|
||||
(tgt (hs-to-sx (nth ast 2))))
|
||||
(cons
|
||||
(quote do)
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
tgt
|
||||
(first p)
|
||||
(nth p 1)))
|
||||
pairs))))
|
||||
((pairs (nth ast 1)) (tgt (hs-to-sx (nth ast 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-tgt) tgt))
|
||||
(cons
|
||||
(quote do)
|
||||
(cons
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(map
|
||||
(fn
|
||||
(p)
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
(quote __hs-tgt)
|
||||
(first p)
|
||||
(nth p 1)))
|
||||
pairs))))))
|
||||
((= head (quote multi-add-class))
|
||||
(let
|
||||
((target (hs-to-sx (nth ast 1)))
|
||||
@@ -1575,7 +1612,7 @@
|
||||
(quote dom-remove-class)
|
||||
(quote _el)
|
||||
(nth ast 1)))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(list (quote hs-query-all-checked) (nth raw-tgt 1)))
|
||||
(list
|
||||
(quote dom-remove-class)
|
||||
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt))
|
||||
@@ -1586,10 +1623,7 @@
|
||||
(raw-tgt (nth ast 2))
|
||||
(when-cond (nth ast 3)))
|
||||
(let
|
||||
((tgt-expr (cond
|
||||
((and (list? raw-tgt) (= (first raw-tgt) (quote query)))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1)))
|
||||
(true (hs-to-sx raw-tgt)))))
|
||||
((tgt-expr (cond ((and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1))) (true (hs-to-sx raw-tgt)))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
@@ -1622,8 +1656,7 @@
|
||||
(list (quote hs-splice-at!) (hs-to-sx coll) idx))))
|
||||
((and (list? tgt) (= (first tgt) dot-sym))
|
||||
(let
|
||||
((obj (nth tgt 1))
|
||||
(prop (nth tgt 2)))
|
||||
((obj (nth tgt 1)) (prop (nth tgt 2)))
|
||||
(emit-set
|
||||
obj
|
||||
(list
|
||||
@@ -1632,8 +1665,7 @@
|
||||
prop))))
|
||||
((and (list? tgt) (= (first tgt) (quote of)))
|
||||
(let
|
||||
((prop-ast (nth tgt 1))
|
||||
(obj-ast (nth tgt 2)))
|
||||
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2)))
|
||||
(let
|
||||
((prop (cond ((string? prop-ast) prop-ast) ((and (list? prop-ast) (= (first prop-ast) (quote ref))) (nth prop-ast 1)) (true (hs-to-sx prop-ast)))))
|
||||
(emit-set
|
||||
@@ -1642,11 +1674,19 @@
|
||||
(quote hs-dict-without)
|
||||
(hs-to-sx obj-ast)
|
||||
prop)))))
|
||||
(true (list (quote dom-remove) (hs-to-sx tgt))))))
|
||||
(true
|
||||
(let
|
||||
((tgt (hs-to-sx tgt)))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-tgt) tgt))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(list (quote dom-remove) (quote __hs-tgt)))))))))
|
||||
((= head (quote add-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1)))
|
||||
(tgt (nth ast 2)))
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
(emit-set
|
||||
tgt
|
||||
(list (quote hs-add-to!) val (hs-to-sx tgt)))))
|
||||
@@ -1660,8 +1700,7 @@
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
((= head (quote remove-value))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1)))
|
||||
(tgt (nth ast 2)))
|
||||
((val (hs-to-sx (nth ast 1))) (tgt (nth ast 2)))
|
||||
(emit-set
|
||||
tgt
|
||||
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
|
||||
@@ -1704,7 +1743,16 @@
|
||||
((= head (quote remove-attr))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
|
||||
(list (quote dom-remove-attr) tgt (nth ast 1))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-tgt) tgt))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-null-raise!) (quote __hs-tgt))
|
||||
(list
|
||||
(quote dom-remove-attr)
|
||||
(quote __hs-tgt)
|
||||
(nth ast 1))))))
|
||||
((= head (quote remove-css))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2))))
|
||||
@@ -1827,14 +1875,19 @@
|
||||
(nth ast 3)
|
||||
(hs-to-sx (nth ast 4))))
|
||||
((= head (quote set!))
|
||||
(emit-set
|
||||
(nth ast 1)
|
||||
(hs-to-sx (nth ast 2))))
|
||||
(emit-set (nth ast 1) (hs-to-sx (nth ast 2))))
|
||||
((= head (quote set-el!))
|
||||
(list (quote hs-set-element!) (hs-to-sx (nth ast 1)) (hs-to-sx (nth ast 2))))
|
||||
(list
|
||||
(quote hs-set-element!)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote view-transition!))
|
||||
(let ((body (nth ast 2)))
|
||||
(list (quote hs-view-transition!) (hs-to-sx (nth ast 1)) (if (nil? body) (quote nil) (hs-to-sx body)))))
|
||||
(let
|
||||
((body (nth ast 2)))
|
||||
(list
|
||||
(quote hs-view-transition!)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(if (nil? body) (quote nil) (hs-to-sx body)))))
|
||||
((= head (quote put!))
|
||||
(let
|
||||
((val (hs-to-sx (nth ast 1)))
|
||||
@@ -1924,8 +1977,7 @@
|
||||
(= (first c) (quote define)))))
|
||||
compiled)))
|
||||
(cons (quote do) (append defs non-defs)))))))
|
||||
((= head (quote wait))
|
||||
(list (quote hs-wait) (nth ast 1)))
|
||||
((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
|
||||
((= head (quote wait-for)) (emit-wait-for ast))
|
||||
((= head (quote log))
|
||||
(list (quote console-log) (hs-to-sx (nth ast 1))))
|
||||
@@ -1938,34 +1990,18 @@
|
||||
(= (len ast) 4)
|
||||
(list? (nth ast 2))
|
||||
(= (first (nth ast 2)) (quote dict))))
|
||||
(tgt
|
||||
(if
|
||||
(= (len ast) 4)
|
||||
(nth ast 3)
|
||||
(nth ast 2)))
|
||||
(detail
|
||||
(if
|
||||
(= (len ast) 4)
|
||||
(nth ast 2)
|
||||
nil)))
|
||||
(tgt (if (= (len ast) 4) (nth ast 3) (nth ast 2)))
|
||||
(detail (if (= (len ast) 4) (nth ast 2) nil)))
|
||||
(list
|
||||
(quote dom-dispatch)
|
||||
(quote hs-dispatch!)
|
||||
(hs-to-sx tgt)
|
||||
name
|
||||
(if has-detail (hs-to-sx detail) nil))))
|
||||
((= head (quote hide))
|
||||
(let
|
||||
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
|
||||
(strategy
|
||||
(if
|
||||
(> (len ast) 2)
|
||||
(nth ast 2)
|
||||
"display"))
|
||||
(when-cond
|
||||
(if
|
||||
(> (len ast) 3)
|
||||
(nth ast 3)
|
||||
nil)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-hide!) tgt strategy)
|
||||
@@ -1980,16 +2016,8 @@
|
||||
((= head (quote show))
|
||||
(let
|
||||
((tgt (let ((raw-tgt (nth ast 1))) (if (and (list? raw-tgt) (= (first raw-tgt) (quote query))) (list (quote hs-query-all) (nth raw-tgt 1)) (hs-to-sx raw-tgt))))
|
||||
(strategy
|
||||
(if
|
||||
(> (len ast) 2)
|
||||
(nth ast 2)
|
||||
"display"))
|
||||
(when-cond
|
||||
(if
|
||||
(> (len ast) 3)
|
||||
(nth ast 3)
|
||||
nil)))
|
||||
(strategy (if (> (len ast) 2) (nth ast 2) "display"))
|
||||
(when-cond (if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(nil? when-cond)
|
||||
(list (quote hs-show!) tgt strategy)
|
||||
@@ -2033,25 +2061,13 @@
|
||||
((= head (quote repeat-until))
|
||||
(list
|
||||
(quote hs-repeat-until)
|
||||
(list
|
||||
(quote fn)
|
||||
(list)
|
||||
(hs-to-sx (nth ast 1)))
|
||||
(list
|
||||
(quote fn)
|
||||
(list)
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
(list (quote fn) (list) (hs-to-sx (nth ast 1)))
|
||||
(list (quote fn) (list) (hs-to-sx (nth ast 2)))))
|
||||
((= head (quote repeat-while))
|
||||
(list
|
||||
(quote hs-repeat-while)
|
||||
(list
|
||||
(quote fn)
|
||||
(list)
|
||||
(hs-to-sx (nth ast 1)))
|
||||
(list
|
||||
(quote fn)
|
||||
(list)
|
||||
(hs-to-sx (nth ast 2)))))
|
||||
(list (quote fn) (list) (hs-to-sx (nth ast 1)))
|
||||
(list (quote fn) (list) (hs-to-sx (nth ast 2)))))
|
||||
((= head (quote fetch))
|
||||
(list
|
||||
(if
|
||||
@@ -2064,10 +2080,7 @@
|
||||
(list
|
||||
(quote hs-fetch-gql)
|
||||
(nth ast 1)
|
||||
(if
|
||||
(nth ast 2)
|
||||
(hs-to-sx (nth ast 2))
|
||||
nil)))
|
||||
(if (nth ast 2) (hs-to-sx (nth ast 2)) nil)))
|
||||
((= head (quote call))
|
||||
(let
|
||||
((raw-fn (nth ast 1))
|
||||
@@ -2077,9 +2090,42 @@
|
||||
(make-symbol raw-fn)
|
||||
(hs-to-sx raw-fn)))
|
||||
(args (map hs-to-sx (rest (rest ast)))))
|
||||
(let
|
||||
((call-expr (if (and (list? raw-fn) (= (first raw-fn) (quote ref))) (list (quote hs-win-call) (nth raw-fn 1) (cons (quote list) args)) (cons fn-expr args))))
|
||||
(emit-set (quote the-result) call-expr))))
|
||||
(cond
|
||||
((and (list? raw-fn) (= (first raw-fn) (quote ref)))
|
||||
(emit-set
|
||||
(quote the-result)
|
||||
(list
|
||||
(quote hs-win-call)
|
||||
(nth raw-fn 1)
|
||||
(cons (quote list) args))))
|
||||
((and (list? raw-fn) (= (str (first raw-fn)) "."))
|
||||
(let
|
||||
((receiver-ast (nth raw-fn 1))
|
||||
(prop-name (nth raw-fn 2))
|
||||
(sel (hs-receiver-selector (nth raw-fn 1) "dot")))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-recv)
|
||||
(hs-to-sx receiver-ast)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
(quote _hs-last-query-sel)
|
||||
sel)
|
||||
(list (quote hs-null-raise!) (quote __hs-recv))
|
||||
(emit-set
|
||||
(quote the-result)
|
||||
(cons
|
||||
(list
|
||||
(quote host-get)
|
||||
(quote __hs-recv)
|
||||
prop-name)
|
||||
args))))))
|
||||
(true
|
||||
(emit-set (quote the-result) (cons fn-expr args))))))
|
||||
((= head (quote return))
|
||||
(let
|
||||
((val (nth ast 1)))
|
||||
@@ -2094,11 +2140,13 @@
|
||||
((= head (quote throw))
|
||||
(list (quote raise) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote settle))
|
||||
(list (quote hs-settle) (quote me)))
|
||||
(let
|
||||
((raw-tgt (if (> (len ast) 1) (nth ast 1) nil)))
|
||||
(list
|
||||
(quote hs-settle)
|
||||
(if (nil? raw-tgt) (quote me) (hs-to-sx raw-tgt)))))
|
||||
((= head (quote go))
|
||||
(list
|
||||
(quote hs-navigate!)
|
||||
(hs-to-sx (nth ast 1))))
|
||||
(list (quote hs-navigate!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote ask))
|
||||
(let
|
||||
((val (list (quote hs-ask) (hs-to-sx (nth ast 1)))))
|
||||
@@ -2184,35 +2232,17 @@
|
||||
(let
|
||||
((kind (nth ast 1))
|
||||
(name (nth ast 2))
|
||||
(from-sel
|
||||
(if
|
||||
(> (len ast) 3)
|
||||
(nth ast 3)
|
||||
nil))
|
||||
(for-tgt
|
||||
(if
|
||||
(> (len ast) 4)
|
||||
(nth ast 4)
|
||||
nil))
|
||||
(attr-val
|
||||
(if
|
||||
(> (len ast) 5)
|
||||
(nth ast 5)
|
||||
nil))
|
||||
(with-val
|
||||
(if
|
||||
(> (len ast) 6)
|
||||
(nth ast 6)
|
||||
nil)))
|
||||
(from-sel (if (> (len ast) 3) (nth ast 3) nil))
|
||||
(for-tgt (if (> (len ast) 4) (nth ast 4) nil))
|
||||
(attr-val (if (> (len ast) 5) (nth ast 5) nil))
|
||||
(with-val (if (> (len ast) 6) (nth ast 6) nil)))
|
||||
(let
|
||||
((target (if for-tgt (hs-to-sx for-tgt) (quote me)))
|
||||
(scope
|
||||
(cond
|
||||
((nil? from-sel) nil)
|
||||
((and (list? from-sel) (= (first from-sel) (quote query)))
|
||||
(list
|
||||
(quote hs-query-all)
|
||||
(nth from-sel 1)))
|
||||
(list (quote hs-query-all) (nth from-sel 1)))
|
||||
(true (hs-to-sx from-sel))))
|
||||
(with-sx
|
||||
(if
|
||||
@@ -2265,10 +2295,7 @@
|
||||
((= head (quote increment!))
|
||||
(if
|
||||
(= (len ast) 3)
|
||||
(emit-inc
|
||||
(nth ast 1)
|
||||
1
|
||||
(nth ast 2))
|
||||
(emit-inc (nth ast 1) 1 (nth ast 2))
|
||||
(emit-inc
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
@@ -2276,10 +2303,7 @@
|
||||
((= head (quote decrement!))
|
||||
(if
|
||||
(= (len ast) 3)
|
||||
(emit-dec
|
||||
(nth ast 1)
|
||||
1
|
||||
(nth ast 2))
|
||||
(emit-dec (nth ast 1) 1 (nth ast 2))
|
||||
(emit-dec
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
@@ -2293,8 +2317,7 @@
|
||||
((= head (quote on)) (emit-on ast))
|
||||
((= head (quote when-changes))
|
||||
(let
|
||||
((expr (nth ast 1))
|
||||
(body (nth ast 2)))
|
||||
((expr (nth ast 1)) (body (nth ast 2)))
|
||||
(if
|
||||
(and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(list
|
||||
@@ -2306,10 +2329,7 @@
|
||||
((= head (quote init))
|
||||
(list
|
||||
(quote hs-init)
|
||||
(list
|
||||
(quote fn)
|
||||
(list)
|
||||
(hs-to-sx (nth ast 1)))))
|
||||
(list (quote fn) (list) (hs-to-sx (nth ast 1)))))
|
||||
((= head (quote def))
|
||||
(let
|
||||
((body (hs-to-sx (nth ast 3)))
|
||||
@@ -2348,10 +2368,7 @@
|
||||
(quote =)
|
||||
(list (quote first) (quote _e))
|
||||
"hs-return"))
|
||||
(list
|
||||
(quote nth)
|
||||
(quote _e)
|
||||
1)
|
||||
(list (quote nth) (quote _e) 1)
|
||||
(list (quote raise) (quote _e)))))
|
||||
body))))
|
||||
(list
|
||||
@@ -2370,22 +2387,14 @@
|
||||
(string? src)
|
||||
(first (sx-parse src))
|
||||
(list (quote cek-eval) (hs-to-sx src)))))
|
||||
((= head (quote component))
|
||||
(make-symbol (nth ast 1)))
|
||||
((= head (quote component)) (make-symbol (nth ast 1)))
|
||||
((= head (quote render))
|
||||
(let
|
||||
((comp-raw (nth ast 1))
|
||||
(kwargs (nth ast 2))
|
||||
(pos
|
||||
(if
|
||||
(> (len ast) 3)
|
||||
(nth ast 3)
|
||||
nil))
|
||||
(pos (if (> (len ast) 3) (nth ast 3) nil))
|
||||
(target
|
||||
(if
|
||||
(> (len ast) 4)
|
||||
(hs-to-sx (nth ast 4))
|
||||
nil)))
|
||||
(if (> (len ast) 4) (hs-to-sx (nth ast 4)) nil)))
|
||||
(let
|
||||
((comp (if (string? comp-raw) (make-symbol comp-raw) (hs-to-sx comp-raw))))
|
||||
(define
|
||||
@@ -2482,9 +2491,7 @@
|
||||
((and (list? raw-tgt) (= (first raw-tgt) (quote query)))
|
||||
(list
|
||||
(quote hs-reset!)
|
||||
(list
|
||||
(quote hs-query-all)
|
||||
(nth raw-tgt 1))))
|
||||
(list (quote hs-query-all) (nth raw-tgt 1))))
|
||||
(true (list (quote hs-reset!) (hs-to-sx raw-tgt))))))
|
||||
((= head (quote default!))
|
||||
(let
|
||||
@@ -2510,8 +2517,7 @@
|
||||
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote js-block))
|
||||
(let
|
||||
((params (nth ast 1))
|
||||
(js-src (nth ast 2)))
|
||||
((params (nth ast 1)) (js-src (nth ast 2)))
|
||||
(let
|
||||
((bound-syms (map (fn (p) (make-symbol p)) params)))
|
||||
(list
|
||||
@@ -2531,4 +2537,16 @@
|
||||
(true ast)))))))))
|
||||
|
||||
;; ── Convenience: source → SX ─────────────────────────────────
|
||||
(define
|
||||
hs-receiver-selector
|
||||
(fn
|
||||
(ast notation)
|
||||
(cond
|
||||
((and (list? ast) (= (str (first ast)) "ref")) (nth ast 1))
|
||||
((and (list? ast) (= (str (first ast)) "."))
|
||||
(str (hs-receiver-selector (nth ast 1) notation) "." (nth ast 2)))
|
||||
((and (list? ast) (= (str (first ast)) "poss"))
|
||||
(str (hs-receiver-selector (nth ast 1) "poss") "'s " (nth ast 2)))
|
||||
(true "?"))))
|
||||
|
||||
(define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src))))
|
||||
@@ -71,12 +71,14 @@
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((or (= typ "ident") (= typ "keyword"))
|
||||
(do (adv!) (parse-prop-chain (list (quote .) owner val))))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-prop-chain (list (quote poss) owner val))))
|
||||
((= typ "attr") (do (adv!) (list (quote attr) val owner)))
|
||||
((= typ "class")
|
||||
(let
|
||||
((prop (get (adv!) "value")))
|
||||
(parse-prop-chain (list (quote .) owner prop))))
|
||||
(parse-prop-chain (list (quote poss) owner prop))))
|
||||
((= typ "style") (do (adv!) (list (quote style) val owner)))
|
||||
(true owner)))))
|
||||
(define
|
||||
@@ -116,7 +118,18 @@
|
||||
(prev-end)
|
||||
base-line
|
||||
{:root base})))
|
||||
base)))))
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "op")
|
||||
(= (tp-val) "'s")
|
||||
(not (at-end?)))
|
||||
(let
|
||||
((poss-prop (begin (adv!) (tp-val))))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-prop-chain
|
||||
(list (make-symbol "poss") base poss-prop))))
|
||||
base))))))
|
||||
(define
|
||||
parse-trav
|
||||
(fn
|
||||
@@ -429,8 +442,7 @@
|
||||
(let
|
||||
((name val) (args (parse-call-args)))
|
||||
(cons (quote call) (cons (list (quote ref) name) args)))))
|
||||
((= typ "keyword")
|
||||
(do (adv!) (list (quote ref) val)))
|
||||
((= typ "keyword") (do (adv!) (list (quote ref) val)))
|
||||
(true nil)))))
|
||||
(define
|
||||
parse-poss
|
||||
@@ -443,10 +455,13 @@
|
||||
((= (tp-type) "dot")
|
||||
(do
|
||||
(adv!)
|
||||
(let ((typ2 (tp-type)) (val2 (tp-val)))
|
||||
(let
|
||||
((typ2 (tp-type)) (val2 (tp-val)))
|
||||
(if
|
||||
(or (= typ2 "ident") (= typ2 "keyword"))
|
||||
(do (adv!) (parse-poss (list (make-symbol ".") obj val2)))
|
||||
(do
|
||||
(adv!)
|
||||
(parse-poss (list (make-symbol ".") obj val2)))
|
||||
obj))))
|
||||
((= (tp-type) "paren-open")
|
||||
(let
|
||||
@@ -1475,7 +1490,8 @@
|
||||
((match-kw "to")
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(if (and (list? tgt) (= (first tgt) (quote query)))
|
||||
(if
|
||||
(and (list? tgt) (= (first tgt) (quote query)))
|
||||
(list (quote set-el!) tgt value)
|
||||
(list (quote set!) tgt value))))
|
||||
((match-kw "on")
|
||||
@@ -2648,7 +2664,14 @@
|
||||
((and (= typ "keyword") (= val "answer"))
|
||||
(do (adv!) (parse-answer-cmd)))
|
||||
((and (= typ "keyword") (= val "settle"))
|
||||
(do (adv!) (list (quote settle))))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((tgt (cond ((at-end?) nil) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "on"))) nil) (true (parse-expr)))))
|
||||
(if
|
||||
(nil? tgt)
|
||||
(list (quote settle))
|
||||
(list (quote settle) tgt)))))
|
||||
((and (= typ "keyword") (= val "go"))
|
||||
(do (adv!) (parse-go-cmd)))
|
||||
((and (= typ "keyword") (= val "return"))
|
||||
@@ -2716,9 +2739,11 @@
|
||||
(adv!)
|
||||
(expect-kw! "view")
|
||||
(expect-kw! "transition")
|
||||
(let ((using (if (match-kw "using") (parse-expr) nil)))
|
||||
(let
|
||||
((using (if (match-kw "using") (parse-expr) nil)))
|
||||
(match-kw "then")
|
||||
(let ((body (parse-cmd-list)))
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote view-transition!) using body)))))
|
||||
(true (parse-expr))))))
|
||||
@@ -2882,7 +2907,11 @@
|
||||
(true nil))))
|
||||
(true nil))))
|
||||
(consume-having!)
|
||||
(when (and (= (tp-type) "keyword") (= (tp-val) "queue")) (do (adv!) (adv!)))
|
||||
(when
|
||||
(and
|
||||
(= (tp-type) "keyword")
|
||||
(= (tp-val) "queue"))
|
||||
(do (adv!) (adv!)))
|
||||
(let
|
||||
((having (if (or h-margin h-threshold) (dict "margin" h-margin "threshold" h-threshold) nil)))
|
||||
(let
|
||||
|
||||
@@ -146,18 +146,27 @@
|
||||
(perform (list (quote io-wait-event) target event-name timeout-ms)))))
|
||||
|
||||
;; Find next sibling matching a selector (or any sibling).
|
||||
(define hs-settle (fn (target) (perform (list (quote io-settle) target))))
|
||||
(define
|
||||
hs-settle
|
||||
(fn
|
||||
(target)
|
||||
(hs-null-raise! target)
|
||||
(when (not (nil? target)) (perform (list (quote io-settle) target)))))
|
||||
|
||||
;; Find previous sibling matching a selector.
|
||||
(define
|
||||
hs-toggle-class!
|
||||
(fn (target cls) (host-call (host-get target "classList") "toggle" cls)))
|
||||
(fn
|
||||
(target cls)
|
||||
(hs-null-raise! target)
|
||||
(host-call (host-get target "classList") "toggle" cls)))
|
||||
|
||||
;; First element matching selector within a scope.
|
||||
(define
|
||||
hs-toggle-between!
|
||||
(fn
|
||||
(target cls1 cls2)
|
||||
(hs-null-raise! target)
|
||||
(if
|
||||
(dom-has-class? target cls1)
|
||||
(do (dom-remove-class target cls1) (dom-add-class target cls2))
|
||||
@@ -272,11 +281,13 @@
|
||||
hs-set-attr!
|
||||
(fn
|
||||
(el name val)
|
||||
(hs-null-raise! el)
|
||||
(if (nil? val) (dom-remove-attr el name) (dom-set-attr el name val))))
|
||||
(define
|
||||
hs-toggle-attr!
|
||||
(fn
|
||||
(el name)
|
||||
(hs-null-raise! el)
|
||||
(if
|
||||
(dom-has-attr? el name)
|
||||
(dom-remove-attr el name)
|
||||
@@ -311,22 +322,34 @@
|
||||
hs-set-inner-html!
|
||||
(fn
|
||||
(target value)
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target)))))
|
||||
(do
|
||||
(hs-null-raise! target)
|
||||
(let
|
||||
((str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(do (dom-set-inner-html target str-val) (hs-boot-subtree! target))))))
|
||||
(define
|
||||
hs-set-element!
|
||||
(fn
|
||||
(target value)
|
||||
(let ((parent (dom-parent target)))
|
||||
(when parent
|
||||
(let ((tmp (dom-create-element "div"))
|
||||
(str-val (if (list? value) (join "" (map (fn (x) (str x)) value)) value)))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(when
|
||||
parent
|
||||
(let
|
||||
((tmp (dom-create-element "div"))
|
||||
(str-val
|
||||
(if
|
||||
(list? value)
|
||||
(join "" (map (fn (x) (str x)) value))
|
||||
value)))
|
||||
(do
|
||||
(dom-set-inner-html tmp str-val)
|
||||
(let ((children (host-get tmp "children")))
|
||||
(if (> (len children) 0)
|
||||
(let ((new-el (first children)))
|
||||
(let
|
||||
((children (host-get tmp "children")))
|
||||
(if
|
||||
(> (len children) 0)
|
||||
(let
|
||||
((new-el (first children)))
|
||||
(do
|
||||
(host-call parent "replaceChild" new-el target)
|
||||
(hs-boot-subtree! new-el)))
|
||||
@@ -335,62 +358,64 @@
|
||||
hs-put!
|
||||
(fn
|
||||
(value pos target)
|
||||
(cond
|
||||
((= pos "into")
|
||||
(cond
|
||||
((list? target) target)
|
||||
((hs-element? value)
|
||||
(do
|
||||
(dom-set-inner-html target "")
|
||||
(host-call target "appendChild" value)))
|
||||
(true
|
||||
(do
|
||||
(dom-set-inner-html target value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "before")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(when parent (host-call parent "insertBefore" value target)))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforebegin" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "after")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target))
|
||||
(next (host-get target "nextSibling")))
|
||||
(when
|
||||
parent
|
||||
(if
|
||||
next
|
||||
(host-call parent "insertBefore" value next)
|
||||
(host-call parent "appendChild" value))))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterend" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "start")
|
||||
(cond
|
||||
((list? target) (append! target value 0))
|
||||
((hs-element? value) (dom-prepend target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterbegin" value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "end")
|
||||
(cond
|
||||
((list? target) (append! target value))
|
||||
((hs-element? value) (dom-append target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target)))))))))
|
||||
(do
|
||||
(hs-null-raise! target)
|
||||
(cond
|
||||
((= pos "into")
|
||||
(cond
|
||||
((list? target) target)
|
||||
((hs-element? value)
|
||||
(do
|
||||
(dom-set-inner-html target "")
|
||||
(host-call target "appendChild" value)))
|
||||
(true
|
||||
(do
|
||||
(dom-set-inner-html target value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "before")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(when parent (host-call parent "insertBefore" value target)))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforebegin" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "after")
|
||||
(if
|
||||
(hs-element? value)
|
||||
(let
|
||||
((parent (dom-parent target))
|
||||
(next (host-get target "nextSibling")))
|
||||
(when
|
||||
parent
|
||||
(if
|
||||
next
|
||||
(host-call parent "insertBefore" value next)
|
||||
(host-call parent "appendChild" value))))
|
||||
(let
|
||||
((parent (dom-parent target)))
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterend" value)
|
||||
(when parent (hs-boot-subtree! parent))))))
|
||||
((= pos "start")
|
||||
(cond
|
||||
((list? target) (append! target value 0))
|
||||
((hs-element? value) (dom-prepend target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "afterbegin" value)
|
||||
(hs-boot-subtree! target)))))
|
||||
((= pos "end")
|
||||
(cond
|
||||
((list? target) (append! target value))
|
||||
((hs-element? value) (dom-append target value))
|
||||
(true
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend" value)
|
||||
(hs-boot-subtree! target))))))))))
|
||||
|
||||
;; ── Fetch ───────────────────────────────────────────────────────
|
||||
|
||||
@@ -687,11 +712,59 @@
|
||||
(true (find-prev (dom-get-prop el "previousElementSibling"))))))
|
||||
(find-prev sibling)))))
|
||||
|
||||
(define
|
||||
hs-query-all
|
||||
(fn (sel) (host-call (dom-body) "querySelectorAll" sel)))
|
||||
(define _hs-last-query-sel nil)
|
||||
;; ── Sandbox/test runtime additions ──────────────────────────────
|
||||
;; Property access — dot notation and .length
|
||||
(define
|
||||
hs-null-raise!
|
||||
(fn
|
||||
(v)
|
||||
(when
|
||||
(nil? v)
|
||||
(let
|
||||
((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
|
||||
(host-set! (host-global "window") "_hs_null_error" msg)
|
||||
(guard (_null-e (true nil)) (raise msg))))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
(define
|
||||
hs-empty-raise!
|
||||
(fn
|
||||
(v)
|
||||
(when
|
||||
(or
|
||||
(nil? v)
|
||||
(and (list? v) (= (len v) 0))
|
||||
(= (host-get v "length") 0))
|
||||
(let
|
||||
((msg (str "'" (or (host-get (host-global "window") "_hs_last_query_sel") "target") "' is null")))
|
||||
(host-set! (host-global "window") "_hs_null_error" msg)
|
||||
(guard (_null-e (true nil)) (raise msg))))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
(define
|
||||
hs-query-all-checked
|
||||
(fn
|
||||
(sel)
|
||||
(let
|
||||
((result (hs-query-all sel)))
|
||||
(do (hs-empty-raise! result) result))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
(define
|
||||
hs-dispatch!
|
||||
(fn
|
||||
(target event detail)
|
||||
(hs-null-raise! target)
|
||||
(dom-dispatch target event detail)))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(define
|
||||
hs-query-all
|
||||
(fn
|
||||
(sel)
|
||||
(do
|
||||
(host-set! (host-global "window") "_hs_last_query_sel" sel)
|
||||
(host-to-list (host-call (dom-body) "querySelectorAll" sel)))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
(define
|
||||
hs-query-all-in
|
||||
(fn
|
||||
@@ -700,23 +773,25 @@
|
||||
(nil? target)
|
||||
(hs-query-all sel)
|
||||
(host-call target "querySelectorAll" sel))))
|
||||
;; DOM query stub — sandbox returns empty list
|
||||
;; Collection: sorted by
|
||||
(define
|
||||
hs-list-set
|
||||
(fn
|
||||
(lst idx val)
|
||||
(append (take lst idx) (cons val (drop lst (+ idx 1))))))
|
||||
;; Method dispatch — obj.method(args)
|
||||
;; Collection: sorted by descending
|
||||
(define
|
||||
hs-to-number
|
||||
(fn (v) (if (number? v) v (or (parse-number (str v)) 0))))
|
||||
|
||||
;; ── 0.9.90 features ─────────────────────────────────────────────
|
||||
;; beep! — debug logging, returns value unchanged
|
||||
;; Collection: split by
|
||||
(define
|
||||
hs-query-first
|
||||
(fn (sel) (host-call (host-global "document") "querySelector" sel)))
|
||||
;; Property-based is — check obj.key truthiness
|
||||
(fn
|
||||
(sel)
|
||||
(do
|
||||
(host-set! (host-global "window") "_hs_last_query_sel" sel)
|
||||
(host-call (host-global "document") "querySelector" sel))))
|
||||
;; Collection: joined by
|
||||
(define
|
||||
hs-query-last
|
||||
(fn
|
||||
@@ -724,9 +799,9 @@
|
||||
(let
|
||||
((all (dom-query-all (dom-body) sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; Array slicing (inclusive both ends)
|
||||
|
||||
(define hs-first (fn (scope sel) (dom-query-all scope sel)))
|
||||
;; Collection: sorted by
|
||||
|
||||
(define
|
||||
hs-last
|
||||
(fn
|
||||
@@ -734,7 +809,7 @@
|
||||
(let
|
||||
((all (dom-query-all scope sel)))
|
||||
(if (> (len all) 0) (nth all (- (len all) 1)) nil))))
|
||||
;; Collection: sorted by descending
|
||||
|
||||
(define
|
||||
hs-repeat-times
|
||||
(fn
|
||||
@@ -752,7 +827,7 @@
|
||||
((= signal "hs-continue") (do-repeat (+ i 1)))
|
||||
(true (do-repeat (+ i 1))))))))
|
||||
(do-repeat 0)))
|
||||
;; Collection: split by
|
||||
|
||||
(define
|
||||
hs-repeat-forever
|
||||
(fn
|
||||
@@ -768,7 +843,7 @@
|
||||
((= signal "hs-continue") (do-forever))
|
||||
(true (do-forever))))))
|
||||
(do-forever)))
|
||||
;; Collection: joined by
|
||||
|
||||
(define
|
||||
hs-repeat-while
|
||||
(fn
|
||||
@@ -829,8 +904,13 @@
|
||||
(append target (list value))))
|
||||
((hs-element? target)
|
||||
(do
|
||||
(dom-insert-adjacent-html target "beforeend"
|
||||
(if (hs-element? value) (host-get value "outerHTML") (str value)))
|
||||
(dom-insert-adjacent-html
|
||||
target
|
||||
"beforeend"
|
||||
(if
|
||||
(hs-element? value)
|
||||
(host-get value "outerHTML")
|
||||
(str value)))
|
||||
target))
|
||||
(true (str target value)))))
|
||||
(define
|
||||
@@ -840,8 +920,13 @@
|
||||
(cond
|
||||
((nil? target) nil)
|
||||
((hs-element? target)
|
||||
(dom-insert-adjacent-html target "beforeend"
|
||||
(if (hs-element? value) (host-get value "outerHTML") (str value))))
|
||||
(dom-insert-adjacent-html
|
||||
target
|
||||
"beforeend"
|
||||
(if
|
||||
(hs-element? value)
|
||||
(host-get value "outerHTML")
|
||||
(str value))))
|
||||
(true nil)))))
|
||||
|
||||
(define
|
||||
@@ -911,24 +996,23 @@
|
||||
(fn
|
||||
(url format no-throw)
|
||||
(let
|
||||
((fmt (cond
|
||||
((nil? format) "text")
|
||||
((or (= format "json") (= format "JSON") (= format "Object")) "json")
|
||||
((or (= format "html") (= format "HTML")) "html")
|
||||
((or (= format "response") (= format "Response")) "response")
|
||||
((or (= format "text") (= format "Text")) "text")
|
||||
((or (= format "number") (= format "Number")) "number")
|
||||
(true "text"))))
|
||||
((fmt (cond ((nil? format) "text") ((or (= format "json") (= format "JSON") (= format "Object")) "json") ((or (= format "html") (= format "HTML")) "html") ((or (= format "response") (= format "Response")) "response") ((or (= format "text") (= format "Text")) "text") ((or (= format "number") (= format "Number")) "number") (true "text"))))
|
||||
(let
|
||||
((_hs-before-caller (host-get meta "owner")))
|
||||
(when _hs-before-caller
|
||||
(when
|
||||
_hs-before-caller
|
||||
(dom-dispatch _hs-before-caller "hyperscript:beforeFetch" {:url url})))
|
||||
(let
|
||||
((raw (perform (list "io-fetch" url fmt))))
|
||||
(begin
|
||||
(when (= (host-get raw "_network-error") true)
|
||||
(when
|
||||
(= (host-get raw "_network-error") true)
|
||||
(raise (or (host-get raw "message") "Network error")))
|
||||
(when (and (not no-throw) (not (= fmt "response")) (= (host-get raw "ok") false))
|
||||
(when
|
||||
(and
|
||||
(not no-throw)
|
||||
(not (= fmt "response"))
|
||||
(= (host-get raw "ok") false))
|
||||
(raise (str "HTTP Error: " (host-get raw "status"))))
|
||||
(cond
|
||||
((= fmt "response") raw)
|
||||
@@ -938,13 +1022,9 @@
|
||||
(hs-to-number (perform (list "io-parse-text" raw))))
|
||||
(true (perform (list "io-parse-text" raw)))))))))
|
||||
|
||||
(define
|
||||
hs-fetch
|
||||
(fn (url format) (hs-fetch-impl url format false)))
|
||||
(define hs-fetch (fn (url format) (hs-fetch-impl url format false)))
|
||||
|
||||
(define
|
||||
hs-fetch-no-throw
|
||||
(fn (url format) (hs-fetch-impl url format true)))
|
||||
(define hs-fetch-no-throw (fn (url format) (hs-fetch-impl url format true)))
|
||||
|
||||
(define
|
||||
hs-json-escape
|
||||
@@ -1035,7 +1115,8 @@
|
||||
(true (str value))))
|
||||
((= type-name "JSON")
|
||||
(cond
|
||||
((string? value) (guard (_e (true value)) (hs-host-to-sx (json-parse value))))
|
||||
((string? value)
|
||||
(guard (_e (true value)) (hs-host-to-sx (json-parse value))))
|
||||
((not (nil? (host-get value "_json")))
|
||||
(hs-host-to-sx (perform (list "io-parse-json" value))))
|
||||
((dict? value) value)
|
||||
@@ -1206,7 +1287,9 @@
|
||||
raw-val
|
||||
(if
|
||||
(and (not (nil? opts)) (>= idx 0))
|
||||
(host-get (if (list? opts) (nth opts idx) (host-get opts idx)) "value")
|
||||
(host-get
|
||||
(if (list? opts) (nth opts idx) (host-get opts idx))
|
||||
"value")
|
||||
"")))))
|
||||
((or (= typ "checkbox") (= typ "radio"))
|
||||
(if (host-get node "checked") (host-get node "value") nil))
|
||||
@@ -1418,12 +1501,16 @@
|
||||
|
||||
(define
|
||||
hs-measure
|
||||
(fn (target) (perform (list (quote io-measure) target))))
|
||||
(fn
|
||||
(target)
|
||||
(hs-null-raise! target)
|
||||
(when (not (nil? target)) (perform (list (quote io-measure) target)))))
|
||||
|
||||
(define
|
||||
hs-transition
|
||||
(fn
|
||||
(target prop value duration)
|
||||
(hs-null-raise! target)
|
||||
(let
|
||||
((init-attr (str "data-hs-init-" prop)))
|
||||
(when
|
||||
@@ -2010,6 +2097,7 @@
|
||||
hs-hide!
|
||||
(fn
|
||||
(target strategy)
|
||||
(hs-empty-raise! target)
|
||||
(if
|
||||
(list? target)
|
||||
(do (for-each (fn (el) (hs-hide-one! el strategy)) target) target)
|
||||
@@ -2051,6 +2139,7 @@
|
||||
hs-show!
|
||||
(fn
|
||||
(target strategy)
|
||||
(hs-empty-raise! target)
|
||||
(if
|
||||
(list? target)
|
||||
(do (for-each (fn (el) (hs-show-one! el strategy)) target) target)
|
||||
@@ -2192,9 +2281,7 @@
|
||||
((d {}))
|
||||
(do
|
||||
(for-each
|
||||
(fn
|
||||
(pair)
|
||||
(dict-set! d (first pair) (nth pair 1)))
|
||||
(fn (pair) (dict-set! d (first pair) (nth pair 1)))
|
||||
pairs)
|
||||
d))))
|
||||
|
||||
@@ -2560,6 +2647,8 @@
|
||||
((= (dom-get-attr el "dom-scope") "isolated") nil)
|
||||
(true (hs-dom-find-owner (dom-parent el) name)))))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-dom-get
|
||||
(fn (el name) (hs-dom-walk (hs-dom-resolve-start el) name)))
|
||||
@@ -2596,8 +2685,6 @@
|
||||
((nth entry 2) val)))
|
||||
_hs-dom-watchers)))
|
||||
|
||||
;; ── SourceInfo API ────────────────────────────────────────────────
|
||||
|
||||
(define
|
||||
hs-dom-is-ancestor?
|
||||
(fn
|
||||
@@ -2611,7 +2698,15 @@
|
||||
hs-win-call
|
||||
(fn
|
||||
(fn-name args)
|
||||
(let ((fn (host-global fn-name))) (if fn (host-call-fn fn args) nil))))
|
||||
(let
|
||||
((fn (host-get (host-global "window") fn-name)))
|
||||
(if
|
||||
fn
|
||||
(host-call-fn fn args)
|
||||
(let
|
||||
((msg (str "'" fn-name "' is null")))
|
||||
(host-set! (host-global "window") "_hs_null_error" msg)
|
||||
(guard (_null-e (true nil)) (raise msg)))))))
|
||||
|
||||
(define
|
||||
hs-source-for
|
||||
@@ -2725,22 +2820,38 @@
|
||||
{:value value :type "COLON" :op true}
|
||||
(= type "op")
|
||||
(cond
|
||||
(= value "+") {:value value :type "PLUS" :op true}
|
||||
(= value "-") {:value value :type "MINUS" :op true}
|
||||
(= value "*") {:value value :type "MULTIPLY" :op true}
|
||||
(= value "/") {:value value :type "SLASH" :op true}
|
||||
(= value "!") {:value value :type "EXCLAMATION" :op true}
|
||||
(= value "?") {:value value :type "QUESTION" :op true}
|
||||
(= value "#") {:value value :type "POUND" :op true}
|
||||
(= value "&") {:value value :type "AMPERSAND" :op true}
|
||||
(= value "=") {:value value :type "EQUALS" :op true}
|
||||
(= value "<") {:value value :type "L_ANG" :op true}
|
||||
(= value ">") {:value value :type "R_ANG" :op true}
|
||||
(= value "<=") {:value value :type "LTE_ANG" :op true}
|
||||
(= value ">=") {:value value :type "GTE_ANG" :op true}
|
||||
(= value "==") {:value value :type "EQ" :op true}
|
||||
(= value "===") {:value value :type "EQQ" :op true}
|
||||
(= value "..") {:value value :type "PERIOD_PERIOD" :op true}
|
||||
(= value "+")
|
||||
{:value value :type "PLUS" :op true}
|
||||
(= value "-")
|
||||
{:value value :type "MINUS" :op true}
|
||||
(= value "*")
|
||||
{:value value :type "MULTIPLY" :op true}
|
||||
(= value "/")
|
||||
{:value value :type "SLASH" :op true}
|
||||
(= value "!")
|
||||
{:value value :type "EXCLAMATION" :op true}
|
||||
(= value "?")
|
||||
{:value value :type "QUESTION" :op true}
|
||||
(= value "#")
|
||||
{:value value :type "POUND" :op true}
|
||||
(= value "&")
|
||||
{:value value :type "AMPERSAND" :op true}
|
||||
(= value "=")
|
||||
{:value value :type "EQUALS" :op true}
|
||||
(= value "<")
|
||||
{:value value :type "L_ANG" :op true}
|
||||
(= value ">")
|
||||
{:value value :type "R_ANG" :op true}
|
||||
(= value "<=")
|
||||
{:value value :type "LTE_ANG" :op true}
|
||||
(= value ">=")
|
||||
{:value value :type "GTE_ANG" :op true}
|
||||
(= value "==")
|
||||
{:value value :type "EQ" :op true}
|
||||
(= value "===")
|
||||
{:value value :type "EQQ" :op true}
|
||||
(= value "..")
|
||||
{:value value :type "PERIOD_PERIOD" :op true}
|
||||
:else {:value value :type value :op true})
|
||||
:else {:value (or value "") :type (str type) :op false}))))
|
||||
|
||||
@@ -2761,8 +2872,7 @@
|
||||
(fn
|
||||
(s i)
|
||||
(let
|
||||
((lst (dict-get s :list))
|
||||
(n (len (dict-get s :list))))
|
||||
((lst (dict-get s :list)) (n (len (dict-get s :list))))
|
||||
(define
|
||||
find
|
||||
(fn
|
||||
@@ -2775,10 +2885,7 @@
|
||||
(if
|
||||
(= (dict-get tok :type) "whitespace")
|
||||
(find (+ pos 1) count)
|
||||
(if
|
||||
(= count 0)
|
||||
tok
|
||||
(find (+ pos 1) (- count 1))))))))
|
||||
(if (= count 0) tok (find (+ pos 1) (- count 1))))))))
|
||||
(find (dict-get s :pos) i))))
|
||||
|
||||
(define
|
||||
@@ -2786,8 +2893,7 @@
|
||||
(fn
|
||||
(s)
|
||||
(let
|
||||
((lst (dict-get s :list))
|
||||
(n (len (dict-get s :list))))
|
||||
((lst (dict-get s :list)) (n (len (dict-get s :list))))
|
||||
(define
|
||||
find-pos
|
||||
(fn
|
||||
|
||||
Reference in New Issue
Block a user