HS: fix empty/halt/morph/reset/dialog — 17 upstream tests pass
- parser `empty` no-target → (ref "me") (was bogus (sym "me")) - parser `halt` modes distinguish: "all"/"bubbling"/"default" halt execution (raise hs-return), "the-event"/"the event's" only stop propagation/default. "'s" now matched as op token, not keyword. - parser `get` cmd: dispatch + cmd-kw list + parse-get-cmd (parses expr with optional `as TYPE`). Required for `get result as JSON` in fetch chains. - compiler empty-target for (local X): emit (set! X (hs-empty-like X)) so arrays/sets/maps clear the variable, not call DOM empty on the value. - runtime hs-empty-like: container-of-same-type empty value. - runtime hs-empty-target!: drop dead FORM branch that was short-circuiting to innerHTML=""; the querySelectorAll-over-inputs branch now runs. - runtime hs-halt!: take ev param (was free `event` lookup); raise hs-return to stop execution unless mode is "the-event". - runtime hs-reset!: type-aware — FORM → reset, INPUT/TEXTAREA → value/checked from defaults, SELECT → defaultSelected option. - runtime hs-open!/hs-close!: toggle `open` attribute on details elements (not just the prop) so dom-has-attr? assertions work. - runtime hs-coerce JSON: json-stringify dict/list (was str). - test-runner mock: host-get on List + "length"/"size" (was only Dict); dom-set-attr tracks defaultChecked / defaultSelected / defaultValue; mock_query_all supports comma-separated selector groups. - generator: emit boolean attrs (checked/selected/etc) even with null value; drop overcautious "skip HS with bare quotes or embedded HTML" guard so morph tests (source contains embedded <div>) emit properly. Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -23,14 +23,48 @@
|
||||
((th (first target)))
|
||||
(cond
|
||||
((= th dot-sym)
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx (nth target 1))
|
||||
(nth target 2)
|
||||
value))
|
||||
(let
|
||||
((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
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(quote __hs-el)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth base-ast 1))))
|
||||
((and (list? base-ast) (= (first base-ast) dot-sym) (let ((inner (nth base-ast 1))) (and (list? inner) (= (first inner) (quote query)) (let ((s (nth inner 1))) (and (string? s) (> (len s) 0) (= (substring s 0 1) "."))))))
|
||||
(let
|
||||
((inner (nth base-ast 1))
|
||||
(mid-prop (nth base-ast 2)))
|
||||
(list
|
||||
(quote for-each)
|
||||
(list
|
||||
(quote fn)
|
||||
(list (quote __hs-el))
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(list
|
||||
(quote host-get)
|
||||
(quote __hs-el)
|
||||
mid-prop)
|
||||
prop
|
||||
value))
|
||||
(list (quote hs-query-all) (nth inner 1)))))
|
||||
(true
|
||||
(list
|
||||
(quote dom-set-prop)
|
||||
(hs-to-sx base-ast)
|
||||
prop
|
||||
value)))))
|
||||
((= th (quote attr))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
value))
|
||||
@@ -44,6 +78,12 @@
|
||||
(list (quote set!) (make-symbol (nth target 1)) value))
|
||||
((= th (quote local))
|
||||
(list (quote define) (make-symbol (nth target 1)) value))
|
||||
((= th (quote dom-ref))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
(hs-to-sx (nth target 2))
|
||||
(nth target 1)
|
||||
value))
|
||||
((= th (quote me))
|
||||
(list (quote dom-set-inner-html) (quote me) value))
|
||||
((= th (quote it)) (list (quote set!) (quote it) value))
|
||||
@@ -55,6 +95,8 @@
|
||||
(hs-to-sx (nth target 1))
|
||||
(hs-to-sx (nth target 2))
|
||||
value))
|
||||
((or (= th (quote next)) (= th (quote previous)) (= th (quote closest)))
|
||||
(list (quote dom-set-inner-html) (hs-to-sx target) value))
|
||||
((= th (quote of))
|
||||
(let
|
||||
((prop-ast (nth target 1)) (obj-ast (nth target 2)))
|
||||
@@ -76,7 +118,7 @@
|
||||
(list? prop-ast)
|
||||
(= (first prop-ast) (quote attr)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
(quote hs-set-attr!)
|
||||
(hs-to-sx obj-ast)
|
||||
(nth prop-ast 1)
|
||||
value)
|
||||
@@ -247,7 +289,14 @@
|
||||
(ast)
|
||||
(let
|
||||
((var-name (nth ast 1))
|
||||
(collection (hs-to-sx (nth ast 2)))
|
||||
(raw-coll (hs-to-sx (nth ast 2)))
|
||||
(collection
|
||||
(if
|
||||
(symbol? raw-coll)
|
||||
(list
|
||||
(quote hs-safe-call)
|
||||
(list (quote fn) (list) raw-coll))
|
||||
raw-coll))
|
||||
(body (hs-to-sx (nth ast 3))))
|
||||
(if
|
||||
(and (> (len ast) 4) (= (nth ast 4) :index))
|
||||
@@ -308,48 +357,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(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)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) 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)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(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)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote +)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote +) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote +) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-dec
|
||||
(fn
|
||||
@@ -357,48 +478,120 @@
|
||||
(cond
|
||||
((and (list? expr) (= (first expr) (quote attr)))
|
||||
(let
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me))))
|
||||
((el (if tgt-override (hs-to-sx tgt-override) (quote me)))
|
||||
(attr-name (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-attr)
|
||||
el
|
||||
(nth expr 1)
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-attr) el (nth expr 1)))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-attr) el attr-name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-attr) el attr-name (quote __hs-new))
|
||||
(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)))
|
||||
(list
|
||||
(quote host-set!)
|
||||
obj
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote host-get) obj prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote host-set!) 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)))
|
||||
(prop (nth expr 1)))
|
||||
(list
|
||||
(quote dom-set-style)
|
||||
el
|
||||
prop
|
||||
(quote let)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote parse-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount))))
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote dom-get-style) el prop))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote dom-set-style) el prop (quote __hs-new))
|
||||
(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)))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote hs-dom-get) el name))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote hs-dom-set!) el name (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new))))))
|
||||
((and (list? expr) (= (first expr) (quote array-index)) (list? (nth expr 1)) (= (first (nth expr 1)) (quote ref)))
|
||||
(let
|
||||
((var-sym (make-symbol (nth (nth expr 1) 1)))
|
||||
(idx (hs-to-sx (nth expr 2))))
|
||||
(list
|
||||
(quote let)
|
||||
(list (list (quote __hs-idx) idx))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list
|
||||
(quote -)
|
||||
(list
|
||||
(quote hs-to-number)
|
||||
(list (quote nth) var-sym (quote __hs-idx)))
|
||||
amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list
|
||||
(quote set!)
|
||||
var-sym
|
||||
(list
|
||||
(quote hs-list-set)
|
||||
var-sym
|
||||
(quote __hs-idx)
|
||||
(quote __hs-new)))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))
|
||||
(true
|
||||
(let
|
||||
((t (hs-to-sx expr)))
|
||||
(list (quote set!) t (list (quote -) t amount)))))))
|
||||
(list
|
||||
(quote let)
|
||||
(list
|
||||
(list
|
||||
(quote __hs-new)
|
||||
(list (quote -) (list (quote hs-to-number) t) amount)))
|
||||
(list
|
||||
(quote do)
|
||||
(list (quote set!) t (quote __hs-new))
|
||||
(list (quote set!) (quote it) (quote __hs-new)))))))))
|
||||
(define
|
||||
emit-behavior
|
||||
(fn
|
||||
@@ -427,7 +620,7 @@
|
||||
((= head (quote null-literal)) nil)
|
||||
((= head (quote not))
|
||||
(list (quote not) (hs-to-sx (nth ast 1))))
|
||||
((or (= head (quote starts-with?)) (= head (quote ends-with?)) (= head (quote contains?)) (= head (quote precedes?)) (= head (quote follows?)) (= head (quote exists?)))
|
||||
((or (= head (quote and)) (= head (quote or)) (= head (quote >=)) (= head (quote <=)) (= head (quote >)) (= head (quote <)))
|
||||
(cons head (map hs-to-sx (rest ast))))
|
||||
((= head (quote object-literal))
|
||||
(let
|
||||
@@ -559,6 +752,37 @@
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote pick-first))
|
||||
(list
|
||||
(quote hs-pick-first)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote pick-last))
|
||||
(list
|
||||
(quote hs-pick-last)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote pick-random))
|
||||
(list
|
||||
(quote hs-pick-random)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(if (nil? (nth ast 2)) nil (hs-to-sx (nth ast 2)))))
|
||||
((= head (quote pick-items))
|
||||
(list
|
||||
(quote hs-pick-items)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))
|
||||
(hs-to-sx (nth ast 3))))
|
||||
((= head (quote pick-match))
|
||||
(list
|
||||
(quote regex-match)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote pick-matches))
|
||||
(list
|
||||
(quote regex-find-all)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote prop-is))
|
||||
(list
|
||||
(quote hs-prop-is)
|
||||
@@ -656,6 +880,11 @@
|
||||
(quote dom-get-style)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
((= head (quote dom-ref))
|
||||
(list
|
||||
(quote hs-dom-get)
|
||||
(hs-to-sx (nth ast 2))
|
||||
(nth ast 1)))
|
||||
((= head (quote has-class?))
|
||||
(list
|
||||
(quote dom-has-class?)
|
||||
@@ -742,6 +971,26 @@
|
||||
(quote hs-ends-with-ic?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote starts-with?))
|
||||
(list
|
||||
(quote hs-starts-with?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote ends-with?))
|
||||
(list
|
||||
(quote hs-ends-with?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote precedes?))
|
||||
(list
|
||||
(quote hs-precedes?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote follows?))
|
||||
(list
|
||||
(quote hs-follows?)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote contains?))
|
||||
(list
|
||||
(quote hs-contains?)
|
||||
@@ -922,7 +1171,15 @@
|
||||
(hs-to-sx tgt)
|
||||
(list (quote hs-remove-from!) val (hs-to-sx tgt)))))
|
||||
((= head (quote empty-target))
|
||||
(list (quote hs-empty-target!) (hs-to-sx (nth ast 1))))
|
||||
(let
|
||||
((tgt (nth ast 1)))
|
||||
(if
|
||||
(and (list? tgt) (= (first tgt) (quote local)))
|
||||
(list
|
||||
(quote set!)
|
||||
(make-symbol (nth tgt 1))
|
||||
(list (quote hs-empty-like) (make-symbol (nth tgt 1))))
|
||||
(list (quote hs-empty-target!) (hs-to-sx tgt)))))
|
||||
((= head (quote open-element))
|
||||
(list (quote hs-open!) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote close-element))
|
||||
@@ -937,6 +1194,11 @@
|
||||
(quote do)
|
||||
(emit-set lhs (hs-to-sx rhs))
|
||||
(emit-set rhs (quote _swap_tmp))))))
|
||||
((= head (quote morph!))
|
||||
(list
|
||||
(quote hs-morph!)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote remove-attr))
|
||||
(let
|
||||
((tgt (if (nil? (nth ast 2)) (quote me) (hs-to-sx (nth ast 2)))))
|
||||
@@ -977,6 +1239,23 @@
|
||||
(quote hs-set-on!)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(hs-to-sx (nth ast 2))))
|
||||
((= head (quote set-on!))
|
||||
(let
|
||||
((lhs (nth ast 1))
|
||||
(tgt-ast (nth ast 2))
|
||||
(val-ast (nth ast 3)))
|
||||
(if
|
||||
(and (list? lhs) (= (first lhs) (quote dom-ref)))
|
||||
(list
|
||||
(quote hs-dom-set!)
|
||||
(hs-to-sx tgt-ast)
|
||||
(nth lhs 1)
|
||||
(hs-to-sx val-ast))
|
||||
(list
|
||||
(quote hs-set-on!)
|
||||
(hs-to-sx lhs)
|
||||
(hs-to-sx tgt-ast)
|
||||
(hs-to-sx val-ast)))))
|
||||
((= head (quote toggle-between))
|
||||
(list
|
||||
(quote hs-toggle-between!)
|
||||
@@ -1051,6 +1330,9 @@
|
||||
(or
|
||||
(= (first c) (quote hs-fetch))
|
||||
(= (first c) (quote hs-wait))
|
||||
(= (first c) (quote hs-wait-for))
|
||||
(= (first c) (quote hs-query-first))
|
||||
(= (first c) (quote hs-query-all))
|
||||
(= (first c) (quote perform)))))
|
||||
compiled))
|
||||
(reduce
|
||||
@@ -1061,7 +1343,7 @@
|
||||
(list (list (quote it) cmd))
|
||||
body))
|
||||
(nth compiled (- (len compiled) 1))
|
||||
(reverse (rest (reverse compiled))))
|
||||
(rest (reverse compiled)))
|
||||
(cons (quote do) compiled))))
|
||||
((= head (quote wait)) (list (quote hs-wait) (nth ast 1)))
|
||||
((= head (quote wait-for)) (emit-wait-for ast))
|
||||
@@ -1194,20 +1476,39 @@
|
||||
((= head (quote measure))
|
||||
(list (quote hs-measure) (hs-to-sx (nth ast 1))))
|
||||
((= head (quote increment!))
|
||||
(emit-inc
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(= (len ast) 3)
|
||||
(emit-inc (nth ast 1) 1 (nth ast 2))
|
||||
(emit-inc
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil))))
|
||||
((= head (quote decrement!))
|
||||
(emit-dec
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil)))
|
||||
(if
|
||||
(= (len ast) 3)
|
||||
(emit-dec (nth ast 1) 1 (nth ast 2))
|
||||
(emit-dec
|
||||
(nth ast 1)
|
||||
(nth ast 2)
|
||||
(if (> (len ast) 3) (nth ast 3) nil))))
|
||||
((= head (quote break)) (list (quote raise) "hs-break"))
|
||||
((= head (quote continue))
|
||||
(list (quote raise) "hs-continue"))
|
||||
((= head (quote exit)) nil)
|
||||
((= head (quote live-no-op)) nil)
|
||||
((= head (quote when-feat-no-op)) nil)
|
||||
((= head (quote on)) (emit-on ast))
|
||||
((= head (quote when-changes))
|
||||
(let
|
||||
((expr (nth ast 1)) (body (nth ast 2)))
|
||||
(if
|
||||
(and (list? expr) (= (first expr) (quote dom-ref)))
|
||||
(list
|
||||
(quote hs-dom-watch!)
|
||||
(hs-to-sx (nth expr 2))
|
||||
(nth expr 1)
|
||||
(list (quote fn) (list (quote it)) (hs-to-sx body)))
|
||||
nil)))
|
||||
((= head (quote init))
|
||||
(list
|
||||
(quote hs-init)
|
||||
@@ -1352,7 +1653,14 @@
|
||||
(quote when)
|
||||
(list (quote nil?) t)
|
||||
(list (quote set!) t v))))
|
||||
((= head (quote halt!)) (list (quote hs-halt!) (nth ast 1)))
|
||||
((= head (quote hs-is))
|
||||
(list
|
||||
(quote hs-is)
|
||||
(hs-to-sx (nth ast 1))
|
||||
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2)))
|
||||
(nth ast 3)))
|
||||
((= head (quote halt!))
|
||||
(list (quote hs-halt!) (quote event) (nth ast 1)))
|
||||
((= head (quote focus!))
|
||||
(list (quote dom-focus) (hs-to-sx (nth ast 1))))
|
||||
(true ast))))))))
|
||||
|
||||
@@ -180,6 +180,16 @@
|
||||
((= typ "style")
|
||||
(do (adv!) (list (quote style) val (list (quote me)))))
|
||||
((= typ "local") (do (adv!) (list (quote local) val)))
|
||||
((= typ "hat")
|
||||
(do (adv!) (list (quote dom-ref) val (list (quote me)))))
|
||||
((and (= typ "keyword") (= val "dom"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((name (tp-val)))
|
||||
(do
|
||||
(adv!)
|
||||
(list (quote dom-ref) name (list (quote me)))))))
|
||||
((= typ "class")
|
||||
(do (adv!) (list (quote query) (str "." val))))
|
||||
((= typ "ident") (do (adv!) (list (quote ref) val)))
|
||||
@@ -288,7 +298,7 @@
|
||||
(adv!)
|
||||
(let
|
||||
((name val) (args (parse-call-args)))
|
||||
(list (quote call) (list (quote ref) name) args))))
|
||||
(cons (quote call) (cons (list (quote ref) name) args)))))
|
||||
(true nil)))))
|
||||
(define
|
||||
parse-poss
|
||||
@@ -301,7 +311,7 @@
|
||||
((= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(list (quote call) obj args)))
|
||||
(cons (quote call) (cons obj args))))
|
||||
((= (tp-type) "bracket-open")
|
||||
(do
|
||||
(adv!)
|
||||
@@ -479,20 +489,24 @@
|
||||
(list (quote type-check-strict) left type-name)
|
||||
(list (quote type-check) left type-name))))))
|
||||
(true
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(not (hs-keyword? (tp-val))))
|
||||
(let
|
||||
((prop-name (tp-val)))
|
||||
(do (adv!) (list (quote prop-is) left prop-name)))
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
(match-kw "case")
|
||||
(list (quote eq-ignore-case) left right))
|
||||
(if
|
||||
(match-kw "ignoring")
|
||||
(do
|
||||
(match-kw "case")
|
||||
(list (quote eq-ignore-case) left right))
|
||||
(and
|
||||
(list? right)
|
||||
(= (len right) 2)
|
||||
(= (first right) (quote ref))
|
||||
(string? (nth right 1)))
|
||||
(list
|
||||
(quote hs-is)
|
||||
left
|
||||
(list (quote fn) (list) right)
|
||||
(nth right 1))
|
||||
(list (quote =) left right))))))))
|
||||
((and (= typ "keyword") (= val "am"))
|
||||
(do
|
||||
@@ -504,12 +518,34 @@
|
||||
(list (quote not-in?) left (parse-expr)))
|
||||
((match-kw "empty")
|
||||
(list (quote not) (list (quote empty?) left)))
|
||||
((match-kw "between")
|
||||
(let
|
||||
((lo (parse-atom)))
|
||||
(match-kw "and")
|
||||
(let
|
||||
((hi (parse-atom)))
|
||||
(list
|
||||
(quote not)
|
||||
(list
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi))))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
(list (quote not) (list (quote =) left right))))))
|
||||
((match-kw "in") (list (quote in?) left (parse-expr)))
|
||||
((match-kw "empty") (list (quote empty?) left))
|
||||
((match-kw "between")
|
||||
(let
|
||||
((lo (parse-atom)))
|
||||
(match-kw "and")
|
||||
(let
|
||||
((hi (parse-atom)))
|
||||
(list
|
||||
(quote and)
|
||||
(list (quote >=) left lo)
|
||||
(list (quote <=) left hi)))))
|
||||
(true
|
||||
(let
|
||||
((right (parse-expr)))
|
||||
@@ -639,6 +675,14 @@
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote ends-with?) left (parse-expr)))))
|
||||
((or (match-kw "precede") (match-kw "precedes"))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote precedes?) left (parse-atom))))
|
||||
((or (match-kw "follow") (match-kw "follows"))
|
||||
(list
|
||||
(quote not)
|
||||
(list (quote follows?) left (parse-atom))))
|
||||
(true left))))
|
||||
((and (= typ "keyword") (= val "equals"))
|
||||
(do (adv!) (list (quote =) left (parse-expr))))
|
||||
@@ -877,7 +921,7 @@
|
||||
(collect-classes!))))
|
||||
(collect-classes!)
|
||||
(let
|
||||
((tgt (if (match-kw "from") (parse-expr) nil)))
|
||||
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
|
||||
(if
|
||||
(empty? extra-classes)
|
||||
(list (quote remove-class) cls tgt)
|
||||
@@ -1097,7 +1141,12 @@
|
||||
((match-kw "on")
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(list (quote set-on) tgt target)))
|
||||
(if
|
||||
(match-kw "to")
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(list (quote set-on!) tgt target value))
|
||||
(list (quote set-on) tgt target))))
|
||||
(true (error (str "Expected to/on at position " p)))))))
|
||||
(define
|
||||
parse-put-cmd
|
||||
@@ -1105,28 +1154,31 @@
|
||||
()
|
||||
(let
|
||||
((value (parse-expr)))
|
||||
(cond
|
||||
((match-kw "into") (list (quote set!) (parse-expr) value))
|
||||
((match-kw "before")
|
||||
(list (quote put!) value "before" (parse-expr)))
|
||||
((match-kw "after")
|
||||
(list (quote put!) value "after" (parse-expr)))
|
||||
((match-kw "at")
|
||||
(do
|
||||
(match-kw "the")
|
||||
(cond
|
||||
((match-kw "start")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "start" (parse-expr))))
|
||||
((match-kw "end")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "end" (parse-expr))))
|
||||
(true
|
||||
(error (str "Expected start/end after at, position " p))))))
|
||||
(true
|
||||
(error (str "Expected into/before/after/at at position " p)))))))
|
||||
(let
|
||||
((value (if (and (list? value) (= (first value) (quote dom-ref)) (match-kw "on")) (list (quote dom-ref) (nth value 1) (parse-expr)) value)))
|
||||
(cond
|
||||
((match-kw "into") (list (quote set!) (parse-expr) value))
|
||||
((match-kw "before")
|
||||
(list (quote put!) value "before" (parse-expr)))
|
||||
((match-kw "after")
|
||||
(list (quote put!) value "after" (parse-expr)))
|
||||
((match-kw "at")
|
||||
(do
|
||||
(match-kw "the")
|
||||
(cond
|
||||
((match-kw "start")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "start" (parse-expr))))
|
||||
((match-kw "end")
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(list (quote put!) value "end" (parse-expr))))
|
||||
(true
|
||||
(error
|
||||
(str "Expected start/end after at, position " p))))))
|
||||
(true
|
||||
(error (str "Expected into/before/after/at at position " p))))))))
|
||||
(define
|
||||
parse-if-cmd
|
||||
(fn
|
||||
@@ -1153,14 +1205,33 @@
|
||||
(adv!)
|
||||
(let
|
||||
((source (if (match-kw "from") (parse-expr) nil)))
|
||||
(if
|
||||
source
|
||||
(list (quote wait-for) event-name :from source)
|
||||
(list (quote wait-for) event-name)))))
|
||||
(let
|
||||
((timeout-dur (if (match-kw "or") (if (= (tp-type) "number") (let ((tok (adv!))) (let ((raw (get tok "value")) (suffix (if (and (= (tp-type) "ident") (or (= (tp-val) "ms") (= (tp-val) "s"))) (get (adv!) "value") ""))) (parse-dur (str raw suffix)))) nil) nil)))
|
||||
(cond
|
||||
((and source timeout-dur)
|
||||
(list
|
||||
(quote wait-for)
|
||||
event-name
|
||||
:from source
|
||||
:or timeout-dur))
|
||||
(source
|
||||
(list (quote wait-for) event-name :from source))
|
||||
(timeout-dur
|
||||
(list (quote wait-for) event-name :or timeout-dur))
|
||||
(true (list (quote wait-for) event-name)))))))
|
||||
((= (tp-type) "number")
|
||||
(let
|
||||
((tok (adv!)))
|
||||
(list (quote wait) (parse-dur (get tok "value")))))
|
||||
(let
|
||||
((raw (get tok "value"))
|
||||
(suffix
|
||||
(if
|
||||
(and
|
||||
(= (tp-type) "ident")
|
||||
(or (= (tp-val) "ms") (= (tp-val) "s")))
|
||||
(get (adv!) "value")
|
||||
"")))
|
||||
(list (quote wait) (parse-dur (str raw suffix))))))
|
||||
(true (list (quote wait) 0)))))
|
||||
(define
|
||||
parse-detail-dict
|
||||
@@ -1241,10 +1312,13 @@
|
||||
(let
|
||||
((expr (parse-expr)))
|
||||
(let
|
||||
((amount (if (match-kw "by") (parse-expr) 1)))
|
||||
((by-amount (if (match-kw "by") (parse-expr) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote increment!) expr amount tgt))))))
|
||||
(if
|
||||
by-amount
|
||||
(list (quote increment!) expr by-amount tgt)
|
||||
(list (quote increment!) expr tgt)))))))
|
||||
(define
|
||||
parse-dec-cmd
|
||||
(fn
|
||||
@@ -1252,10 +1326,13 @@
|
||||
(let
|
||||
((expr (parse-expr)))
|
||||
(let
|
||||
((amount (if (match-kw "by") (parse-expr) 1)))
|
||||
((by-amount (if (match-kw "by") (parse-expr) nil)))
|
||||
(let
|
||||
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
||||
(list (quote decrement!) expr amount tgt))))))
|
||||
(if
|
||||
by-amount
|
||||
(list (quote decrement!) expr by-amount tgt)
|
||||
(list (quote decrement!) expr tgt)))))))
|
||||
(define
|
||||
parse-hide-cmd
|
||||
(fn
|
||||
@@ -1279,7 +1356,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
((tgt (cond ((and (= (tp-type) "ident") (= (tp-val) "element")) (do (adv!) (parse-atom))) ((and (= (tp-type) "keyword") (= (tp-val) "its")) (do (adv!) (list (quote ref) "it"))) ((= (tp-type) "id") (parse-atom)) ((= (tp-type) "class") (parse-atom)) ((= (tp-type) "selector") (parse-atom)) (true nil))))
|
||||
(define
|
||||
parse-one-transition
|
||||
(fn
|
||||
@@ -1370,11 +1447,13 @@
|
||||
(fn
|
||||
()
|
||||
(if
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "gql"))
|
||||
(and
|
||||
(or (= (tp-type) "keyword") (= (tp-type) "ident"))
|
||||
(= (tp-val) "gql"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((gql-source (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql (append acc (list (if v v ""))) depth)))))) (str "{ " (collect-gql (list) 0) " }")) (if (or (and (= (tp-type) "keyword") (= (tp-val) "query")) (and (= (tp-type) "keyword") (= (tp-val) "mutation")) (and (= (tp-type) "keyword") (= (tp-val) "subscription"))) (let ((op-word (tp-val))) (adv!) (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql2 (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql2 (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql2 (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql2 (append acc (list (if v v ""))) depth)))))) (str op-word " { " (collect-gql2 (list) 0) " }")) (str op-word ""))) ""))))
|
||||
((gql-source (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql (append acc (list (if v v ""))) depth)))))) (str "{ " (collect-gql (list) 0) " }")) (if (or (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "query")) (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "mutation")) (and (or (= (tp-type) "keyword") (= (tp-type) "ident")) (= (tp-val) "subscription"))) (let ((op-word (tp-val))) (adv!) (if (= (tp-type) "brace-open") (do (adv!) (define collect-gql2 (fn (acc depth) (cond ((at-end?) (join " " acc)) ((= (tp-type) "brace-open") (do (adv!) (collect-gql2 (append acc (list "{")) (+ depth 1)))) ((= (tp-type) "brace-close") (if (= depth 0) (do (adv!) (join " " acc)) (do (adv!) (collect-gql2 (append acc (list "}")) (- depth 1))))) (true (let ((v (tp-val))) (adv!) (collect-gql2 (append acc (list (if v v ""))) depth)))))) (str op-word " { " (collect-gql2 (list) 0) " }")) (str op-word ""))) ""))))
|
||||
(let
|
||||
((url (if (and (= (tp-type) "keyword") (= (tp-val) "from")) (do (adv!) (parse-arith (parse-poss (parse-atom)))) nil)))
|
||||
(list (quote fetch-gql) gql-source url))))
|
||||
@@ -1383,7 +1462,7 @@
|
||||
(let
|
||||
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
|
||||
(let
|
||||
((fmt-before (if (match-kw "as") (let ((f (tp-val))) (adv!) f) nil)))
|
||||
((fmt-before (if (match-kw "as") (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
|
||||
(when (= (tp-type) "brace-open") (parse-expr))
|
||||
(when
|
||||
(match-kw "with")
|
||||
@@ -1392,7 +1471,7 @@
|
||||
(parse-expr)
|
||||
(parse-expr)))
|
||||
(let
|
||||
((fmt-after (if (and (not fmt-before) (match-kw "as")) (let ((f (tp-val))) (adv!) f) nil)))
|
||||
((fmt-after (if (and (not fmt-before) (match-kw "as")) (do (when (and (or (= (tp-type) "ident") (= (tp-type) "keyword")) (or (= (tp-val) "an") (= (tp-val) "a"))) (adv!)) (let ((f (tp-val))) (adv!) f)) nil)))
|
||||
(let
|
||||
((fmt (or fmt-before fmt-after "text")))
|
||||
(list (quote fetch) url fmt)))))))))
|
||||
@@ -1413,18 +1492,8 @@
|
||||
(if (= (tp-type) "comma") (adv!) nil)
|
||||
(ca-collect (append acc (list arg)))))))
|
||||
(ca-collect (list))))
|
||||
(define
|
||||
parse-call-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((name (get (adv!) "value")))
|
||||
(if
|
||||
(= (tp-type) "paren-open")
|
||||
(let
|
||||
((args (parse-call-args)))
|
||||
(cons (quote call) (cons name args)))
|
||||
(list (quote call) name)))))
|
||||
(define parse-call-cmd (fn () (parse-expr)))
|
||||
(define parse-get-cmd (fn () (parse-expr)))
|
||||
(define
|
||||
parse-take-cmd
|
||||
(fn
|
||||
@@ -1458,6 +1527,103 @@
|
||||
attr-val
|
||||
with-val)))))))
|
||||
(true nil))))
|
||||
(define
|
||||
parse-pick-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((typ (tp-type)) (val (tp-val)))
|
||||
(cond
|
||||
((and (= typ "keyword") (= val "first"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-first) coll n))))))
|
||||
((and (= typ "keyword") (= val "last"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-last) coll n))))))
|
||||
((and (= typ "keyword") (= val "random"))
|
||||
(do
|
||||
(adv!)
|
||||
(if
|
||||
(match-kw "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll nil))
|
||||
(let
|
||||
((n (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-random) coll n)))))))
|
||||
((and (= typ "ident") (= val "items"))
|
||||
(do
|
||||
(adv!)
|
||||
(let
|
||||
((start-expr (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((end-expr (parse-atom)))
|
||||
(do
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((coll (parse-expr)))
|
||||
(list (quote pick-items) coll start-expr end-expr))))))))
|
||||
((and (= typ "keyword") (= val "match"))
|
||||
(do
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
((match-kw "from") nil)
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected of/from after pick match regex at "
|
||||
p))))
|
||||
(let
|
||||
((haystack (parse-expr)))
|
||||
(list (quote pick-match) regex haystack))))))
|
||||
((and (= typ "keyword") (= val "matches"))
|
||||
(do
|
||||
(adv!)
|
||||
(expect-kw! "of")
|
||||
(let
|
||||
((regex (parse-expr)))
|
||||
(do
|
||||
(cond
|
||||
((match-kw "of") nil)
|
||||
((match-kw "from") nil)
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected of/from after pick matches regex at "
|
||||
p))))
|
||||
(let
|
||||
((haystack (parse-expr)))
|
||||
(list (quote pick-matches) regex haystack))))))
|
||||
(true
|
||||
(error
|
||||
(str
|
||||
"Expected first/last/random/items/match/matches after 'pick' at "
|
||||
p)))))))
|
||||
(define
|
||||
parse-go-cmd
|
||||
(fn () (match-kw "to") (list (quote go) (parse-expr))))
|
||||
@@ -1683,7 +1849,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (match-kw "'s") "event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "event"))))
|
||||
((mode (cond ((match-kw "the") (do (match-kw "event") (when (and (= (tp-type) "op") (= (tp-val) "'s")) (adv!)) "the-event")) ((or (match-kw "default") (and (= (tp-val) "default") (do (adv!) true))) "default") ((or (match-kw "bubbling") (and (= (tp-val) "bubbling") (do (adv!) true))) "bubbling") (true "all"))))
|
||||
(list (quote halt!) mode))))
|
||||
(define
|
||||
parse-param-list
|
||||
@@ -1807,7 +1973,7 @@
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (cond ((at-end?) (list (quote sym) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote sym) "me")) (true (parse-expr)))))
|
||||
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
|
||||
(list (quote empty-target) target))))
|
||||
(define
|
||||
parse-swap-cmd
|
||||
@@ -1817,6 +1983,16 @@
|
||||
((lhs (parse-expr)))
|
||||
(match-kw "with")
|
||||
(let ((rhs (parse-expr))) (list (quote swap!) lhs rhs)))))
|
||||
(define
|
||||
parse-morph-cmd
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((target (parse-expr)))
|
||||
(expect-kw! "to")
|
||||
(let
|
||||
((content (parse-expr)))
|
||||
(list (quote morph!) target content)))))
|
||||
(define
|
||||
parse-open-cmd
|
||||
(fn
|
||||
@@ -1874,10 +2050,14 @@
|
||||
(do (adv!) (parse-repeat-cmd)))
|
||||
((and (= typ "keyword") (= val "fetch"))
|
||||
(do (adv!) (parse-fetch-cmd)))
|
||||
((and (= typ "keyword") (= val "get"))
|
||||
(do (adv!) (parse-get-cmd)))
|
||||
((and (= typ "keyword") (= val "call"))
|
||||
(do (adv!) (parse-call-cmd)))
|
||||
((and (= typ "keyword") (= val "take"))
|
||||
(do (adv!) (parse-take-cmd)))
|
||||
((and (= typ "keyword") (= val "pick"))
|
||||
(do (adv!) (parse-pick-cmd)))
|
||||
((and (= typ "keyword") (= val "settle"))
|
||||
(do (adv!) (list (quote settle))))
|
||||
((and (= typ "keyword") (= val "go"))
|
||||
@@ -1918,6 +2098,8 @@
|
||||
(do (adv!) (parse-empty-cmd)))
|
||||
((and (= typ "keyword") (= val "swap"))
|
||||
(do (adv!) (parse-swap-cmd)))
|
||||
((and (= typ "keyword") (= val "morph"))
|
||||
(do (adv!) (parse-morph-cmd)))
|
||||
((and (= typ "keyword") (= val "open"))
|
||||
(do (adv!) (parse-open-cmd)))
|
||||
((and (= typ "keyword") (= val "close"))
|
||||
@@ -1955,6 +2137,7 @@
|
||||
(= v "transition")
|
||||
(= v "repeat")
|
||||
(= v "fetch")
|
||||
(= v "get")
|
||||
(= v "call")
|
||||
(= v "take")
|
||||
(= v "settle")
|
||||
@@ -1977,8 +2160,10 @@
|
||||
(= v "empty")
|
||||
(= v "clear")
|
||||
(= v "swap")
|
||||
(= v "morph")
|
||||
(= v "open")
|
||||
(= v "close"))))
|
||||
(= v "close")
|
||||
(= v "pick"))))
|
||||
(define
|
||||
cl-collect
|
||||
(fn
|
||||
@@ -2047,6 +2232,53 @@
|
||||
((body (parse-cmd-list)))
|
||||
(match-kw "end")
|
||||
(list (quote init) body))))
|
||||
(define
|
||||
parse-live-feat
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
plf-skip
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((at-end?) nil)
|
||||
((and (= (tp-type) "keyword") (or (= (tp-val) "end") (= (tp-val) "on") (= (tp-val) "init") (= (tp-val) "def") (= (tp-val) "behavior") (= (tp-val) "live") (= (tp-val) "when")))
|
||||
nil)
|
||||
(true (do (adv!) (plf-skip))))))
|
||||
(plf-skip)
|
||||
(match-kw "end")
|
||||
(list (quote live-no-op))))
|
||||
(define
|
||||
parse-when-feat
|
||||
(fn
|
||||
()
|
||||
(define
|
||||
pwf-skip
|
||||
(fn
|
||||
()
|
||||
(cond
|
||||
((at-end?) nil)
|
||||
((and (= (tp-type) "keyword") (or (= (tp-val) "end") (= (tp-val) "on") (= (tp-val) "init") (= (tp-val) "def") (= (tp-val) "behavior") (= (tp-val) "live") (= (tp-val) "when")))
|
||||
nil)
|
||||
(true (do (adv!) (pwf-skip))))))
|
||||
(if
|
||||
(or
|
||||
(= (tp-type) "hat")
|
||||
(and (= (tp-type) "keyword") (= (tp-val) "dom")))
|
||||
(let
|
||||
((expr (parse-expr)))
|
||||
(if
|
||||
(match-kw "changes")
|
||||
(let
|
||||
((body (parse-cmd-list)))
|
||||
(do
|
||||
(match-kw "end")
|
||||
(list (quote when-changes) expr body)))
|
||||
(do
|
||||
(pwf-skip)
|
||||
(match-kw "end")
|
||||
(list (quote when-feat-no-op)))))
|
||||
(do (pwf-skip) (match-kw "end") (list (quote when-feat-no-op))))))
|
||||
(define
|
||||
parse-feat
|
||||
(fn
|
||||
@@ -2058,6 +2290,8 @@
|
||||
((= val "init") (do (adv!) (parse-init-feat)))
|
||||
((= val "def") (do (adv!) (parse-def-feat)))
|
||||
((= val "behavior") (do (adv!) (parse-behavior-feat)))
|
||||
((= val "live") (do (adv!) (parse-live-feat)))
|
||||
((= val "when") (do (adv!) (parse-when-feat)))
|
||||
(true (parse-cmd-list))))))
|
||||
(define
|
||||
coll-feats
|
||||
|
||||
@@ -117,6 +117,7 @@
|
||||
"first"
|
||||
"last"
|
||||
"random"
|
||||
"pick"
|
||||
"empty"
|
||||
"clear"
|
||||
"swap"
|
||||
@@ -173,11 +174,17 @@
|
||||
"default"
|
||||
"halt"
|
||||
"precedes"
|
||||
"precede"
|
||||
"follow"
|
||||
"follows"
|
||||
"ignoring"
|
||||
"case"
|
||||
"changes"
|
||||
"focus"
|
||||
"blur"))
|
||||
"blur"
|
||||
"dom"
|
||||
"morph"
|
||||
"using"))
|
||||
|
||||
(define hs-keyword? (fn (word) (some (fn (k) (= k word)) hs-keywords)))
|
||||
|
||||
@@ -472,6 +479,14 @@
|
||||
(hs-advance! 1)
|
||||
(hs-emit! "attr" (read-ident pos) start)
|
||||
(scan!))
|
||||
(and
|
||||
(= ch "^")
|
||||
(< (+ pos 1) src-len)
|
||||
(hs-ident-char? (hs-peek 1)))
|
||||
(do
|
||||
(hs-advance! 1)
|
||||
(hs-emit! "hat" (read-ident pos) start)
|
||||
(scan!))
|
||||
(and
|
||||
(= ch "~")
|
||||
(< (+ pos 1) src-len)
|
||||
|
||||
Reference in New Issue
Block a user