giles
e71e74941e
Parser: remove me/[@attr]/{css}, tell body scoping (skip then),
transition from/to syntax + my/style prefixes.
Compiler: remove-element, remove-attr, remove-css, transition-from.
Runtime: hs-transition-from for from/to CSS transitions.
Generator changes (already committed) fix ref() unnamed-first mapping,
assertion dedup for pre/post pairs, on-event then insertion.
Conformance: 374→395 (+21 tests, 48%)
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
1646 lines
62 KiB
Plaintext
1646 lines
62 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))))
|
|
(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)))))
|
|
(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") (or (= val "it") (= val "result")))
|
|
(do (adv!) (list (quote it))))
|
|
((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") (= val "my"))
|
|
(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!) (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 "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))))))))
|
|
(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)))
|
|
(list (quote call) 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-expr)))
|
|
(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
|
|
(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)))
|
|
(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)))
|
|
(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))
|
|
(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")
|
|
(list (quote starts-with?) left (parse-expr))))
|
|
((and (or (= typ "keyword") (= typ "ident")) (= val "ends"))
|
|
(do
|
|
(adv!)
|
|
(match-kw "with")
|
|
(list (quote ends-with?) left (parse-expr))))
|
|
((and (= typ "keyword") (= val "matches"))
|
|
(do (adv!) (list (quote matches?) left (parse-expr))))
|
|
((and (= typ "keyword") (= val "contains"))
|
|
(do (adv!) (list (quote contains?) left (parse-expr))))
|
|
((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)))))
|
|
(list (quote as) left type-name))))))
|
|
((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))))
|
|
(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") (= val "precedes"))
|
|
(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"))
|
|
(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
|
|
()
|
|
(if
|
|
(= (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 (parse-tgt-kw "to" (list (quote me)))))
|
|
(if
|
|
(empty? extra-classes)
|
|
(list (quote add-class) cls tgt)
|
|
(cons
|
|
(quote multi-add-class)
|
|
(cons tgt (cons cls extra-classes))))))
|
|
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) nil)))
|
|
(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
|
|
((target (parse-expr)))
|
|
(list (quote remove-element) target))))))
|
|
(define
|
|
parse-toggle-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((match-kw "between")
|
|
(if
|
|
(= (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))
|
|
nil))
|
|
((= (tp-type) "class")
|
|
(let
|
|
((cls (do (let ((v (tp-val))) (adv!) v))))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-class) cls tgt))))
|
|
((= (tp-type) "style")
|
|
(let
|
|
((prop (do (let ((v (tp-val))) (adv!) v))))
|
|
(if
|
|
(match-kw "between")
|
|
(let
|
|
((val1 (parse-atom)))
|
|
(expect-kw! "and")
|
|
(let
|
|
((val2 (parse-atom)))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-style-between) prop val1 val2 tgt))))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-style) prop tgt)))))
|
|
((= (tp-type) "attr")
|
|
(let
|
|
((attr-name (do (let ((v (tp-val))) (adv!) v))))
|
|
(if
|
|
(match-kw "between")
|
|
(let
|
|
((val1 (parse-atom)))
|
|
(expect-kw! "and")
|
|
(let
|
|
((val2 (parse-atom)))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list
|
|
(quote toggle-attr-between)
|
|
attr-name
|
|
val1
|
|
val2
|
|
tgt))))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-attr) attr-name tgt)))))
|
|
(true nil))))
|
|
(define
|
|
parse-set-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (parse-expr)))
|
|
(expect-kw! "to")
|
|
(let ((value (parse-expr))) (list (quote set!) tgt value)))))
|
|
(define
|
|
parse-put-cmd
|
|
(fn
|
|
()
|
|
(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")
|
|
(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 (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)))
|
|
(if
|
|
source
|
|
(list (quote wait-for) event-name :from source)
|
|
(list (quote wait-for) event-name)))))
|
|
((= (tp-type) "number")
|
|
(let
|
|
((tok (adv!)))
|
|
(list (quote wait) (parse-dur (get tok "value")))))
|
|
(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-send-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((name (get (adv!) "value")))
|
|
(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
|
|
((amount (if (match-kw "by") (parse-expr) 1)))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote increment!) expr amount tgt))))))
|
|
(define
|
|
parse-dec-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((expr (parse-expr)))
|
|
(let
|
|
((amount (if (match-kw "by") (parse-expr) 1)))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote decrement!) expr amount 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) "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))) (adv!) s)) "display")))
|
|
(list (quote hide) tgt strategy)))))
|
|
(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) "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))) (adv!) s)) "display")))
|
|
(list (quote show) tgt strategy)))))
|
|
(define
|
|
parse-transition-cmd
|
|
(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")))) (true (get (adv!) "value")))))
|
|
(let
|
|
((from-val (if (match-kw "from") (parse-expr) nil)))
|
|
(expect-kw! "to")
|
|
(let
|
|
((value (parse-expr)))
|
|
(let
|
|
((dur (if (match-kw "over") (parse-expr) nil)))
|
|
(if
|
|
from-val
|
|
(list (quote transition-from) prop from-val value dur)
|
|
(if
|
|
dur
|
|
(list (quote transition) prop value dur nil)
|
|
(list (quote transition) prop value nil)))))))))
|
|
(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 nil 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 (parse-cmd-list)))
|
|
(match-kw "end")
|
|
(list (quote repeat) mode body)))))))
|
|
(define
|
|
parse-fetch-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((url-atom (parse-atom)))
|
|
(let
|
|
((url (if (nil? url-atom) url-atom (parse-arith (parse-poss url-atom)))))
|
|
(let
|
|
((fmt (if (match-kw "as") (let ((f (tp-val))) (adv!) f) "json")))
|
|
(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
|
|
()
|
|
(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-take-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((= (tp-type) "class")
|
|
(let
|
|
((cls (do (let ((v (tp-val))) (adv!) v))))
|
|
(let
|
|
((from-sel (if (match-kw "from") (parse-expr) nil)))
|
|
(let
|
|
((for-tgt (if (match-kw "for") (parse-expr) nil)))
|
|
(list (quote take!) "class" cls from-sel for-tgt)))))
|
|
((= (tp-type) "attr")
|
|
(let
|
|
((attr-name (do (let ((v (tp-val))) (adv!) v))))
|
|
(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)))))
|
|
(true nil))))
|
|
(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)))
|
|
(if
|
|
(or (= typ "ident") (= typ "keyword"))
|
|
(do
|
|
(adv!)
|
|
(if
|
|
(match-kw "of")
|
|
(list (make-symbol ".") (parse-expr) val)
|
|
(cond
|
|
((= val "result") (list (quote it)))
|
|
((= 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)))))
|
|
(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)))
|
|
(expect-kw! "to")
|
|
(let
|
|
((target (parse-expr)))
|
|
(list (quote append!) value target)))))
|
|
(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 (if (match-kw "index") (let ((iname (tp-val))) (adv!) iname) nil)))
|
|
(let
|
|
((body (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
|
|
((the-event (and (match-kw "the") (or (match-kw "event") (match-kw "default")))))
|
|
(list (quote halt!) (if the-event "event" "default")))))
|
|
(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-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 "call"))
|
|
(do (adv!) (parse-call-cmd)))
|
|
((and (= typ "keyword") (= val "take"))
|
|
(do (adv!) (parse-take-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)))
|
|
(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 "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"))))
|
|
(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 acc2))
|
|
((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) cmds))))))
|
|
(define
|
|
parse-on-feat
|
|
(fn
|
|
()
|
|
(let
|
|
((every? (match-kw "every")))
|
|
(let
|
|
((event-name (let ((v (tp-val))) (adv!) v)))
|
|
(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-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)))
|
|
(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)))
|