coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

HS: parser attaches source spans to AST nodes

Browse Source
This commit is contained in:
giles
2026-04-25 19:09:04 +00:00
parent 20a643806b
commit 9c8da50003
4 changed files with 228 additions and 88 deletions
Download Patch File Download Diff File Expand all files Collapse all files

13
lib/hyperscript/compiler.sx
View File

@@ -789,11 +789,12 @@
(cons (quote do) (map hs-to-sx body))))))) (cons (quote do) (map hs-to-sx body)))))))
(fn (fn
(ast) (ast)
(cond (let ((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
((nil? ast) nil) (cond
((number? ast) ast) ((nil? ast) nil)
((string? ast) ast) ((number? ast) ast)
((boolean? ast) ast) ((string? ast) ast)
((boolean? ast) ast)
((and (symbol? ast) (= (str ast) "sender")) ((and (symbol? ast) (= (str ast) "sender"))
(list (quote hs-sender) (quote event))) (list (quote hs-sender) (quote event)))
((not (list? ast)) ast) ((not (list? ast)) ast)
@@ -2207,7 +2208,7 @@
(list (quote hs-halt!) (quote event) (nth ast 1))) (list (quote hs-halt!) (quote event) (nth ast 1)))
((= head (quote focus!)) ((= head (quote focus!))
(list (quote dom-focus) (hs-to-sx (nth ast 1)))) (list (quote dom-focus) (hs-to-sx (nth ast 1))))
(true ast)))))))) (true ast)))))))))
;; ── Convenience: source → SX ───────────────────────────────── ;; ── Convenience: source → SX ─────────────────────────────────
(define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src)))) (define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src))))

145
lib/hyperscript/parser.sx
View File

