diff --git a/lib/hyperscript/compiler.sx b/lib/hyperscript/compiler.sx index c7549d51..c64ed966 100644 --- a/lib/hyperscript/compiler.sx +++ b/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)))) \ No newline at end of file diff --git a/lib/hyperscript/parser.sx b/lib/hyperscript/parser.sx index 0c337953..9189569d 100644 --- a/lib/hyperscript/parser.sx +++ b/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)))) diff --git a/shared/static/wasm/sx/hs-compiler.sx b/shared/static/wasm/sx/hs-compiler.sx index c7549d51..c64ed966 100644 --- a/shared/static/wasm/sx/hs-compiler.sx +++ b/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)))) \ No newline at end of file diff --git a/shared/static/wasm/sx/hs-parser.sx b/shared/static/wasm/sx/hs-parser.sx index 0c337953..9189569d 100644 --- a/shared/static/wasm/sx/hs-parser.sx +++ b/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))))