Tokenizer: * and % now emit as operators (were silently swallowed) Added keywords: install, measure, behavior, called 5 new arithmetic operator tests Parser — expression layer: Arithmetic (+, -, *, /, %) via parse-arith Unary not, no, unary minus the X of Y possessive (parse-the-expr) as Type conversion, X in Y membership, array literals [...] fetch URL parsing fixed — no longer consumes "as" meant for fetch Parser — 8 new commands: return, throw, append...to, tell...end, for...in...end, make a Type, install Behavior, measure Parser — 2 new features: def name(params)...end, behavior Name(params)...end Parser — enhanced: wait for event [from target], on every event modifier 33 new parser tests (16 suites), 5 tokenizer tests. 3043/3043 full build, zero regressions. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
857 lines
30 KiB
Plaintext
857 lines
30 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)
|
|
(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"))
|
|
(string->number (substring val 0 (- slen 2))))
|
|
((and (>= slen 2) (= (nth val (- slen 1)) "s"))
|
|
(* 1000 (string->number (substring val 0 (- slen 1)))))
|
|
(true (string->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 "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 (get (adv!) "value")))
|
|
(parse-prop-chain (list (quote .) base prop)))
|
|
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))
|
|
((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!) nil))
|
|
((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 "the"))
|
|
(do (adv!) (parse-the-expr)))
|
|
((and (= typ "keyword") (= val "me"))
|
|
(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!) (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 "bracket-open") (do (adv!) (parse-array-lit)))
|
|
((and (= typ "op") (= val "-"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((operand (parse-atom)))
|
|
(list (quote -) 0 operand))))
|
|
(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))
|
|
(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 ">=")))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((right (parse-expr)))
|
|
(list (if (= val "==") (quote =) val) left right))))
|
|
((and (= typ "keyword") (= val "is"))
|
|
(do
|
|
(adv!)
|
|
(cond
|
|
((match-kw "not")
|
|
(if
|
|
(match-kw "empty")
|
|
(list (quote not) (list (quote empty?) left))
|
|
(let
|
|
((right (parse-expr)))
|
|
(list (quote not) (list (quote =) left right)))))
|
|
((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 (= 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 "and"))
|
|
(do (adv!) (list (quote and) left (parse-expr))))
|
|
((and (= typ "keyword") (= val "or"))
|
|
(do (adv!) (list (quote or) left (parse-expr))))
|
|
((and (= typ "keyword") (= val "as"))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((type-name (tp-val)))
|
|
(adv!)
|
|
(list (quote as) 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))))
|
|
(true left)))))
|
|
(define
|
|
parse-expr
|
|
(fn
|
|
()
|
|
(let
|
|
((left (parse-atom)))
|
|
(if
|
|
(nil? left)
|
|
nil
|
|
(let
|
|
((left2 (parse-poss left)))
|
|
(let ((left3 (parse-arith left2))) (parse-cmp left3)))))))
|
|
(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")))
|
|
(let
|
|
((tgt (parse-tgt-kw "to" (list (quote me)))))
|
|
(list (quote add-class) cls tgt)))
|
|
nil)))
|
|
(define
|
|
parse-remove-cmd
|
|
(fn
|
|
()
|
|
(if
|
|
(= (tp-type) "class")
|
|
(let
|
|
((cls (get (adv!) "value")))
|
|
(let
|
|
((tgt (parse-tgt-kw "from" (list (quote me)))))
|
|
(list (quote remove-class) cls tgt)))
|
|
nil)))
|
|
(define
|
|
parse-toggle-cmd
|
|
(fn
|
|
()
|
|
(cond
|
|
((match-kw "between")
|
|
(if
|
|
(= (tp-type) "class")
|
|
(let
|
|
((cls1 (get (adv!) "value")))
|
|
(expect-kw! "and")
|
|
(if
|
|
(= (tp-type) "class")
|
|
(let
|
|
((cls2 (get (adv!) "value")))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-between) cls1 cls2 tgt)))
|
|
nil))
|
|
nil))
|
|
((= (tp-type) "class")
|
|
(let
|
|
((cls (get (adv!) "value")))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(list (quote toggle-class) cls 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)))
|
|
(true
|
|
(error (str "Expected into/before/after 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 () (list (quote increment!) (parse-expr))))
|
|
(define parse-dec-cmd (fn () (list (quote decrement!) (parse-expr))))
|
|
(define
|
|
parse-hide-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
|
(list (quote hide) tgt))))
|
|
(define
|
|
parse-show-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((tgt (if (at-end?) (list (quote me)) (if (or (= (tp-type) "id") (= (tp-type) "selector")) (parse-expr) (list (quote me))))))
|
|
(list (quote show) tgt))))
|
|
(define
|
|
parse-transition-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((prop (get (adv!) "value")))
|
|
(expect-kw! "to")
|
|
(let
|
|
((value (parse-expr)))
|
|
(let
|
|
((dur (if (match-kw "over") (if (= (tp-type) "number") (parse-dur (get (adv!) "value")) 400) nil)))
|
|
(let
|
|
((tgt (parse-tgt-kw "on" (list (quote me)))))
|
|
(if
|
|
dur
|
|
(list (quote transition) prop value dur tgt)
|
|
(list (quote transition) prop value tgt))))))))
|
|
(define
|
|
parse-repeat-cmd
|
|
(fn
|
|
()
|
|
(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))) ((= (tp-type) "number") (let ((n (parse-dur (get (adv!) "value")))) (expect-kw! "times") (list (quote times) n))) (true (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
|
|
()
|
|
(if
|
|
(= (tp-type) "class")
|
|
(let
|
|
((cls (get (adv!) "value")))
|
|
(let
|
|
((tgt (parse-tgt-kw "from" (list (quote me)))))
|
|
(list (quote take) cls tgt)))
|
|
nil)))
|
|
(define
|
|
parse-go-cmd
|
|
(fn () (match-kw "to") (list (quote go) (parse-expr))))
|
|
(begin
|
|
(define
|
|
parse-arith
|
|
(fn
|
|
(left)
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(if
|
|
(and
|
|
(= typ "op")
|
|
(or
|
|
(= val "+")
|
|
(= val "-")
|
|
(= val "*")
|
|
(= val "/")
|
|
(= val "%")))
|
|
(do
|
|
(adv!)
|
|
(let
|
|
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((= val "%") (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)))
|
|
(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-param-list
|
|
(fn () (if (= (tp-type) "paren-open") (parse-call-args) (list))))
|
|
(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-cmd
|
|
(fn
|
|
()
|
|
(let
|
|
((typ (tp-type)) (val (tp-val)))
|
|
(cond
|
|
((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)))
|
|
(true (parse-expr))))))
|
|
(define
|
|
parse-cmd-list
|
|
(fn
|
|
()
|
|
(define
|
|
cl-collect
|
|
(fn
|
|
(acc)
|
|
(let
|
|
((cmd (parse-cmd)))
|
|
(if
|
|
(nil? cmd)
|
|
acc
|
|
(let
|
|
((acc2 (append acc (list cmd))))
|
|
(if (match-kw "then") (cl-collect acc2) 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)))
|
|
(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)))
|
|
(append parts (list body)))))))))))))
|
|
(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))))))
|
|
|
|
;; ── Convenience: source string → AST ─────────────────────────────
|
|
(define hs-compile (fn (src) (hs-parse (hs-tokenize src))))
|