@@ -21,6 +21,15 @@
adv! adv!
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t))) (fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof")))) (define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
(define cur-start (fn () (if (< p tok-len) (get (tp) "pos") 0)))
(define cur-line (fn () (if (< p tok-len) (get (tp) "line") 1)))
(define prev-end (fn () (if (> p 0) (get (nth tokens (- p 1)) "end") 0)))
(define hs-ast-wrap
(fn (raw kind start end-pos line fields)
(if hs-span-mode
{:hs-ast true :kind kind :start start :end end-pos :line line
:src src :children raw :fields fields}
raw)))
(define (define
match-kw match-kw
(fn (fn
@@ -69,19 +78,28 @@
parse-prop-chain parse-prop-chain
(fn (fn
(base) (base)
(if (let
(and (= (tp-type) "class") (not (at-end?))) ((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start)))
(let (base-line (if (and (dict? base) (get base :hs-ast)) (get base :line) (cur-line))))
((prop (tp-val)))
(do
(adv!)
(parse-prop-chain (list (make-symbol ".") base prop))))
(if (if
(= (tp-type) "paren-open") (and (= (tp-type) "class") (not (at-end?)))
(let (let
((args (parse-call-args))) ((prop (tp-val)))
(parse-prop-chain (list (quote method-call) base args))) (do
base)))) (adv!)
(parse-prop-chain
(hs-ast-wrap
(list (make-symbol ".") base prop)
"member" base-start (prev-end) base-line {:root base}))))
(if
(= (tp-type) "paren-open")
(let
((args (parse-call-args)))
(parse-prop-chain
(hs-ast-wrap
(list (quote method-call) base args)
"call" base-start (prev-end) base-line {:root base})))
base)))))
(define (define
parse-trav parse-trav
(fn (fn
@@ -124,8 +142,12 @@
(let (let
((typ (tp-type)) (val (tp-val))) ((typ (tp-type)) (val (tp-val)))
(cond (cond
((= typ "number") (do (adv!) (parse-dur val))) ((= typ "number")
((= typ "string") (do (adv!) val)) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-dur val) "number" s (prev-end) l {}))))
((= typ "string")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap val "string" s (prev-end) l {}))))
((= typ "template") (do (adv!) (list (quote template) val))) ((= typ "template") (do (adv!) (list (quote template) val)))
((and (= typ "keyword") (= val "true")) (do (adv!) true)) ((and (= typ "keyword") (= val "true")) (do (adv!) true))
((and (= typ "keyword") (= val "false")) (do (adv!) false)) ((and (= typ "keyword") (= val "false")) (do (adv!) false))
@@ -190,19 +212,23 @@
((and (= typ "keyword") (= val "last")) ((and (= typ "keyword") (= val "last"))
(do (adv!) (parse-pos-kw (quote last)))) (do (adv!) (parse-pos-kw (quote last))))
((= typ "id") ((= typ "id")
(do (adv!) (list (quote query) (str "#" val)))) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote query) (str "#" val)) "selector" s (prev-end) l {}))))
((= typ "selector") ((= typ "selector")
(do (let ((s (cur-start)) (l (cur-line)))
(adv!) (do
(if (adv!)
(and (= (tp-type) "keyword") (= (tp-val) "in")) (hs-ast-wrap
(do (if
(adv!) (and (= (tp-type) "keyword") (= (tp-val) "in"))
(list (do
(quote query-scoped) (adv!)
val (list
(parse-cmp (parse-arith (parse-poss (parse-atom)))))) (quote query-scoped)
(list (quote query) val)))) val
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
(list (quote query) val))
"selector" s (prev-end) l {}))))
((= typ "attr") ((= typ "attr")
(do (adv!) (list (quote attr) val (list (quote me))))) (do (adv!) (list (quote attr) val (list (quote me)))))
((= typ "style") ((= typ "style")
@@ -219,8 +245,11 @@
(adv!) (adv!)
(list (quote dom-ref) name (list (quote me))))))) (list (quote dom-ref) name (list (quote me)))))))
((= typ "class") ((= typ "class")
(do (adv!) (list (quote query) (str "." val)))) (let ((s (cur-start)) (l (cur-line)))
((= typ "ident") (do (adv!) (list (quote ref) val))) (do (adv!) (hs-ast-wrap (list (quote query) (str "." val)) "selector" s (prev-end) l {}))))
((= typ "ident")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote ref) val) "ref" s (prev-end) l {}))))
((= typ "paren-open") ((= typ "paren-open")
(do (do
(adv!) (adv!)
@@ -2021,7 +2050,11 @@
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%"))))) ((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%")))))
(let (let
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a))))) ((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
(parse-arith (list op left right))))) (let
((lhs-start (if (and (dict? left) (get left :hs-ast)) (get left :start) 0))
(lhs-line (if (and (dict? left) (get left :hs-ast)) (get left :line) 1)))
(parse-arith
(hs-ast-wrap (list op left right) "arith" lhs-start (prev-end) lhs-line {:lhs left :rhs right}))))))
left)))) left))))
(define (define
parse-the-expr parse-the-expr
@@ -2421,7 +2454,15 @@
((and (= typ "keyword") (= val "put")) ((and (= typ "keyword") (= val "put"))
(do (adv!) (parse-put-cmd))) (do (adv!) (parse-put-cmd)))
((and (= typ "keyword") (= val "if")) ((and (= typ "keyword") (= val "if"))
(do (adv!) (parse-if-cmd))) (let ((s (cur-start)) (l (cur-line)))
(do
(adv!)
(let ((r (parse-if-cmd)))
(let ((tb (if (and (list? r) (> (len r) 2)) (nth r 2) nil)))
(hs-ast-wrap r "if" s (prev-end) l
(if tb
{:true-branch (if (and (list? tb) (= (first tb) (quote do))) (nth tb 1) tb)}
{})))))))
((and (= typ "keyword") (= val "wait")) ((and (= typ "keyword") (= val "wait"))
(do (adv!) (parse-wait-cmd))) (do (adv!) (parse-wait-cmd)))
((and (= typ "keyword") (= val "send")) ((and (= typ "keyword") (= val "send"))
@@ -2429,7 +2470,8 @@
((and (= typ "keyword") (= val "trigger")) ((and (= typ "keyword") (= val "trigger"))
(do (adv!) (parse-trigger-cmd))) (do (adv!) (parse-trigger-cmd)))
((and (= typ "keyword") (= val "log")) ((and (= typ "keyword") (= val "log"))
(do (adv!) (parse-log-cmd))) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-log-cmd) "cmd" s (prev-end) l {}))))
((and (= typ "keyword") (= val "increment")) ((and (= typ "keyword") (= val "increment"))
(do (adv!) (parse-inc-cmd))) (do (adv!) (parse-inc-cmd)))
((and (= typ "keyword") (= val "decrement")) ((and (= typ "keyword") (= val "decrement"))
@@ -2469,7 +2511,8 @@
((and (= typ "keyword") (= val "tell")) ((and (= typ "keyword") (= val "tell"))
(do (adv!) (parse-tell-cmd))) (do (adv!) (parse-tell-cmd)))
((and (= typ "keyword") (= val "for")) ((and (= typ "keyword") (= val "for"))
(do (adv!) (parse-for-cmd))) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-for-cmd) "cmd" s (prev-end) l {}))))
((and (= typ "keyword") (= val "make")) ((and (= typ "keyword") (= val "make"))
(do (adv!) (parse-make-cmd))) (do (adv!) (parse-make-cmd)))
((and (= typ "keyword") (= val "install")) ((and (= typ "keyword") (= val "install"))
@@ -2591,13 +2634,31 @@
(true acc2))))))) (true acc2)))))))
(let (let
((cmds (cl-collect (list)))) ((cmds (cl-collect (list))))
(cond (define
((= (len cmds) 0) nil) link-next-cmds
((= (len cmds) 1) (first cmds)) (fn
(true (cmds-list)
(cons (define
(quote do) loop
(filter (fn (c) (not (= c (quote __then__)))) cmds))))))) (fn
(i)
(when (< i (- (len cmds-list) 1))
(let
((cur-node (nth cmds-list i)) (nxt-node (nth cmds-list (+ i 1))))
(when (and (dict? cur-node) (get cur-node :hs-ast))
(dict-set! (get cur-node :fields) "next" nxt-node)))
(loop (+ i 1)))))
(loop 0)
cmds-list))
(let
((linked (if hs-span-mode (link-next-cmds cmds) cmds)))
(cond
((= (len linked) 0) nil)
((= (len linked) 1) (first linked))
(true
(cons
(quote do)
(filter (fn (c) (not (= c (quote __then__)))) linked))))))))
(define (define
parse-on-feat parse-on-feat
(fn (fn
@@ -2767,4 +2828,12 @@
(first features) (first features)
(cons (quote do) features)))))) (cons (quote do) features))))))
(define hs-span-mode false)
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src))) (define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
(define hs-parse-ast
(fn (src)
(set! hs-span-mode true)
(let ((result (hs-parse (hs-tokenize src) src)))
(do (set! hs-span-mode false) result))))

13
shared/static/wasm/sx/hs-compiler.sx
View File

@@ -789,11 +789,12 @@
(cons (quote do) (map hs-to-sx body))))))) (cons (quote do) (map hs-to-sx body)))))))
(fn (fn
(ast) (ast)
(cond (let ((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
((nil? ast) nil) (cond
((number? ast) ast) ((nil? ast) nil)
((string? ast) ast) ((number? ast) ast)
((boolean? ast) ast) ((string? ast) ast)
((boolean? ast) ast)
((and (symbol? ast) (= (str ast) "sender")) ((and (symbol? ast) (= (str ast) "sender"))
(list (quote hs-sender) (quote event))) (list (quote hs-sender) (quote event)))
((not (list? ast)) ast) ((not (list? ast)) ast)
@@ -2207,7 +2208,7 @@
(list (quote hs-halt!) (quote event) (nth ast 1))) (list (quote hs-halt!) (quote event) (nth ast 1)))
((= head (quote focus!)) ((= head (quote focus!))
(list (quote dom-focus) (hs-to-sx (nth ast 1)))) (list (quote dom-focus) (hs-to-sx (nth ast 1))))
(true ast)))))))) (true ast)))))))))
;; ── Convenience: source → SX ───────────────────────────────── ;; ── Convenience: source → SX ─────────────────────────────────
(define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src)))) (define hs-to-sx-from-source (fn (src) (hs-to-sx (hs-compile src))))

