;; _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 hs-falsy?) (parse-atom)))) ((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 "sender")) (do (adv!) (list (quote sender)))) ((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") (= val "my")) (do (adv!) (parse-poss-tail (list (quote me))))) ((and (= typ "keyword") (= val "your")) (do (adv!) (parse-poss-tail (list (quote ref) "you")))) ((and (= typ "keyword") (= val "its")) (do (adv!) (parse-poss-tail (list (quote it))))) ((and (= typ "keyword") (or (= val "you") (= val "yourself"))) (do (adv!) (parse-prop-chain (list (quote ref) val)))) ((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))) (parse-poss (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-assert-strict) left type-name) (list (quote type-assert) 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))))) (let ((when-clause (if (match-kw "when") (parse-expr) nil))) (if when-clause (list (quote add-attr-when) attr-name attr-val tgt when-clause) (list (quote add-attr) attr-name attr-val tgt)))))))) ((= (tp-type) "attr") (let ((attr-name (get (adv!) "value"))) (let ((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) ""))) (let ((tgt (if (match-kw "to") (parse-expr) (list (quote me))))) (let ((when-clause (if (match-kw "when") (parse-expr) nil))) (if when-clause (list (quote add-attr-when) attr-name attr-val tgt when-clause) (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))))))) ((= (tp-type) "attr") (let ((attr-name (get (adv!) "value"))) (let ((tgt (if (match-kw "from") (parse-expr) (list (quote me))))) (list (quote remove-attr) attr-name tgt)))) ((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)))) (define collect-classes (fn (acc) (if (= (tp-type) "class") (let ((v (tp-val))) (adv!) (collect-classes (append acc (list v)))) acc))) (let ((extra-classes (collect-classes (list)))) (let ((tgt (parse-tgt-kw "on" (list (quote me))))) (cond ((> (len extra-classes) 0) (list (quote toggle-between) cls (first extra-classes) tgt)) ((match-kw "for") (let ((dur (parse-expr))) (list (quote toggle-class-for) cls tgt dur))) ((match-kw "until") (let ((event-name (tp-val))) (adv!) (let ((source (if (match-kw "from") (parse-expr) nil))) (list (quote toggle-class-until) cls tgt event-name source)))) (true (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-raw (cond ((and (= (tp-type) "ident") (or (= (tp-val) "element") (= (tp-val) "global") (= (tp-val) "local"))) (do (adv!) (parse-expr))) (true (parse-expr))))) (let ((tgt (if (= (tp-type) "attr") (let ((attr-name (get (adv!) "value"))) (list (quote attr) attr-name tgt-raw)) tgt-raw))) (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 ((destructure (if (= (tp-type) "paren-open") (let ((_ (adv!))) (define collect-dnames (fn (acc) (cond ((or (= (tp-type) "paren-close") (at-end?)) (do (if (= (tp-type) "paren-close") (adv!) nil) acc)) ((= (tp-type) "comma") (do (adv!) (collect-dnames acc))) (true (let ((name (tp-val))) (adv!) (collect-dnames (append acc (list name)))))))) (collect-dnames (list))) nil))) (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))) (let ((base (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))))) (if destructure (append base (list :destructure destructure)) base))))))) ((= (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 (parse-compound-event-name))) (let ((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil))) (let ((tgt (parse-tgt-kw "on" (list (quote me))))) (if dtl (list (quote trigger) name dtl tgt) (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 ((with-cls nil) (from-sel nil) (for-tgt nil)) (define parse-cls-clauses (fn () (cond ((and (nil? with-cls) (match-kw "with") (= (tp-type) "class")) (do (set! with-cls (tp-val)) (adv!) (parse-cls-clauses))) ((and (nil? with-cls) (match-kw "giving") (= (tp-type) "class")) (do (set! with-cls (tp-val)) (adv!) (parse-cls-clauses))) ((and (nil? from-sel) (match-kw "from")) (do (set! from-sel (parse-expr)) (parse-cls-clauses))) ((and (nil? for-tgt) (match-kw "for")) (do (set! for-tgt (parse-expr)) (parse-cls-clauses))) (true nil)))) (parse-cls-clauses) (if (= (len classes) 1) (list (quote take!) "class" (first classes) from-sel for-tgt nil with-cls) (cons (quote do) (map (fn (cls) (list (quote take!) "class" cls from-sel for-tgt nil with-cls)) 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 nil) (from-sel nil) (for-tgt nil)) (define parse-attr-clauses (fn () (cond ((and (nil? with-val) (match-kw "with")) (do (set! with-val (parse-expr)) (parse-attr-clauses))) ((and (nil? with-val) (match-kw "giving")) (do (set! with-val (parse-expr)) (parse-attr-clauses))) ((and (nil? from-sel) (match-kw "from")) (do (set! from-sel (parse-expr)) (parse-attr-clauses))) ((and (nil? for-tgt) (match-kw "for")) (do (set! for-tgt (parse-expr)) (parse-attr-clauses))) (true nil)))) (parse-attr-clauses) (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 ((kind (if (= (tp-type) "selector") (quote element) (quote object))) (type-name (tp-val))) (adv!) (let ((called nil) (args nil)) (define parse-from-args (fn () (set! args (append args (list (parse-expr)))) (when (= (tp-type) "comma") (adv!) (parse-from-args)))) (define parse-clauses (fn () (cond ((match-kw "from") (do (parse-from-args) (parse-clauses))) ((match-kw "called") (do (set! called (tp-val)) (adv!) (parse-clauses))) (true nil)))) (parse-clauses) (list (quote make) type-name called args kind))))) (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)))