HS: parser attaches source spans to AST nodes

lib/hyperscript/compiler.sx

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

lib/hyperscript/parser.sx

@@ -21,6 +21,15 @@
         adv!
         (fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
       (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
         match-kw
         (fn
@@ -69,19 +78,28 @@
         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))))
+          (let
+            ((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start)))
+              (base-line (if (and (dict? base) (get base :hs-ast)) (get base :line) (cur-line))))
             (if
-              (= (tp-type) "paren-open")
+              (and (= (tp-type) "class") (not (at-end?)))
               (let
-                ((args (parse-call-args)))
-                (parse-prop-chain (list (quote method-call) base args)))
-              base))))
+                ((prop (tp-val)))
+                (do
+                  (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
         parse-trav
         (fn
@@ -124,8 +142,12 @@
           (let
             ((typ (tp-type)) (val (tp-val)))
             (cond
-              ((= typ "number") (do (adv!) (parse-dur val)))
-              ((= typ "string") (do (adv!) val))
+              ((= typ "number")
+                (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)))
               ((and (= typ "keyword") (= val "true")) (do (adv!) true))
               ((and (= typ "keyword") (= val "false")) (do (adv!) false))
@@ -190,19 +212,23 @@
               ((and (= typ "keyword") (= val "last"))
                 (do (adv!) (parse-pos-kw (quote last))))
               ((= 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")
-                (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))))
+                (let ((s (cur-start)) (l (cur-line)))
+                  (do
+                    (adv!)
+                    (hs-ast-wrap
+                      (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))
+                      "selector" s (prev-end) l {}))))
               ((= typ "attr")
                 (do (adv!) (list (quote attr) val (list (quote me)))))
               ((= typ "style")
@@ -219,8 +245,11 @@
                       (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)))
+                (let ((s (cur-start)) (l (cur-line)))
+                  (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")
                 (do
                   (adv!)
@@ -2021,7 +2050,11 @@
                   ((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)))))
+                    (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))))
       (define
         parse-the-expr
@@ -2421,7 +2454,15 @@
               ((and (= typ "keyword") (= val "put"))
                 (do (adv!) (parse-put-cmd)))
               ((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"))
                 (do (adv!) (parse-wait-cmd)))
               ((and (= typ "keyword") (= val "send"))
@@ -2429,7 +2470,8 @@
               ((and (= typ "keyword") (= val "trigger"))
                 (do (adv!) (parse-trigger-cmd)))
               ((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"))
                 (do (adv!) (parse-inc-cmd)))
               ((and (= typ "keyword") (= val "decrement"))
@@ -2469,7 +2511,8 @@
               ((and (= typ "keyword") (= val "tell"))
                 (do (adv!) (parse-tell-cmd)))
               ((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"))
                 (do (adv!) (parse-make-cmd)))
               ((and (= typ "keyword") (= val "install"))
@@ -2591,13 +2634,31 @@
                       (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
+              link-next-cmds
+              (fn
+                (cmds-list)
+                (define
+                  loop
+                  (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
         parse-on-feat
         (fn
@@ -2767,4 +2828,12 @@
           (first features)
           (cons (quote do) features))))))
 
+(define hs-span-mode false)
+
 (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))))

shared/static/wasm/sx/hs-compiler.sx

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

shared/static/wasm/sx/hs-parser.sx

@@ -21,6 +21,15 @@
         adv!
         (fn () (let ((t (nth tokens p))) (set! p (+ p 1)) t)))
       (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
         match-kw
         (fn
@@ -69,19 +78,28 @@
         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))))
+          (let
+            ((base-start (if (and (dict? base) (get base :hs-ast)) (get base :start) (cur-start)))
+              (base-line (if (and (dict? base) (get base :hs-ast)) (get base :line) (cur-line))))
             (if
-              (= (tp-type) "paren-open")
+              (and (= (tp-type) "class") (not (at-end?)))
               (let
-                ((args (parse-call-args)))
-                (parse-prop-chain (list (quote method-call) base args)))
-              base))))
+                ((prop (tp-val)))
+                (do
+                  (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
         parse-trav
         (fn
@@ -124,8 +142,12 @@
           (let
             ((typ (tp-type)) (val (tp-val)))
             (cond
-              ((= typ "number") (do (adv!) (parse-dur val)))
-              ((= typ "string") (do (adv!) val))
+              ((= typ "number")
+                (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)))
               ((and (= typ "keyword") (= val "true")) (do (adv!) true))
               ((and (= typ "keyword") (= val "false")) (do (adv!) false))
@@ -190,19 +212,23 @@
               ((and (= typ "keyword") (= val "last"))
                 (do (adv!) (parse-pos-kw (quote last))))
               ((= 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")
-                (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))))
+                (let ((s (cur-start)) (l (cur-line)))
+                  (do
+                    (adv!)
+                    (hs-ast-wrap
+                      (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))
+                      "selector" s (prev-end) l {}))))
               ((= typ "attr")
                 (do (adv!) (list (quote attr) val (list (quote me)))))
               ((= typ "style")
@@ -219,8 +245,11 @@
                       (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)))
+                (let ((s (cur-start)) (l (cur-line)))
+                  (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")
                 (do
                   (adv!)
@@ -2021,7 +2050,11 @@
                   ((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)))))
+                    (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))))
       (define
         parse-the-expr
@@ -2421,7 +2454,15 @@
               ((and (= typ "keyword") (= val "put"))
                 (do (adv!) (parse-put-cmd)))
               ((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"))
                 (do (adv!) (parse-wait-cmd)))
               ((and (= typ "keyword") (= val "send"))
@@ -2429,7 +2470,8 @@
               ((and (= typ "keyword") (= val "trigger"))
                 (do (adv!) (parse-trigger-cmd)))
               ((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"))
                 (do (adv!) (parse-inc-cmd)))
               ((and (= typ "keyword") (= val "decrement"))
@@ -2469,7 +2511,8 @@
               ((and (= typ "keyword") (= val "tell"))
                 (do (adv!) (parse-tell-cmd)))
               ((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"))
                 (do (adv!) (parse-make-cmd)))
               ((and (= typ "keyword") (= val "install"))
@@ -2591,13 +2634,31 @@
                       (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
+              link-next-cmds
+              (fn
+                (cmds-list)
+                (define
+                  loop
+                  (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
         parse-on-feat
         (fn
@@ -2767,4 +2828,12 @@
           (first features)
           (cons (quote do) features))))))
 
+(define hs-span-mode false)
+
 (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))))