giles
a11d0941e9
Generator changes (tests/playwright/generate-sx-tests.py):
- toHaveCSS regex: balance parens so `'rgb(255, 0, 0)'` is captured intact
(was truncating at first `)`)
- Map browser-computed colors `rgb(R,G,B)` back to CSS keywords
(red/green/blue/black/white) — our DOM mock returns the inline value
- js_val_to_sx now handles object literals `{a: 1, b: {c: 2}}` → `{:a 1 :b {:c 2}}`
- Pattern 2 (`var x = await run(...)`) now captures locals via balanced-brace
scan and emits `eval-hs-locals` instead of `eval-hs`
- Pattern 1 with locals: emit `eval-hs-locals` (was wrapping in `let`, which
doesn't reach the inner HS env)
- Stop collapsing `\"` → `"` in raw HTML (line 218): the backslash escapes
are legitimate in single-quoted `_='...'` HS attribute values containing
nested HS scripts
Test-framework changes (regenerated into spec/tests/test-hyperscript-behavioral.sx):
- `_hs-wrap-body`: returns expression value if non-nil, else `it`. Lets bare
expressions (`foo.foo`) and `it`-mutating scripts (`pick first 3 of arr;
set $test to it`) both round-trip through the same wrapper
- `eval-hs-locals` now injects locals via `(let ((name (quote val)) ...) sx)`
rather than `apply handler (cons nil vals)` — works around a JIT loop on
some compiled forms (e.g. `bar.doh of foo` with undefined `bar`)
Also synced lib/hyperscript/*.sx → shared/static/wasm/sx/hs-*.sx (the WASM
test runner reads from the wasm/sx/ copies).
Net per-cluster pass counts (vs prior baseline):
- put: 23 → 29 (+6)
- set: 21 → 28 (+7)
- show: 7 → 15 (+8)
- expressions/propertyAccess: 3 → 9 (+6)
- expressions/possessiveExpression: 17 → 18 (+1)
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2504 lines
100 KiB
Plaintext
2504 lines
100 KiB
Plaintext
;; _hyperscript parser — token stream → SX AST
|
|
;;
|
|
;; Input: list of {:type T :value V :pos P} tokens from hs-tokenize
|
|
;; Output: SX AST forms that map to runtime primitives
|
|
|
|
;; ── Parser entry point ────────────────────────────────────────────
|
|
(define
|
|
hs-parse
|
|
(fn
|
|
(tokens src)
|
|
(let
|
|
((p 0) (tok-len (len tokens)))
|
|
(define tp (fn () (if (< p tok-len) (nth tokens p) nil)))
|
|
(define
|
|
tp-type
|
|
(fn () (let ((t (tp))) (if t (get t "type") "eof"))))
|
|
(define
|
|
tp-val
|
|
(fn () (let ((t (tp))) (if t (get t "value") nil))))
|
|
(define
|
|
adv!
|
|
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
|
|
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
|
|
(define
|
|
match-kw
|
|
(fn
|
|
(kw)
|
|
(if
|
|
(and (= (tp-type) "keyword") (= (tp-val) kw))
|
|
(do (adv!) true)
|
|
nil)))
|
|
(define
|
|
expect-kw!
|
|
(fn
|
|
(kw)
|
|
(if
|
|
(match-kw kw)
|
|
true
|
|
(error (str "Expected '" kw "' at position " p)))))
|
|
(define
|
|
parse-dur
|
|
(fn
|
|
(val)
|
|
(let
|
|
((slen (len val)))
|
|
(cond
|
|
((and (>= slen 3) (= (substring val (- slen 2) slen) "ms"))
|
|
(parse-number (substring val 0 (- slen 2))))
|
|
((and (>= slen 2) (= (nth val (- slen 1)) "s"))
|
|
(* 1000 (parse-number (substring val 0 (- slen 1)))))
|
|
(true (parse-number val))))))
|
|
(define
|
|
parse-poss-tail
|
|
(fn
|
|
(owner)
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(cond
|
|
((or (= typ "ident") (= typ "keyword"))
|
|
(do (adv!) (parse-prop-chain (list (quote .) 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))))
|
|
((= typ "style") (do (adv!) (list (quote style) val owner)))
|
|
(true owner)))))
|
|
(define
|
|
parse-prop-chain
|
|
(fn
|
|
(base)
|
|
(if
|
|
(and (= (tp-type) "class") (not (at-end?)))
|
|
(let
|
|
((prop (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(parse-prop-chain (list (make-symbol ".") base prop))))
|
|
(if
|
|
(= (tp-type) "paren-open")
|
|
(let
|
|
((args (parse-call-args)))
|
|
(parse-prop-chain (list (quote method-call) base args)))
|
|
base))))
|
|
(define
|
|
parse-trav
|
|
(fn
|
|
(kind)
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(cond
|
|
((= typ "selector")
|
|
(do (adv!) (list kind val (list (quote me)))))
|
|
((= typ "class")
|
|
(do (adv!) (list kind (str "." val) (list (quote me)))))
|
|
((= typ "id")
|
|
(do (adv!) (list kind (str "#" val) (list (quote me)))))
|
|
((= typ "attr")
|
|
(do
|
|
(adv!)
|
|
(list
|
|
(quote attr)
|
|
val
|
|
(list kind (str "[" val "]") (list (quote me))))))
|
|
(true (list kind "*" (list (quote me))))))))
|
|
(define
|
|
parse-pos-kw
|
|
(fn
|
|
(kind)
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(let
|
|
((sel (cond ((= typ "selector") (do (adv!) val)) ((= typ "class") (do (adv!) (str "." val))) ((= typ "id") (do (adv!) (str "#" val))) (true "*"))))
|
|
(if
|
|
(match-kw "in")
|
|
(list kind sel (parse-expr))
|
|
(list kind sel))))))
|
|
(define
|
|
parse-atom
|
|
(fn
|
|
()
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(cond
|
|
((= typ "number") (do (adv!) (parse-dur val)))
|
|
((= typ "string") (do (adv!) val))
|
|
((= typ "template") (do (adv!) (list (quote template) val)))
|
|
((and (= typ "keyword") (= val "true")) (do (adv!) true))
|
|
((and (= typ "keyword") (= val "false")) (do (adv!) false))
|
|
((and (= typ "keyword") (or (= val "null") (= val "nil")))
|
|
(do (adv!) (list (quote null-literal))))
|
|
((and (= typ "keyword") (= val "undefined"))
|
|
(do (adv!) (list (quote null-literal))))
|
|
((and (= typ "keyword") (= val "beep"))
|
|
(do
|
|
(adv!)
|
|
(when (and (= (tp-type) "op") (= (tp-val) "!")) (adv!))
|
|
(list (quote beep!) (parse-expr))))
|
|
((and (= typ "keyword") (= val "not"))
|
|
(do (adv!) (list (quote not) (parse-expr))))
|
|
((and (= typ "keyword") (= val "no"))
|
|
(do (adv!) (list (quote no) (parse-expr))))
|
|
((and (= typ "keyword") (= val "eval"))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(= (tp-type) "paren-open")
|
|
(list (quote sx-eval) (collect-sx-source))
|
|
(list (quote sx-eval) (parse-expr)))))
|
|
((and (= typ "keyword") (= val "the"))
|
|
(do (adv!) (parse-the-expr)))
|
|
((and (= typ "keyword") (= val "me"))
|
|
(do (adv!) (list (quote me))))
|
|
((and (= typ "keyword") (= val "I"))
|
|
(do (adv!) (list (quote me))))
|
|
((and (= typ "keyword") (= val "it"))
|
|
(do (adv!) (list (quote it))))
|
|
((and (= typ "keyword") (= val "result"))
|
|
(do (adv!) (quote the-result)))
|
|
((and (= typ "keyword") (= val "event"))
|
|
(do (adv!) (list (quote event))))
|
|
((and (= typ "keyword") (= val "target"))
|
|
(do
|
|
(adv!)
|
|
(list (make-symbol ".") (list (quote event)) "target")))
|
|
((and (= typ "keyword") (= val "detail"))
|
|
(do
|
|
(adv!)
|
|
(list (make-symbol ".") (list (quote event)) "detail")))
|
|
((and (= typ "keyword") (or (= val "my") (= val "your")))
|
|
(do (adv!) (parse-poss-tail (list (quote me)))))
|
|
((and (= typ "keyword") (= val "its"))
|
|
(do (adv!) (parse-poss-tail (list (quote it)))))
|
|
((and (= typ "keyword") (= val "closest"))
|
|
(do (adv!) (parse-trav (quote closest))))
|
|
((and (= typ "keyword") (= val "next"))
|
|
(do (adv!) (parse-trav (quote next))))
|
|
((and (= typ "keyword") (= val "previous"))
|
|
(do (adv!) (parse-trav (quote previous))))
|
|
((and (= typ "keyword") (= val "first"))
|
|
(do (adv!) (parse-pos-kw (quote first))))
|
|
((and (= typ "keyword") (= val "last"))
|
|
(do (adv!) (parse-pos-kw (quote last))))
|
|
((= typ "id")
|
|
(do (adv!) (list (quote query) (str "#" val))))
|
|
((= typ "selector")
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(and (= (tp-type) "keyword") (= (tp-val) "in"))
|
|
(do
|
|
(adv!)
|
|
(list
|
|
(quote query-scoped)
|
|
val
|
|
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
|
(list (quote query) val))))
|
|
((= typ "attr")
|
|
(do (adv!) (list (quote attr) val (list (quote me)))))
|
|
((= 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)))
|
|
((= typ "paren-open")
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((expr (parse-expr)))
|
|
(if (= (tp-type) "paren-close") (adv!) nil)
|
|
expr)))
|
|
((= typ "brace-open")
|
|
(do
|
|
(adv!)
|
|
(define
|
|
obj-collect
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(or (at-end?) (= (tp-type) "brace-close"))
|
|
(do (when (= (tp-type) "brace-close") (adv!)) acc)
|
|
(let
|
|
((key (cond ((= (tp-type) "string") (let ((k (tp-val))) (do (adv!) k))) (true (let ((k (tp-val))) (do (adv!) k))))))
|
|
(let
|
|
((value (cond ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (cond ((= v "true") true) ((= v "false") false) ((= v "null") nil) (true (list (quote ref) v)))))) ((= (tp-type) "colon") (do (adv!) (parse-expr))) (true (parse-expr)))))
|
|
(do
|
|
(when (= (tp-type) "comma") (adv!))
|
|
(obj-collect (cons (list key value) acc))))))))
|
|
(list (quote object-literal) (obj-collect (list)))))
|
|
((and (= typ "op") (= val "\\"))
|
|
(do
|
|
(adv!)
|
|
(define
|
|
bl-params
|
|
(fn
|
|
(acc)
|
|
(cond
|
|
((and (= (tp-type) "op") (= (tp-val) "-"))
|
|
(if
|
|
(and
|
|
(< (+ p 1) (len tokens))
|
|
(= (get (nth tokens (+ p 1)) "value") ">"))
|
|
(do (adv!) (adv!) acc)
|
|
acc))
|
|
((= (tp-type) "ident")
|
|
(let
|
|
((name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(when (= (tp-type) "comma") (adv!))
|
|
(bl-params (append acc name)))))
|
|
(true acc))))
|
|
(let
|
|
((params (bl-params (list))))
|
|
(list (quote block-literal) params (parse-expr)))))
|
|
((= typ "bracket-open") (do (adv!) (parse-array-lit)))
|
|
((and (= typ "op") (= val "-"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((operand (parse-atom)))
|
|
(list (quote -) 0 operand))))
|
|
((= typ "component")
|
|
(do (adv!) (list (quote component) val)))
|
|
((and (= typ "keyword") (= val "some"))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(and
|
|
(= (tp-type) "ident")
|
|
(> (len tokens) (+ p 1))
|
|
(= (get (nth tokens (+ p 1)) "value") "in"))
|
|
(let
|
|
((var-name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(match-kw "in")
|
|
(let
|
|
((collection (parse-expr)))
|
|
(do
|
|
(match-kw "with")
|
|
(list
|
|
(quote some)
|
|
var-name
|
|
collection
|
|
(parse-expr))))))
|
|
(list (quote not) (list (quote no) (parse-expr))))))
|
|
((and (= typ "keyword") (= val "every"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((var-name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(match-kw "in")
|
|
(let
|
|
((collection (parse-expr)))
|
|
(do
|
|
(match-kw "with")
|
|
(list
|
|
(quote every)
|
|
var-name
|
|
collection
|
|
(parse-expr))))))))
|
|
((and (= typ "keyword") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "paren-open"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((name val) (args (parse-call-args)))
|
|
(cons (quote call) (cons (list (quote ref) name) args)))))
|
|
(true nil)))))
|
|
(define
|
|
parse-poss
|
|
(fn
|
|
(obj)
|
|
(cond
|
|
((and (= (tp-type) "op") (= (tp-val) "'s"))
|
|
(do (adv!) (parse-poss-tail obj)))
|
|
((= (tp-type) "class") (parse-prop-chain obj))
|
|
((= (tp-type) "paren-open")
|
|
(let
|
|
((args (parse-call-args)))
|
|
(cons (quote call) (cons obj args))))
|
|
((= (tp-type) "bracket-open")
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(and (= (tp-type) "op") (= (tp-val) ".."))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((end-expr (parse-expr)))
|
|
(when (= (tp-type) "bracket-close") (adv!))
|
|
(parse-poss
|
|
(list (quote array-slice) obj nil end-expr))))
|
|
(let
|
|
((start-expr (parse-expr)))
|
|
(if
|
|
(and (= (tp-type) "op") (= (tp-val) ".."))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(= (tp-type) "bracket-close")
|
|
(do
|
|
(adv!)
|
|
(parse-poss
|
|
(list (quote array-slice) obj start-expr nil)))
|
|
(let
|
|
((end-expr (parse-expr)))
|
|
(when (= (tp-type) "bracket-close") (adv!))
|
|
(parse-poss
|
|
(list
|
|
(quote array-slice)
|
|
obj
|
|
start-expr
|
|
end-expr)))))
|
|
(do
|
|
(when (= (tp-type) "bracket-close") (adv!))
|
|
(parse-poss
|
|
(list (quote array-index) obj start-expr))))))))
|
|
(true obj))))
|
|
(define
|
|
parse-cmp
|
|
(fn
|
|
(left)
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(cond
|
|
((and (= typ "op") (or (= val "==") (= val "!=") (= val "<") (= val ">") (= val "<=") (= val ">=") (= val "===") (= val "!==")))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((right (parse-expr)))
|
|
(cond
|
|
((= val "==") (list (quote =) left right))
|
|
((= val "===") (list (quote strict-eq) left right))
|
|
((= val "!==")
|
|
(list
|
|
(quote not)
|
|
(list (quote strict-eq) left right)))
|
|
(true (list val left right))))))
|
|
((and (= typ "keyword") (= val "is"))
|
|
(do
|
|
(adv!)
|
|
(cond
|
|
((match-kw "not")
|
|
(cond
|
|
((match-kw "empty")
|
|
(list (quote not) (list (quote empty?) left)))
|
|
((match-kw "in")
|
|
(list (quote not-in?) left (parse-expr)))
|
|
((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))))))
|
|
((match-kw "really")
|
|
(do
|
|
(match-kw "equal")
|
|
(match-kw "to")
|
|
(list
|
|
(quote not)
|
|
(list (quote strict-eq) left (parse-expr)))))
|
|
((match-kw "equal")
|
|
(do
|
|
(match-kw "to")
|
|
(list
|
|
(quote not)
|
|
(list (quote =) left (parse-expr)))))
|
|
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
|
(let
|
|
((type-name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((strict (and (= (tp-type) "op") (= (tp-val) "!"))))
|
|
(when strict (adv!))
|
|
(if
|
|
strict
|
|
(list
|
|
(quote not)
|
|
(list
|
|
(quote type-check-strict)
|
|
left
|
|
type-name))
|
|
(list
|
|
(quote not)
|
|
(list (quote type-check) left type-name)))))))
|
|
(true
|
|
(let
|
|
((right (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
|
(if
|
|
(match-kw "ignoring")
|
|
(do
|
|
(match-kw "case")
|
|
(list
|
|
(quote not)
|
|
(list (quote eq-ignore-case) left right)))
|
|
(list (quote not) (list (quote =) left right)))))))
|
|
((match-kw "empty") (list (quote empty?) left))
|
|
((match-kw "less")
|
|
(do
|
|
(match-kw "than")
|
|
(if
|
|
(match-kw "or")
|
|
(do
|
|
(match-kw "equal")
|
|
(match-kw "to")
|
|
(list (quote <=) left (parse-expr)))
|
|
(list (quote <) left (parse-expr)))))
|
|
((match-kw "greater")
|
|
(do
|
|
(match-kw "than")
|
|
(if
|
|
(match-kw "or")
|
|
(do
|
|
(match-kw "equal")
|
|
(match-kw "to")
|
|
(list (quote >=) left (parse-expr)))
|
|
(list (quote >) left (parse-expr)))))
|
|
((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)))))
|
|
((match-kw "in") (list (quote in?) left (parse-expr)))
|
|
((match-kw "really")
|
|
(do
|
|
(match-kw "equal")
|
|
(match-kw "to")
|
|
(list (quote strict-eq) left (parse-expr))))
|
|
((match-kw "equal")
|
|
(do
|
|
(match-kw "to")
|
|
(list (quote =) left (parse-expr))))
|
|
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
|
(let
|
|
((type-name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((strict (and (= (tp-type) "op") (= (tp-val) "!"))))
|
|
(when strict (adv!))
|
|
(if
|
|
strict
|
|
(list (quote type-check-strict) left type-name)
|
|
(list (quote type-check) left type-name))))))
|
|
(true
|
|
(let
|
|
((right (parse-expr)))
|
|
(if
|
|
(match-kw "ignoring")
|
|
(do
|
|
(match-kw "case")
|
|
(list (quote eq-ignore-case) left right))
|
|
(if
|
|
(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
|
|
(adv!)
|
|
(cond
|
|
((match-kw "not")
|
|
(cond
|
|
((match-kw "in")
|
|
(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))))))
|
|
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
|
(let
|
|
((type-name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(list
|
|
(quote not)
|
|
(list (quote type-check) left type-name)))))
|
|
(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)))))
|
|
((or (and (or (= (tp-val) "a") (= (tp-val) "an")) (do (adv!) true)))
|
|
(let
|
|
((type-name (tp-val)))
|
|
(do (adv!) (list (quote type-check) left type-name))))
|
|
(true
|
|
(let
|
|
((right (parse-expr)))
|
|
(list (quote =) left right))))))
|
|
((and (= typ "keyword") (= val "exists"))
|
|
(do (adv!) (list (quote exists?) left)))
|
|
((and (or (= typ "keyword") (= typ "ident")) (= val "starts"))
|
|
(do
|
|
(adv!)
|
|
(match-kw "with")
|
|
(let
|
|
((rhs (parse-atom)))
|
|
(if
|
|
(match-kw "ignoring")
|
|
(do
|
|
(match-kw "case")
|
|
(list (quote starts-with-ic?) left rhs))
|
|
(list (quote starts-with?) left rhs)))))
|
|
((and (or (= typ "keyword") (= typ "ident")) (= val "ends"))
|
|
(do
|
|
(adv!)
|
|
(match-kw "with")
|
|
(let
|
|
((rhs (parse-atom)))
|
|
(if
|
|
(match-kw "ignoring")
|
|
(do
|
|
(match-kw "case")
|
|
(list (quote ends-with-ic?) left rhs))
|
|
(list (quote ends-with?) left rhs)))))
|
|
((and (= typ "keyword") (or (= val "matches") (= val "match")))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((right (parse-expr)))
|
|
(if
|
|
(match-kw "ignoring")
|
|
(do
|
|
(match-kw "case")
|
|
(list (quote matches-ignore-case?) left right))
|
|
(list (quote matches?) left right)))))
|
|
((and (= typ "keyword") (= val "contains"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((right (parse-expr)))
|
|
(if
|
|
(match-kw "ignoring")
|
|
(do
|
|
(match-kw "case")
|
|
(list (quote contains-ignore-case?) left right))
|
|
(list (quote contains?) left right)))))
|
|
((and (= typ "keyword") (= val "as"))
|
|
(do
|
|
(adv!)
|
|
(when (or (= (tp-val) "a") (= (tp-val) "an")) (adv!))
|
|
(let
|
|
((type-name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(and (= (tp-type) "colon") (not (at-end?)))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((param (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(list
|
|
(quote as)
|
|
left
|
|
(str type-name ":" param)))))
|
|
(let
|
|
loop
|
|
((result (list (quote as) left type-name)))
|
|
(if
|
|
(and (= (tp-type) "op") (= (tp-val) "|"))
|
|
(do
|
|
(adv!)
|
|
(when
|
|
(or (= (tp-val) "a") (= (tp-val) "an"))
|
|
(adv!))
|
|
(let
|
|
((next-type (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(loop (list (quote as) result next-type)))))
|
|
result)))))))
|
|
((and (= typ "colon"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((type-name (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((strict (and (= (tp-type) "op") (= (tp-val) "!"))))
|
|
(when strict (adv!))
|
|
(if
|
|
strict
|
|
(list (quote type-check-strict) left type-name)
|
|
(list (quote type-check) left type-name)))))))
|
|
((and (= typ "keyword") (= val "of"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((target (parse-expr)))
|
|
(if
|
|
(and (list? left) (= (first left) (quote ref)))
|
|
(list (make-symbol ".") target (nth left 1))
|
|
(list (quote of) left target)))))
|
|
((and (= typ "keyword") (= val "in"))
|
|
(do (adv!) (list (quote in?) left (parse-expr))))
|
|
((and (= typ "keyword") (= val "does"))
|
|
(do
|
|
(adv!)
|
|
(match-kw "not")
|
|
(cond
|
|
((match-kw "exist")
|
|
(list (quote not) (list (quote exists?) left)))
|
|
((match-kw "match")
|
|
(list
|
|
(quote not)
|
|
(list (quote matches?) left (parse-expr))))
|
|
((or (match-kw "contain") (match-kw "contains"))
|
|
(list
|
|
(quote not)
|
|
(list (quote contains?) left (parse-expr))))
|
|
((or (match-kw "include") (match-kw "includes"))
|
|
(list
|
|
(quote not)
|
|
(list (quote contains?) left (parse-expr))))
|
|
((match-kw "start")
|
|
(do
|
|
(match-kw "with")
|
|
(list
|
|
(quote not)
|
|
(list (quote starts-with?) left (parse-expr)))))
|
|
((match-kw "end")
|
|
(do
|
|
(match-kw "with")
|
|
(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))))
|
|
((and (= typ "keyword") (= val "really"))
|
|
(do
|
|
(adv!)
|
|
(match-kw "equals")
|
|
(list (quote strict-eq) left (parse-expr))))
|
|
((and (= typ "keyword") (or (= val "contain") (= val "include") (= val "includes")))
|
|
(do (adv!) (list (quote contains?) left (parse-expr))))
|
|
((and (= typ "keyword") (or (= val "precedes") (= val "precede")))
|
|
(do (adv!) (list (quote precedes?) left (parse-atom))))
|
|
((and (= typ "keyword") (= val "follows"))
|
|
(do (adv!) (list (quote follows?) left (parse-atom))))
|
|
(true left)))))
|
|
(define
|
|
parse-collection
|
|
(fn
|
|
(left)
|
|
(cond
|
|
((match-kw "where")
|
|
(let
|
|
((cond-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
|
(parse-collection (list (quote coll-where) left cond-expr))))
|
|
((match-kw "sorted")
|
|
(do
|
|
(match-kw "by")
|
|
(let
|
|
((key-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
|
(let
|
|
((desc (match-kw "descending")))
|
|
(when (not desc) (match-kw "ascending"))
|
|
(parse-collection
|
|
(if
|
|
desc
|
|
(list (quote coll-sorted-desc) left key-expr)
|
|
(list (quote coll-sorted) left key-expr)))))))
|
|
((match-kw "mapped")
|
|
(do
|
|
(match-kw "to")
|
|
(let
|
|
((map-expr (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
|
(parse-collection (list (quote coll-mapped) left map-expr)))))
|
|
((match-kw "split")
|
|
(do
|
|
(match-kw "by")
|
|
(let
|
|
((sep (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
|
(parse-collection (list (quote coll-split) left sep)))))
|
|
((match-kw "joined")
|
|
(do
|
|
(match-kw "by")
|
|
(let
|
|
((sep (parse-cmp (parse-arith (parse-poss (parse-atom))))))
|
|
(parse-collection (list (quote coll-joined) left sep)))))
|
|
(true left))))
|
|
(define
|
|
parse-logical
|
|
(fn
|
|
(left)
|
|
(cond
|
|
((match-kw "and")
|
|
(let
|
|
((right (parse-collection (parse-cmp (parse-arith (parse-poss (parse-atom)))))))
|
|
(parse-logical (list (quote and) left right))))
|
|
((match-kw "or")
|
|
(let
|
|
((right (parse-collection (parse-cmp (parse-arith (parse-poss (parse-atom)))))))
|
|
(parse-logical (list (quote or) left right))))
|
|
(true left))))
|
|
(define
|
|
parse-expr
|
|
(fn
|
|
()
|
|
(let
|
|
((left (parse-atom)))
|
|
(if
|
|
(nil? left)
|
|
nil
|
|
(do
|
|
(when
|
|
(and
|
|
(number? left)
|
|
(= (tp-type) "ident")
|
|
(not
|
|
(or
|
|
(= (tp-val) "starts")
|
|
(= (tp-val) "ends")
|
|
(= (tp-val) "contains")
|
|
(or (= (tp-val) "matches") (= (tp-val) "match"))
|
|
(= (tp-val) "is")
|
|
(= (tp-val) "does")
|
|
(= (tp-val) "in")
|
|
(= (tp-val) "precedes")
|
|
(= (tp-val) "follows"))))
|
|
(let
|
|
((unit (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(set! left (list (quote string-postfix) left unit)))))
|
|
(let
|
|
((l2 (parse-poss left)))
|
|
(let
|
|
((l3 (parse-arith l2)))
|
|
(let
|
|
((l4 (parse-cmp l3)))
|
|
(let
|
|
((l5 (parse-collection l4)))
|
|
(let
|
|
((result (parse-logical l5)))
|
|
(if
|
|
(and
|
|
result
|
|
(or
|
|
(and
|
|
(= (tp-type) "ident")
|
|
(not
|
|
(or
|
|
(= (tp-val) "then")
|
|
(= (tp-val) "end")
|
|
(= (tp-val) "else")
|
|
(= (tp-val) "otherwise"))))
|
|
(and (= (tp-type) "op") (= (tp-val) "%"))))
|
|
(let
|
|
((unit (tp-val)))
|
|
(do
|
|
(adv!)
|
|
(list (quote string-postfix) result unit)))
|
|
result)))))))))))
|
|
(define
|
|
parse-tgt-kw
|
|
(fn (kw default) (if (match-kw kw) (parse-expr) default)))
|
|
(define
|
|
parse-add-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((= (tp-type) "class")
|
|
(let
|
|
((cls (get (adv!) "value")) (extra-classes (list)))
|
|
(define
|
|
collect-classes!
|
|
(fn
|
|
()
|
|
(when
|
|
(= (tp-type) "class")
|
|
(set!
|
|
extra-classes
|
|
(append extra-classes (list (get (adv!) "value"))))
|
|
(collect-classes!))))
|
|
(collect-classes!)
|
|
(let
|
|
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
|
(let
|
|
((when-clause (if (match-kw "when") (parse-expr) nil)))
|
|
(if
|
|
(empty? extra-classes)
|
|
(if
|
|
when-clause
|
|
(list (quote add-class-when) cls tgt when-clause)
|
|
(list (quote add-class) cls tgt))
|
|
(if
|
|
when-clause
|
|
(list
|
|
(quote multi-add-class-when)
|
|
tgt
|
|
when-clause
|
|
cls
|
|
extra-classes)
|
|
(cons
|
|
(quote multi-add-class)
|
|
(cons tgt (cons cls extra-classes)))))))))
|
|
((= (tp-type) "style")
|
|
(let
|
|
((prop (get (adv!) "value"))
|
|
(value
|
|
(if
|
|
(= (tp-type) "local")
|
|
(get (adv!) "value")
|
|
(parse-expr))))
|
|
(let
|
|
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
|
(list (quote set-style) prop value tgt))))
|
|
((= (tp-type) "brace-open")
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((pairs (list)))
|
|
(define
|
|
collect-pairs!
|
|
(fn
|
|
()
|
|
(when
|
|
(and
|
|
(not (= (tp-type) "brace-close"))
|
|
(not (at-end?)))
|
|
(let
|
|
((prop (get (adv!) "value")))
|
|
(when (= (tp-type) "colon") (adv!))
|
|
(let
|
|
((val (tp-val)))
|
|
(adv!)
|
|
(set! pairs (cons (list prop val) pairs))
|
|
(collect-pairs!))))))
|
|
(collect-pairs!)
|
|
(when (= (tp-type) "brace-close") (adv!))
|
|
(let
|
|
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
|
|
(list (quote set-styles) (reverse pairs) tgt)))))
|
|
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((attr-name (get (adv!) "value")))
|
|
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
|
(let
|
|
((attr-val (parse-expr)))
|
|
(when (= (tp-type) "bracket-close") (adv!))
|
|
(let
|
|
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
|
(list (quote add-attr) attr-name attr-val tgt))))))
|
|
(true
|
|
(let
|
|
((value (parse-expr)))
|
|
(if
|
|
(match-kw "to")
|
|
(let
|
|
((tgt (parse-expr)))
|
|
(list (quote add-value) value tgt))
|
|
nil))))))
|
|
(define
|
|
parse-remove-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((= (tp-type) "class")
|
|
(let
|
|
((cls (get (adv!) "value")) (extra-classes (list)))
|
|
(define
|
|
collect-classes!
|
|
(fn
|
|
()
|
|
(when
|
|
(= (tp-type) "class")
|
|
(set!
|
|
extra-classes
|
|
(append extra-classes (list (get (adv!) "value"))))
|
|
(collect-classes!))))
|
|
(collect-classes!)
|
|
(let
|
|
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
|
|
(if
|
|
(empty? extra-classes)
|
|
(list (quote remove-class) cls tgt)
|
|
(cons
|
|
(quote multi-remove-class)
|
|
(cons tgt (cons cls extra-classes)))))))
|
|
((and (= (tp-type) "bracket-open") (= (tp-val) "["))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(= (tp-type) "attr")
|
|
(let
|
|
((attr-name (get (adv!) "value")))
|
|
(match-kw "]")
|
|
(let
|
|
((tgt (if (match-kw "from") (parse-expr) nil)))
|
|
(list (quote remove-attr) attr-name tgt)))
|
|
nil)))
|
|
((= (tp-val) "{")
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((props (list)))
|
|
(define
|
|
collect-props!
|
|
(fn
|
|
()
|
|
(when
|
|
(not (= (tp-val) "}"))
|
|
(when (= (tp-val) ";") (adv!))
|
|
(when
|
|
(not (= (tp-val) "}"))
|
|
(set!
|
|
props
|
|
(append props (list (get (adv!) "value"))))
|
|
(collect-props!)))))
|
|
(collect-props!)
|
|
(match-kw "}")
|
|
(let
|
|
((tgt (if (match-kw "from") (parse-expr) nil)))
|
|
(list (quote remove-css) props tgt)))))
|
|
(true
|
|
(let
|
|
((value (parse-expr)))
|
|
(if
|
|
(match-kw "from")
|
|
(let
|
|
((tgt (parse-expr)))
|
|
(list (quote remove-value) value tgt))
|
|
(list (quote remove-element) value)))))))
|
|
(define
|
|
parse-toggle-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((match-kw "between")
|
|
(cond
|
|
((= (tp-type) "class")
|
|
(let
|
|
((cls1 (do (let ((v (tp-val))) (adv!) v))))
|
|
(expect-kw! "and")
|
|
(if
|
|
(= (tp-type) "class")
|
|
(let
|
|
((cls2 (do (let ((v (tp-val))) (adv!) v))))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-between) cls1 cls2 tgt)))
|
|
nil)))
|
|
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((n1 (get (adv!) "value")))
|
|
(when
|
|
(and (= (tp-type) "op") (= (tp-val) "="))
|
|
(adv!))
|
|
(let
|
|
((v1 (parse-expr)))
|
|
(when (= (tp-type) "bracket-close") (adv!))
|
|
(expect-kw! "and")
|
|
(when (= (tp-type) "bracket-open") (adv!))
|
|
(let
|
|
((n2 (get (adv!) "value")))
|
|
(when
|
|
(and (= (tp-type) "op") (= (tp-val) "="))
|
|
(adv!))
|
|
(let
|
|
((v2 (parse-expr)))
|
|
(when (= (tp-type) "bracket-close") (adv!))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(if
|
|
(= n1 n2)
|
|
(list
|
|
(quote toggle-attr-between)
|
|
n1
|
|
v1
|
|
v2
|
|
tgt)
|
|
(list
|
|
(quote toggle-attr-diff)
|
|
n1
|
|
v1
|
|
n2
|
|
v2
|
|
tgt)))))))))
|
|
(true nil)))
|
|
((= (tp-type) "class")
|
|
(let
|
|
((cls (do (let ((v (tp-val))) (adv!) v))))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(if
|
|
(match-kw "for")
|
|
(let
|
|
((dur (parse-expr)))
|
|
(list (quote toggle-class-for) cls tgt dur))
|
|
(list (quote toggle-class) cls tgt)))))
|
|
((= (tp-type) "style")
|
|
(let
|
|
((prop (get (adv!) "value")))
|
|
(let
|
|
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
|
|
(if
|
|
(match-kw "between")
|
|
(let
|
|
((val1 (parse-atom)))
|
|
(do
|
|
(when (= (tp-type) "comma") (adv!))
|
|
(if
|
|
(and (= (tp-type) "keyword") (= (tp-val) "and"))
|
|
(adv!)
|
|
nil)
|
|
(let
|
|
((val2 (parse-atom)))
|
|
(if
|
|
(or
|
|
(= (tp-type) "comma")
|
|
(and
|
|
(= (tp-type) "keyword")
|
|
(= (tp-val) "and")))
|
|
(do
|
|
(when (= (tp-type) "comma") (adv!))
|
|
(if
|
|
(and
|
|
(= (tp-type) "keyword")
|
|
(= (tp-val) "and"))
|
|
(adv!)
|
|
nil)
|
|
(let
|
|
((val3 (parse-atom)))
|
|
(if
|
|
(or
|
|
(= (tp-type) "comma")
|
|
(and
|
|
(= (tp-type) "keyword")
|
|
(= (tp-val) "and")))
|
|
(do
|
|
(when (= (tp-type) "comma") (adv!))
|
|
(if
|
|
(and
|
|
(= (tp-type) "keyword")
|
|
(= (tp-val) "and"))
|
|
(adv!)
|
|
nil)
|
|
(let
|
|
((val4 (parse-atom)))
|
|
(list
|
|
(quote toggle-style-cycle)
|
|
prop
|
|
tgt
|
|
val1
|
|
val2
|
|
val3
|
|
val4)))
|
|
(list
|
|
(quote toggle-style-cycle)
|
|
prop
|
|
tgt
|
|
val1
|
|
val2
|
|
val3))))
|
|
(list
|
|
(quote toggle-style-between)
|
|
prop
|
|
val1
|
|
val2
|
|
tgt)))))
|
|
(list (quote toggle-style) prop tgt)))))
|
|
((= (tp-type) "attr")
|
|
(let
|
|
((attr-name (get (adv!) "value")))
|
|
(let
|
|
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
|
|
(if
|
|
(match-kw "between")
|
|
(let
|
|
((val1 (parse-expr)))
|
|
(expect-kw! "and")
|
|
(let
|
|
((val2 (parse-expr)))
|
|
(list
|
|
(quote toggle-attr-between)
|
|
attr-name
|
|
val1
|
|
val2
|
|
tgt)))
|
|
(list (quote toggle-attr) attr-name tgt)))))
|
|
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((attr-name (get (adv!) "value")))
|
|
(when (and (= (tp-type) "op") (= (tp-val) "=")) (adv!))
|
|
(let
|
|
((attr-val (parse-expr)))
|
|
(when (= (tp-type) "bracket-close") (adv!))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
|
|
((and (= (tp-type) "keyword") (= (tp-val) "my"))
|
|
(do
|
|
(adv!)
|
|
(cond
|
|
((= (tp-type) "style")
|
|
(let
|
|
((prop (get (adv!) "value")))
|
|
(if
|
|
(match-kw "between")
|
|
(let
|
|
((val1 (parse-expr)))
|
|
(expect-kw! "and")
|
|
(let
|
|
((val2 (parse-expr)))
|
|
(let
|
|
((tgt (if (match-kw "on") (parse-expr) nil)))
|
|
(list
|
|
(quote toggle-style-between)
|
|
prop
|
|
val1
|
|
val2
|
|
tgt))))
|
|
(let
|
|
((tgt (if (match-kw "on") (parse-expr) nil)))
|
|
(list (quote toggle-style) prop tgt)))))
|
|
((= (tp-type) "attr")
|
|
(let
|
|
((attr-name (get (adv!) "value")))
|
|
(let
|
|
((tgt (if (match-kw "on") (parse-expr) nil)))
|
|
(list (quote toggle-attr) attr-name tgt))))
|
|
(true nil))))
|
|
((and (= (tp-type) "keyword") (= (tp-val) "the"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((expr (parse-the-expr)))
|
|
(cond
|
|
((and (list? expr) (= (first expr) (quote style)))
|
|
(let
|
|
((prop (nth expr 1)) (tgt (nth expr 2)))
|
|
(if
|
|
(match-kw "between")
|
|
(let
|
|
((val1 (parse-expr)))
|
|
(expect-kw! "and")
|
|
(let
|
|
((val2 (parse-expr)))
|
|
(list
|
|
(quote toggle-style-between)
|
|
prop
|
|
val1
|
|
val2
|
|
tgt)))
|
|
(list (quote toggle-style) prop tgt))))
|
|
((and (list? expr) (= (first expr) (quote attr)))
|
|
(let
|
|
((attr-name (nth expr 1)) (tgt (nth expr 2)))
|
|
(list (quote toggle-attr) attr-name tgt)))
|
|
((and (list? expr) (= (first expr) (quote has-class?)))
|
|
(let
|
|
((tgt (nth expr 1)) (cls (nth expr 2)))
|
|
(list (quote toggle-class) cls tgt)))
|
|
(true nil)))))
|
|
(true nil))))
|
|
(define
|
|
parse-set-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (parse-expr)))
|
|
(cond
|
|
((match-kw "to")
|
|
(let ((value (parse-expr))) (list (quote set!) tgt value)))
|
|
((match-kw "on")
|
|
(let
|
|
((target (parse-expr)))
|
|
(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
|
|
(fn
|
|
()
|
|
(let
|
|
((value (parse-expr)))
|
|
(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
|
|
()
|
|
(let
|
|
((cnd (parse-expr)))
|
|
(let
|
|
((then-body (do (match-kw "then") (parse-cmd-list))))
|
|
(let
|
|
((else-body (if (or (match-kw "else") (match-kw "otherwise")) (parse-cmd-list) nil)))
|
|
(match-kw "end")
|
|
(if
|
|
else-body
|
|
(list (quote if) cnd then-body else-body)
|
|
(list (quote if) cnd then-body)))))))
|
|
(define
|
|
parse-wait-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((match-kw "for")
|
|
(let
|
|
((event-name (tp-val)))
|
|
(adv!)
|
|
(let
|
|
((source (if (match-kw "from") (parse-expr) nil)))
|
|
(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!)))
|
|
(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
|
|
(fn
|
|
()
|
|
(adv!)
|
|
(define
|
|
dd-collect
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(or (= (tp-type) "paren-close") (at-end?))
|
|
(do (if (= (tp-type) "paren-close") (adv!) nil) acc)
|
|
(let
|
|
((key (get (adv!) "value")))
|
|
(if (= (tp-type) "colon") (adv!) nil)
|
|
(let
|
|
((val (parse-expr)))
|
|
(if (= (tp-type) "comma") (adv!) nil)
|
|
(dd-collect (append acc (list key val))))))))
|
|
(cons (quote dict) (dd-collect (list)))))
|
|
(define
|
|
parse-compound-event-name
|
|
(fn
|
|
()
|
|
(let
|
|
((result (get (adv!) "value")))
|
|
(define
|
|
collect!
|
|
(fn
|
|
()
|
|
(when
|
|
(not (at-end?))
|
|
(cond
|
|
((= (tp-type) "class")
|
|
(let
|
|
((part (tp-val)))
|
|
(adv!)
|
|
(set! result (str result "." part))
|
|
(collect!)))
|
|
((= (tp-type) "local")
|
|
(let
|
|
((part (tp-val)))
|
|
(adv!)
|
|
(set! result (str result ":" part))
|
|
(collect!)))
|
|
(true nil)))))
|
|
(collect!)
|
|
result)))
|
|
(define
|
|
parse-send-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((name (parse-compound-event-name)))
|
|
(let
|
|
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
|
|
(let
|
|
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
|
(if
|
|
dtl
|
|
(list (quote send) name dtl tgt)
|
|
(list (quote send) name tgt)))))))
|
|
(define
|
|
parse-trigger-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((name (get (adv!) "value")))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote trigger) name tgt)))))
|
|
(define parse-log-cmd (fn () (list (quote log) (parse-expr))))
|
|
(define
|
|
parse-inc-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((expr (parse-expr)))
|
|
(let
|
|
((by-amount (if (match-kw "by") (parse-expr) nil)))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(if
|
|
by-amount
|
|
(list (quote increment!) expr by-amount tgt)
|
|
(list (quote increment!) expr tgt)))))))
|
|
(define
|
|
parse-dec-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((expr (parse-expr)))
|
|
(let
|
|
((by-amount (if (match-kw "by") (parse-expr) nil)))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(if
|
|
by-amount
|
|
(list (quote decrement!) expr by-amount tgt)
|
|
(list (quote decrement!) expr tgt)))))))
|
|
(define
|
|
parse-hide-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
|
(let
|
|
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
|
(let
|
|
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
|
(list (quote hide) tgt strategy when-cond))))))
|
|
(define
|
|
parse-show-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show"))) (list (quote me))) (true (parse-expr)))))
|
|
(let
|
|
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
|
|
(let
|
|
((when-cond (if (and (= (tp-type) "keyword") (= (tp-val) "when")) (do (adv!) (parse-expr)) nil)))
|
|
(list (quote show) tgt strategy when-cond))))))
|
|
(define
|
|
parse-transition-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((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
|
|
()
|
|
(let
|
|
((prop (cond ((= (tp-type) "style") (get (adv!) "value")) ((= (tp-val) "my") (do (adv!) (if (= (tp-type) "style") (get (adv!) "value") (get (adv!) "value")))) ((= (tp-val) "'s") (do (adv!) (if (= (tp-type) "style") (get (adv!) "value") (get (adv!) "value")))) (true (get (adv!) "value")))))
|
|
(let
|
|
((inner-tgt (if (match-kw "of") (parse-expr) nil)))
|
|
(let
|
|
((eff-tgt (if inner-tgt inner-tgt tgt)))
|
|
(let
|
|
((from-val (if (match-kw "from") (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
|
|
(expect-kw! "to")
|
|
(let
|
|
((value (let ((v (parse-atom))) (if (and v (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v))))
|
|
(let
|
|
((dur (if (match-kw "over") (let ((v (parse-atom))) (if (and (number? v) (= (tp-type) "ident") (not (hs-keyword? (tp-val)))) (let ((unit (get (adv!) "value"))) (list (quote string-postfix) v unit)) v)) nil)))
|
|
(let
|
|
((using-val (if (match-kw "using") (parse-expr) nil)))
|
|
(if
|
|
from-val
|
|
(list
|
|
(quote transition-from)
|
|
prop
|
|
from-val
|
|
value
|
|
dur
|
|
eff-tgt)
|
|
(list
|
|
(quote transition)
|
|
prop
|
|
value
|
|
dur
|
|
eff-tgt)))))))))))
|
|
(let
|
|
((first-t (parse-one-transition)))
|
|
(define
|
|
collect-transitions
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(and
|
|
(not (at-end?))
|
|
(= (tp-type) "ident")
|
|
(not (hs-keyword? (tp-val))))
|
|
(collect-transitions
|
|
(append acc (list (parse-one-transition))))
|
|
acc)))
|
|
(let
|
|
((all (collect-transitions (list first-t))))
|
|
(if (= (len all) 1) (first all) (cons (quote do) all)))))))
|
|
(define
|
|
parse-repeat-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((and (= (tp-type) "keyword") (= (tp-val) "for"))
|
|
(do (adv!) (parse-for-cmd)))
|
|
((and (= (tp-type) "keyword") (= (tp-val) "in"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((collection (parse-expr)))
|
|
(let
|
|
((body (parse-cmd-list)))
|
|
(match-kw "end")
|
|
(list (quote for) "it" collection body)))))
|
|
(true
|
|
(let
|
|
((mode (cond ((match-kw "forever") (list (quote forever))) ((match-kw "while") (list (quote while) (parse-expr))) ((match-kw "until") (list (quote until) (parse-expr))) (true (let ((n (parse-expr))) (if (match-kw "times") (list (quote times) n) (list (quote forever))))))))
|
|
(let
|
|
((body (do (match-kw "then") (parse-cmd-list))))
|
|
(cond
|
|
((match-kw "until")
|
|
(let
|
|
((cond-expr (parse-expr)))
|
|
(match-kw "end")
|
|
(list (quote repeat-until) cond-expr body)))
|
|
((match-kw "while")
|
|
(let
|
|
((cond-expr (parse-expr)))
|
|
(match-kw "end")
|
|
(list (quote repeat-while) cond-expr body)))
|
|
(true
|
|
(do (match-kw "end") (list (quote repeat) mode body))))))))))
|
|
(define
|
|
parse-fetch-cmd
|
|
(fn
|
|
()
|
|
(if
|
|
(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 (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))))
|
|
(let
|
|
((url-atom (if (and (= (tp-type) "op") (= (tp-val) "/")) (do (adv!) (let ((path-parts (list "/"))) (define read-path (fn () (when (and (not (at-end?)) (or (= (tp-type) "ident") (= (tp-type) "op") (= (tp-type) "dot") (= (tp-type) "number"))) (append! path-parts (tp-val)) (adv!) (read-path)))) (read-path) (join "" path-parts))) (parse-atom))))
|
|
(let
|
|
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
|
|
(let
|
|
((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")
|
|
(if
|
|
(= (tp-type) "brace-open")
|
|
(parse-expr)
|
|
(parse-expr)))
|
|
(let
|
|
((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)))))))))
|
|
(define
|
|
parse-call-args
|
|
(fn
|
|
()
|
|
(adv!)
|
|
(define
|
|
ca-collect
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(or (= (tp-type) "paren-close") (at-end?))
|
|
(do (if (= (tp-type) "paren-close") (adv!) nil) acc)
|
|
(let
|
|
((arg (parse-expr)))
|
|
(if (= (tp-type) "comma") (adv!) nil)
|
|
(ca-collect (append acc (list arg)))))))
|
|
(ca-collect (list))))
|
|
(define parse-call-cmd (fn () (parse-expr)))
|
|
(define parse-get-cmd (fn () (list (quote __get-cmd) (parse-expr))))
|
|
(define
|
|
parse-take-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((= (tp-type) "class")
|
|
(let
|
|
((classes (list)))
|
|
(let
|
|
((collect (fn () (when (= (tp-type) "class") (let ((v (tp-val))) (adv!) (set! classes (append classes (list v))) (collect))))))
|
|
(collect)
|
|
(let
|
|
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
|
(let
|
|
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
|
(if
|
|
(= (len classes) 1)
|
|
(list
|
|
(quote take!)
|
|
"class"
|
|
(first classes)
|
|
from-sel
|
|
for-tgt)
|
|
(cons
|
|
(quote do)
|
|
(map
|
|
(fn
|
|
(cls)
|
|
(list
|
|
(quote take!)
|
|
"class"
|
|
cls
|
|
from-sel
|
|
for-tgt))
|
|
classes))))))))
|
|
((= (tp-type) "attr")
|
|
(let
|
|
((attr-name (get (adv!) "value")))
|
|
(let
|
|
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (get (adv!) "value")) nil)))
|
|
(let
|
|
((with-val (if (match-kw "with") (parse-expr) nil)))
|
|
(let
|
|
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
|
(let
|
|
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
|
(list
|
|
(quote take!)
|
|
"attr"
|
|
attr-name
|
|
from-sel
|
|
for-tgt
|
|
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
|
|
(if
|
|
(not (or (match-kw "of") (match-kw "from")))
|
|
(error (str "Expected 'of' or 'from' at position " p)))
|
|
(let
|
|
((coll (parse-expr)))
|
|
(list (quote pick-first) coll n))))))
|
|
((and (= typ "keyword") (= val "last"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((n (parse-atom)))
|
|
(do
|
|
(if
|
|
(not (or (match-kw "of") (match-kw "from")))
|
|
(error (str "Expected 'of' or 'from' at position " p)))
|
|
(let
|
|
((coll (parse-expr)))
|
|
(list (quote pick-last) coll n))))))
|
|
((and (= typ "keyword") (= val "random"))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(or (match-kw "of") (match-kw "from"))
|
|
(let
|
|
((coll (parse-expr)))
|
|
(list (quote pick-random) coll nil))
|
|
(let
|
|
((n (parse-atom)))
|
|
(do
|
|
(if
|
|
(not (or (match-kw "of") (match-kw "from")))
|
|
(error
|
|
(str "Expected 'of' or 'from' at position " p)))
|
|
(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
|
|
(if
|
|
(not (or (match-kw "of") (match-kw "from")))
|
|
(error
|
|
(str "Expected 'of' or 'from' at position " p)))
|
|
(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-atom)))
|
|
(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-atom)))
|
|
(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))))))
|
|
((and (= typ "ident") (= val "item"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((n (parse-expr)))
|
|
(do
|
|
(if
|
|
(not (or (match-kw "of") (match-kw "from")))
|
|
(error (str "Expected 'of' or 'from' at position " p)))
|
|
(let
|
|
((coll (parse-expr)))
|
|
(list
|
|
(quote pick-items)
|
|
coll
|
|
n
|
|
(list (quote +) n 1)))))))
|
|
(true
|
|
(error
|
|
(str
|
|
"Expected first/last/random/item/items/match/matches after 'pick' at "
|
|
p)))))))
|
|
(define
|
|
parse-go-cmd
|
|
(fn () (match-kw "to") (list (quote go) (parse-expr))))
|
|
(define
|
|
parse-arith
|
|
(fn
|
|
(left)
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(if
|
|
(or
|
|
(and
|
|
(= typ "op")
|
|
(or
|
|
(= val "+")
|
|
(= val "-")
|
|
(= val "*")
|
|
(= val "/")
|
|
(= val "%")))
|
|
(and (= typ "keyword") (= val "mod")))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%")))))
|
|
(let
|
|
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
|
|
(parse-arith (list op left right)))))
|
|
left))))
|
|
(define
|
|
parse-the-expr
|
|
(fn
|
|
()
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(cond
|
|
((= typ "style")
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(match-kw "of")
|
|
(list (quote style) val (parse-expr))
|
|
(list (quote style) val (list (quote me))))))
|
|
((= typ "attr")
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(match-kw "of")
|
|
(list (quote attr) val (parse-expr))
|
|
(list (quote attr) val (list (quote me))))))
|
|
((= typ "class")
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(match-kw "of")
|
|
(list (quote has-class?) (parse-expr) val)
|
|
(list (quote has-class?) (list (quote me)) val))))
|
|
((= typ "selector")
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(match-kw "in")
|
|
(list
|
|
(quote in?)
|
|
(list (quote query) val)
|
|
(parse-expr))
|
|
(list (quote query) val))))
|
|
((or (= typ "ident") (= typ "keyword"))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(match-kw "of")
|
|
(list (make-symbol ".") (parse-expr) val)
|
|
(cond
|
|
((= val "result") (quote the-result))
|
|
((= val "first") (parse-pos-kw (quote first)))
|
|
((= val "last") (parse-pos-kw (quote last)))
|
|
((= val "closest") (parse-trav (quote closest)))
|
|
((= val "next") (parse-trav (quote next)))
|
|
((= val "previous") (parse-trav (quote previous)))
|
|
(true (list (quote ref) val))))))
|
|
(true (parse-atom))))))
|
|
(define
|
|
parse-array-lit
|
|
(fn
|
|
()
|
|
(define
|
|
al-collect
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(or (= (tp-type) "bracket-close") (at-end?))
|
|
(do (if (= (tp-type) "bracket-close") (adv!) nil) acc)
|
|
(let
|
|
((elem (parse-expr)))
|
|
(if (= (tp-type) "comma") (adv!) nil)
|
|
(al-collect (append acc (list elem)))))))
|
|
(cons (quote array) (al-collect (list)))))
|
|
(define
|
|
parse-return-cmd
|
|
(fn
|
|
()
|
|
(if
|
|
(or
|
|
(at-end?)
|
|
(and
|
|
(= (tp-type) "keyword")
|
|
(or
|
|
(= (tp-val) "end")
|
|
(= (tp-val) "then")
|
|
(= (tp-val) "else"))))
|
|
(list (quote return) nil)
|
|
(list (quote return) (parse-expr)))))
|
|
(define parse-throw-cmd (fn () (list (quote throw) (parse-expr))))
|
|
(define
|
|
parse-append-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((value (parse-expr)))
|
|
(if
|
|
(match-kw "to")
|
|
(let
|
|
((target (parse-expr)))
|
|
(list (quote append!) value target))
|
|
(list (quote append!) value (list (quote it)))))))
|
|
(define
|
|
parse-tell-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((target (parse-expr)))
|
|
(match-kw "then")
|
|
(let
|
|
((body (parse-cmd-list)))
|
|
(match-kw "end")
|
|
(list (quote tell) target body)))))
|
|
(define
|
|
parse-for-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((var-name (tp-val)))
|
|
(adv!)
|
|
(expect-kw! "in")
|
|
(let
|
|
((collection (parse-expr)))
|
|
(let
|
|
((idx (cond ((match-kw "index") (let ((iname (tp-val))) (adv!) iname)) ((match-kw "indexed") (do (match-kw "by") (let ((iname (tp-val))) (adv!) iname))) (true nil))))
|
|
(let
|
|
((body (do (match-kw "then") (parse-cmd-list))))
|
|
(match-kw "end")
|
|
(if
|
|
idx
|
|
(list (quote for) var-name collection body :index idx)
|
|
(list (quote for) var-name collection body))))))))
|
|
(define
|
|
parse-make-cmd
|
|
(fn
|
|
()
|
|
(if (= (tp-val) "a") (adv!) nil)
|
|
(let
|
|
((type-name (tp-val)))
|
|
(adv!)
|
|
(let
|
|
((called (if (match-kw "called") (let ((n (tp-val))) (adv!) n) nil)))
|
|
(if
|
|
called
|
|
(list (quote make) type-name called)
|
|
(list (quote make) type-name))))))
|
|
(define
|
|
parse-install-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((name (tp-val)))
|
|
(adv!)
|
|
(if
|
|
(= (tp-type) "paren-open")
|
|
(let
|
|
((args (parse-call-args)))
|
|
(cons (quote install) (cons name args)))
|
|
(list (quote install) name)))))
|
|
(define
|
|
parse-measure-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (parse-expr)))
|
|
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
|
|
(define
|
|
parse-scroll-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
|
(let
|
|
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top"))))
|
|
(list (quote scroll!) tgt pos)))))
|
|
(define
|
|
parse-select-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
|
(list (quote select!) tgt))))
|
|
(define
|
|
parse-reset-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
|
|
(list (quote reset!) tgt))))
|
|
(define
|
|
parse-default-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (parse-expr)))
|
|
(expect-kw! "to")
|
|
(let ((val (parse-expr))) (list (quote default!) tgt val)))))
|
|
(define
|
|
parse-halt-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((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
|
|
(fn () (if (= (tp-type) "paren-open") (parse-call-args) (list))))
|
|
(define
|
|
parse-focus-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
|
(list (quote focus!) tgt))))
|
|
(define
|
|
parse-feat-body
|
|
(fn
|
|
()
|
|
(define
|
|
fb-collect
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(or
|
|
(at-end?)
|
|
(and (= (tp-type) "keyword") (= (tp-val) "end")))
|
|
acc
|
|
(let
|
|
((feat (parse-feat)))
|
|
(if
|
|
(nil? feat)
|
|
acc
|
|
(fb-collect (append acc (list feat))))))))
|
|
(fb-collect (list))))
|
|
(define
|
|
parse-def-feat
|
|
(fn
|
|
()
|
|
(let
|
|
((name (tp-val)))
|
|
(adv!)
|
|
(let
|
|
((params (parse-param-list)))
|
|
(let
|
|
((body (parse-cmd-list)))
|
|
(match-kw "end")
|
|
(list (quote def) name params body))))))
|
|
(define
|
|
parse-behavior-feat
|
|
(fn
|
|
()
|
|
(let
|
|
((name (tp-val)))
|
|
(adv!)
|
|
(let
|
|
((params (parse-param-list)))
|
|
(let
|
|
((body (parse-feat-body)))
|
|
(match-kw "end")
|
|
(list (quote behavior) name params body))))))
|
|
(define
|
|
parse-render-kwargs
|
|
(fn
|
|
()
|
|
(define
|
|
collect-kw
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(= (tp-type) "local")
|
|
(let
|
|
((key (tp-val)))
|
|
(adv!)
|
|
(let
|
|
((val (parse-expr)))
|
|
(collect-kw (append acc (list key val)))))
|
|
acc)))
|
|
(collect-kw (list))))
|
|
(define
|
|
parse-render-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((comp (cond ((= (tp-type) "component") (let ((name (tp-val))) (adv!) name)) ((= (tp-type) "paren-open") (do (adv!) (let ((expr (parse-expr))) (if (= (tp-type) "paren-close") (adv!) nil) expr))) (true (let ((name (tp-val))) (adv!) name)))))
|
|
(let
|
|
((kwargs (parse-render-kwargs)))
|
|
(let
|
|
((pos (cond ((match-kw "into") "into") ((match-kw "before") "before") ((match-kw "after") "after") (true nil))))
|
|
(let
|
|
((target (if pos (parse-expr) nil)))
|
|
(if
|
|
pos
|
|
(list (quote render) comp kwargs pos target)
|
|
(list (quote render) comp kwargs))))))))
|
|
(define
|
|
collect-sx-source
|
|
(fn
|
|
()
|
|
(let
|
|
((start-pos (get (tp) "pos")))
|
|
(adv!)
|
|
(define
|
|
skip-to-close
|
|
(fn
|
|
(depth)
|
|
(cond
|
|
((at-end?) start-pos)
|
|
((= (tp-type) "paren-open")
|
|
(do (adv!) (skip-to-close (+ depth 1))))
|
|
((= (tp-type) "paren-close")
|
|
(if
|
|
(= depth 0)
|
|
(let
|
|
((end-pos (+ (get (tp) "pos") 1)))
|
|
(adv!)
|
|
end-pos)
|
|
(do (adv!) (skip-to-close (- depth 1)))))
|
|
(true (do (adv!) (skip-to-close depth))))))
|
|
(let
|
|
((end-pos (skip-to-close 0)))
|
|
(substring src start-pos end-pos)))))
|
|
(define
|
|
parse-empty-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((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
|
|
(fn
|
|
()
|
|
(let
|
|
((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
|
|
()
|
|
(let
|
|
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
|
(list (quote open-element) target))))
|
|
(define
|
|
parse-close-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
|
|
(list (quote close-element) target))))
|
|
(define
|
|
parse-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(cond
|
|
((and (= typ "keyword") (or (= val "catch") (= val "finally") (= val "end") (= val "else") (= val "otherwise")))
|
|
nil)
|
|
((and (= typ "keyword") (= val "add"))
|
|
(do (adv!) (parse-add-cmd)))
|
|
((and (= typ "keyword") (= val "remove"))
|
|
(do (adv!) (parse-remove-cmd)))
|
|
((and (= typ "keyword") (= val "toggle"))
|
|
(do (adv!) (parse-toggle-cmd)))
|
|
((and (= typ "keyword") (= val "set"))
|
|
(do (adv!) (parse-set-cmd)))
|
|
((and (= typ "keyword") (= val "put"))
|
|
(do (adv!) (parse-put-cmd)))
|
|
((and (= typ "keyword") (= val "if"))
|
|
(do (adv!) (parse-if-cmd)))
|
|
((and (= typ "keyword") (= val "wait"))
|
|
(do (adv!) (parse-wait-cmd)))
|
|
((and (= typ "keyword") (= val "send"))
|
|
(do (adv!) (parse-send-cmd)))
|
|
((and (= typ "keyword") (= val "trigger"))
|
|
(do (adv!) (parse-trigger-cmd)))
|
|
((and (= typ "keyword") (= val "log"))
|
|
(do (adv!) (parse-log-cmd)))
|
|
((and (= typ "keyword") (= val "increment"))
|
|
(do (adv!) (parse-inc-cmd)))
|
|
((and (= typ "keyword") (= val "decrement"))
|
|
(do (adv!) (parse-dec-cmd)))
|
|
((and (= typ "keyword") (= val "hide"))
|
|
(do (adv!) (parse-hide-cmd)))
|
|
((and (= typ "keyword") (= val "show"))
|
|
(do (adv!) (parse-show-cmd)))
|
|
((and (= typ "keyword") (= val "transition"))
|
|
(do (adv!) (parse-transition-cmd)))
|
|
((and (= typ "keyword") (= val "repeat"))
|
|
(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"))
|
|
(do (adv!) (parse-go-cmd)))
|
|
((and (= typ "keyword") (= val "return"))
|
|
(do (adv!) (parse-return-cmd)))
|
|
((and (= typ "keyword") (= val "throw"))
|
|
(do (adv!) (parse-throw-cmd)))
|
|
((and (= typ "keyword") (= val "append"))
|
|
(do (adv!) (parse-append-cmd)))
|
|
((and (= typ "keyword") (= val "tell"))
|
|
(do (adv!) (parse-tell-cmd)))
|
|
((and (= typ "keyword") (= val "for"))
|
|
(do (adv!) (parse-for-cmd)))
|
|
((and (= typ "keyword") (= val "make"))
|
|
(do (adv!) (parse-make-cmd)))
|
|
((and (= typ "keyword") (= val "install"))
|
|
(do (adv!) (parse-install-cmd)))
|
|
((and (= typ "keyword") (= val "measure"))
|
|
(do (adv!) (parse-measure-cmd)))
|
|
((and (= typ "keyword") (= val "render"))
|
|
(do (adv!) (parse-render-cmd)))
|
|
((and (= typ "keyword") (= val "scroll"))
|
|
(do (adv!) (parse-scroll-cmd)))
|
|
((and (= typ "keyword") (= val "select"))
|
|
(do (adv!) (parse-select-cmd)))
|
|
((and (= typ "keyword") (= val "reset"))
|
|
(do (adv!) (parse-reset-cmd)))
|
|
((and (= typ "keyword") (= val "default"))
|
|
(do (adv!) (parse-default-cmd)))
|
|
((and (= typ "keyword") (= val "halt"))
|
|
(do (adv!) (parse-halt-cmd)))
|
|
((and (= typ "keyword") (= val "focus"))
|
|
(do (adv!) (parse-focus-cmd)))
|
|
((and (= typ "keyword") (= val "empty"))
|
|
(do (adv!) (parse-empty-cmd)))
|
|
((and (= typ "keyword") (= val "clear"))
|
|
(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"))
|
|
(do (adv!) (parse-close-cmd)))
|
|
((and (= typ "keyword") (= val "break"))
|
|
(do (adv!) (list (quote break))))
|
|
((and (= typ "keyword") (= val "continue"))
|
|
(do (adv!) (list (quote continue))))
|
|
((and (= typ "keyword") (or (= val "exit") (= val "halt")))
|
|
(do (adv!) (list (quote exit))))
|
|
(true (parse-expr))))))
|
|
(define
|
|
parse-cmd-list
|
|
(fn
|
|
()
|
|
(define
|
|
cmd-kw?
|
|
(fn
|
|
(v)
|
|
(or
|
|
(= v "add")
|
|
(= v "remove")
|
|
(= v "toggle")
|
|
(= v "set")
|
|
(= v "put")
|
|
(= v "if")
|
|
(= v "wait")
|
|
(= v "send")
|
|
(= v "trigger")
|
|
(= v "log")
|
|
(= v "increment")
|
|
(= v "decrement")
|
|
(= v "hide")
|
|
(= v "show")
|
|
(= v "transition")
|
|
(= v "repeat")
|
|
(= v "fetch")
|
|
(= v "get")
|
|
(= v "call")
|
|
(= v "take")
|
|
(= v "settle")
|
|
(= v "go")
|
|
(= v "return")
|
|
(= v "throw")
|
|
(= v "append")
|
|
(= v "tell")
|
|
(= v "for")
|
|
(= v "make")
|
|
(= v "install")
|
|
(= v "measure")
|
|
(= v "render")
|
|
(= v "halt")
|
|
(= v "default")
|
|
(= v "scroll")
|
|
(= v "select")
|
|
(= v "reset")
|
|
(= v "focus")
|
|
(= v "empty")
|
|
(= v "clear")
|
|
(= v "swap")
|
|
(= v "morph")
|
|
(= v "open")
|
|
(= v "close")
|
|
(= v "pick"))))
|
|
(define
|
|
cl-collect
|
|
(fn
|
|
(acc)
|
|
(let
|
|
((cmd (parse-cmd)))
|
|
(if
|
|
(nil? cmd)
|
|
acc
|
|
(let
|
|
((acc2 (append acc (list cmd))))
|
|
(cond
|
|
((match-kw "then")
|
|
(cl-collect (append acc2 (list (quote __then__)))))
|
|
((and (not (at-end?)) (= (tp-type) "keyword") (cmd-kw? (tp-val)))
|
|
(cl-collect acc2))
|
|
(true acc2)))))))
|
|
(let
|
|
((cmds (cl-collect (list))))
|
|
(cond
|
|
((= (len cmds) 0) nil)
|
|
((= (len cmds) 1) (first cmds))
|
|
(true
|
|
(cons
|
|
(quote do)
|
|
(filter (fn (c) (not (= c (quote __then__)))) cmds)))))))
|
|
(define
|
|
parse-on-feat
|
|
(fn
|
|
()
|
|
(let
|
|
((every? (match-kw "every")))
|
|
(let
|
|
((event-name (parse-compound-event-name)))
|
|
(let
|
|
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((f (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) f)) nil)))
|
|
(let
|
|
((source (if (match-kw "from") (parse-expr) nil)))
|
|
(let
|
|
((body (parse-cmd-list)))
|
|
(let
|
|
((catch-clause (if (match-kw "catch") (let ((var (let ((v (tp-val))) (adv!) v)) (handler (parse-cmd-list))) (list var handler)) nil))
|
|
(finally-clause
|
|
(if (match-kw "finally") (parse-cmd-list) nil)))
|
|
(match-kw "end")
|
|
(let
|
|
((parts (list (quote on) event-name)))
|
|
(let
|
|
((parts (if every? (append parts (list :every true)) parts)))
|
|
(let
|
|
((parts (if flt (append parts (list :filter flt)) parts)))
|
|
(let
|
|
((parts (if source (append parts (list :from source)) parts)))
|
|
(let
|
|
((parts (if catch-clause (append parts (list :catch catch-clause)) parts)))
|
|
(let
|
|
((parts (if finally-clause (append parts (list :finally finally-clause)) parts)))
|
|
(let
|
|
((parts (append parts (list body))))
|
|
parts)))))))))))))))
|
|
(define
|
|
parse-init-feat
|
|
(fn
|
|
()
|
|
(let
|
|
((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
|
|
()
|
|
(let
|
|
((val (tp-val)))
|
|
(cond
|
|
((= val "on") (do (adv!) (parse-on-feat)))
|
|
((= 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
|
|
(fn
|
|
(acc)
|
|
(if
|
|
(at-end?)
|
|
acc
|
|
(let
|
|
((feat (parse-feat)))
|
|
(if (nil? feat) acc (coll-feats (append acc (list feat))))))))
|
|
(let
|
|
((features (coll-feats (list))))
|
|
(if
|
|
(= (len features) 1)
|
|
(first features)
|
|
(cons (quote do) features))))))
|
|
|
|
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
|