coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
4cd0e77331ea3ea81191f006d6f9792d4daa915f
rose-ash/lib/hyperscript/parser.sx
giles 4cd0e77331 Step 18 (part 2): _hyperscript parser — token stream → SX AST 
lib/hyperscript/parser.sx — parses token stream from hs-tokenize into
SX AST forms. Covers:
  Commands: add/remove/toggle class, set/put, log, hide/show, settle
  Events: on with from/filter, command sequences
  Sequencing: then, wait (with time units)
  Conditionals: if/then/else/end
  Expressions: property chains, it, comparisons, exists, refs
  DOM traversal: closest, next, previous
  Send/trigger events to targets
  Repeat: forever, N times
  Fetch/call with argument lists

55 tests across 12 suites. 3005/3005 full build, zero regressions.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-06 07:41:17 +00:00

585 lines
20 KiB
Plaintext
Raw Blame History

;; _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") (= val "null")) (do (adv!) nil))
((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 (quote .) (list (quote event)) "target")))
((and (= typ "keyword") (= val "detail"))
(do (adv!) (list (quote .) (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)))
(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))))
(true left)))))
(define
parse-expr
(fn
()
(let
((left (parse-atom)))
(if
(nil? left)
nil
(let ((left2 (parse-poss left))) (parse-cmp left2))))))
(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
()
(if
(= (tp-type) "number")
(let
((tok (adv!)))
(list (quote wait) (parse-dur (get tok "value"))))
(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 (parse-expr)))
(let
((fmt (if (match-kw "as") (get (adv!) "value") "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))))
(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)))
(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
((event-name (get (adv!) "value")))
(let
((flt (if (= (tp-type) "bracket-open") (do (adv!) (let ((expr (parse-expr))) (if (= (tp-type) "bracket-close") (adv!) nil) expr)) 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 source (append parts (list :from source)) parts)))
(let
((parts (if flt (append parts (list :filter flt)) 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)))
(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))))
Reference in New Issue View Git Blame Copy Permalink