145
shared/static/wasm/sx/hs-parser.sx
View File

@@ -21,6 +21,15 @@
adv! adv!
(fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t))) (fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
(define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof")))) (define at-end? (fn () (or (>= p tok-len) (= (tp-type) "eof"))))
(define cur-start (fn () (if (< p tok-len) (get (tp) "pos") 0)))
(define cur-line (fn () (if (< p tok-len) (get (tp) "line") 1)))
(define prev-end (fn () (if (> p 0) (get (nth tokens (- p 1)) "end") 0)))
(define hs-ast-wrap
(fn (raw kind start end-pos line fields)
(if hs-span-mode
{:hs-ast true :kind kind :start start :end end-pos :line line
:src src :children raw :fields fields}
raw)))
(define (define
match-kw match-kw
(fn (fn
@@ -69,19 +78,28 @@
parse-prop-chain parse-prop-chain
(fn (fn
(base) (base)
(if (let
(and (= (tp-type) "class") (not (at-end?))) ((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start)))
(let (base-line (if (and (dict? base) (get base :hs-ast)) (get base :line) (cur-line))))
((prop (tp-val)))
(do
(adv!)
(parse-prop-chain (list (make-symbol ".") base prop))))
(if (if
(= (tp-type) "paren-open") (and (= (tp-type) "class") (not (at-end?)))
(let (let
((args (parse-call-args))) ((prop (tp-val)))
(parse-prop-chain (list (quote method-call) base args))) (do
base)))) (adv!)
(parse-prop-chain
(hs-ast-wrap
(list (make-symbol ".") base prop)
"member" base-start (prev-end) base-line {:root base}))))
(if
(= (tp-type) "paren-open")
(let
((args (parse-call-args)))
(parse-prop-chain
(hs-ast-wrap
(list (quote method-call) base args)
"call" base-start (prev-end) base-line {:root base})))
base)))))
(define (define
parse-trav parse-trav
(fn (fn
@@ -124,8 +142,12 @@
(let (let
((typ (tp-type)) (val (tp-val))) ((typ (tp-type)) (val (tp-val)))
(cond (cond
((= typ "number") (do (adv!) (parse-dur val))) ((= typ "number")
((= typ "string") (do (adv!) val)) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-dur val) "number" s (prev-end) l {}))))
((= typ "string")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap val "string" s (prev-end) l {}))))
((= typ "template") (do (adv!) (list (quote template) val))) ((= typ "template") (do (adv!) (list (quote template) val)))
((and (= typ "keyword") (= val "true")) (do (adv!) true)) ((and (= typ "keyword") (= val "true")) (do (adv!) true))
((and (= typ "keyword") (= val "false")) (do (adv!) false)) ((and (= typ "keyword") (= val "false")) (do (adv!) false))
@@ -190,19 +212,23 @@
((and (= typ "keyword") (= val "last")) ((and (= typ "keyword") (= val "last"))
(do (adv!) (parse-pos-kw (quote last)))) (do (adv!) (parse-pos-kw (quote last))))
((= typ "id") ((= typ "id")
(do (adv!) (list (quote query) (str "#" val)))) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote query) (str "#" val)) "selector" s (prev-end) l {}))))
((= typ "selector") ((= typ "selector")
(do (let ((s (cur-start)) (l (cur-line)))
(adv!) (do
(if (adv!)
(and (= (tp-type) "keyword") (= (tp-val) "in")) (hs-ast-wrap
(do (if
(adv!) (and (= (tp-type) "keyword") (= (tp-val) "in"))
(list (do
(quote query-scoped) (adv!)
val (list
(parse-cmp (parse-arith (parse-poss (parse-atom)))))) (quote query-scoped)
(list (quote query) val)))) val
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
(list (quote query) val))
"selector" s (prev-end) l {}))))
((= typ "attr") ((= typ "attr")
(do (adv!) (list (quote attr) val (list (quote me))))) (do (adv!) (list (quote attr) val (list (quote me)))))
((= typ "style") ((= typ "style")
@@ -219,8 +245,11 @@
(adv!) (adv!)
(list (quote dom-ref) name (list (quote me))))))) (list (quote dom-ref) name (list (quote me)))))))
((= typ "class") ((= typ "class")
(do (adv!) (list (quote query) (str "." val)))) (let ((s (cur-start)) (l (cur-line)))
((= typ "ident") (do (adv!) (list (quote ref) val))) (do (adv!) (hs-ast-wrap (list (quote query) (str "." val)) "selector" s (prev-end) l {}))))
((= typ "ident")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote ref) val) "ref" s (prev-end) l {}))))
((= typ "paren-open") ((= typ "paren-open")
(do (do
(adv!) (adv!)
@@ -2021,7 +2050,11 @@
((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%"))))) ((op (cond ((= val "+") (quote +)) ((= val "-") (quote -)) ((= val "*") (quote *)) ((= val "/") (quote /)) ((or (= val "%") (= val "mod")) (make-symbol "%")))))
(let (let
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a))))) ((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
(parse-arith (list op left right))))) (let
((lhs-start (if (and (dict? left) (get left :hs-ast)) (get left :start) 0))
(lhs-line (if (and (dict? left) (get left :hs-ast)) (get left :line) 1)))
(parse-arith
(hs-ast-wrap (list op left right) "arith" lhs-start (prev-end) lhs-line {:lhs left :rhs right}))))))
left)))) left))))
(define (define
parse-the-expr parse-the-expr
@@ -2421,7 +2454,15 @@
((and (= typ "keyword") (= val "put")) ((and (= typ "keyword") (= val "put"))
(do (adv!) (parse-put-cmd))) (do (adv!) (parse-put-cmd)))
((and (= typ "keyword") (= val "if")) ((and (= typ "keyword") (= val "if"))
(do (adv!) (parse-if-cmd))) (let ((s (cur-start)) (l (cur-line)))
(do
(adv!)
(let ((r (parse-if-cmd)))
(let ((tb (if (and (list? r) (> (len r) 2)) (nth r 2) nil)))
(hs-ast-wrap r "if" s (prev-end) l
(if tb
{:true-branch (if (and (list? tb) (= (first tb) (quote do))) (nth tb 1) tb)}
{})))))))
((and (= typ "keyword") (= val "wait")) ((and (= typ "keyword") (= val "wait"))
(do (adv!) (parse-wait-cmd))) (do (adv!) (parse-wait-cmd)))
((and (= typ "keyword") (= val "send")) ((and (= typ "keyword") (= val "send"))
@@ -2429,7 +2470,8 @@
((and (= typ "keyword") (= val "trigger")) ((and (= typ "keyword") (= val "trigger"))
(do (adv!) (parse-trigger-cmd))) (do (adv!) (parse-trigger-cmd)))
((and (= typ "keyword") (= val "log")) ((and (= typ "keyword") (= val "log"))
(do (adv!) (parse-log-cmd))) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-log-cmd) "cmd" s (prev-end) l {}))))
((and (= typ "keyword") (= val "increment")) ((and (= typ "keyword") (= val "increment"))
(do (adv!) (parse-inc-cmd))) (do (adv!) (parse-inc-cmd)))
((and (= typ "keyword") (= val "decrement")) ((and (= typ "keyword") (= val "decrement"))
@@ -2469,7 +2511,8 @@
((and (= typ "keyword") (= val "tell")) ((and (= typ "keyword") (= val "tell"))
(do (adv!) (parse-tell-cmd))) (do (adv!) (parse-tell-cmd)))
((and (= typ "keyword") (= val "for")) ((and (= typ "keyword") (= val "for"))
(do (adv!) (parse-for-cmd))) (let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-for-cmd) "cmd" s (prev-end) l {}))))
((and (= typ "keyword") (= val "make")) ((and (= typ "keyword") (= val "make"))
(do (adv!) (parse-make-cmd))) (do (adv!) (parse-make-cmd)))
((and (= typ "keyword") (= val "install")) ((and (= typ "keyword") (= val "install"))
@@ -2591,13 +2634,31 @@
(true acc2))))))) (true acc2)))))))
(let (let
((cmds (cl-collect (list)))) ((cmds (cl-collect (list))))
(cond (define
((= (len cmds) 0) nil) link-next-cmds
((= (len cmds) 1) (first cmds)) (fn
(true (cmds-list)
(cons (define
(quote do) loop
(filter (fn (c) (not (= c (quote __then__)))) cmds))))))) (fn
(i)
(when (< i (- (len cmds-list) 1))
(let
((cur-node (nth cmds-list i)) (nxt-node (nth cmds-list (+ i 1))))
(when (and (dict? cur-node) (get cur-node :hs-ast))
(dict-set! (get cur-node :fields) "next" nxt-node)))
(loop (+ i 1)))))
(loop 0)
cmds-list))
(let
((linked (if hs-span-mode (link-next-cmds cmds) cmds)))
(cond
((= (len linked) 0) nil)
((= (len linked) 1) (first linked))
(true
(cons
(quote do)
(filter (fn (c) (not (= c (quote __then__)))) linked))))))))
(define (define
parse-on-feat parse-on-feat
(fn (fn
@@ -2767,4 +2828,12 @@
(first features) (first features)
(cons (quote do) features)))))) (cons (quote do) features))))))
(define hs-span-mode false)
(define hs-compile (fn (src) (hs-parse (hs-tokenize src) src))) (define hs-compile (fn (src) (hs-parse (hs-tokenize src) src)))
(define hs-parse-ast
(fn (src)
(set! hs-span-mode true)
(let ((result (hs-parse (hs-tokenize src) src)))
(do (set! hs-span-mode false) result))))