HS: tell uses beingTold implicit target, preserves me (+3 tests)

tell now rebinds beingTold/you/yourself without overwriting me.
Parser implicit targets use beingTold; handler wrapper seeds beingTold=me.
Fixes: attributes refer to the thing being told, does not overwrite me,
your symbol represents the thing being told.

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
2026-04-26 13:38:19 +00:00
parent 835fffb834
commit 11ee71d846
6 changed files with 3220 additions and 2874 deletions

View File

@@ -789,7 +789,8 @@
(cons (quote do) (map hs-to-sx body)))))))
(fn
(ast)
(let ((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
(let
((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
(cond
((nil? ast) nil)
((number? ast) ast)
@@ -910,7 +911,8 @@
(append
parts
(list
(hs-to-sx (hs-compile expr-src)))))
(hs-to-sx
(hs-compile expr-src)))))
(set! i (+ close 1))
(tpl-collect)))))
(let
@@ -1081,6 +1083,7 @@
body
(list (quote fn) params body))))
((= head (quote me)) (quote me))
((= head (quote beingTold)) (quote beingTold))
((= head (quote it)) (quote it))
((= head (quote event)) (quote event))
((= head dot-sym)
@@ -1185,7 +1188,10 @@
((left (nth ast 1)) (right (nth ast 2)))
(if
(and (list? right) (= (first right) (quote query)))
(list (quote hs-matches?) (hs-to-sx left) (nth right 1))
(list
(quote hs-matches?)
(hs-to-sx left)
(nth right 1))
(list
(quote hs-matches?)
(hs-to-sx left)
@@ -1236,7 +1242,10 @@
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote as))
(list (quote hs-coerce) (hs-to-sx (nth ast 1)) (nth ast 2)))
(list
(quote hs-coerce)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote in?))
(list
(quote hs-in?)
@@ -1313,19 +1322,27 @@
((= head (quote last))
(if
(> (len ast) 2)
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1))
(list
(quote hs-last)
(hs-to-sx (nth ast 2))
(nth ast 1))
(list (quote hs-query-last) (nth ast 1))))
((= head (quote add-class))
(let
((raw-tgt (nth ast 2)))
(if
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list
(quote for-each)
(list
(quote fn)
(list (quote _el))
(list (quote dom-add-class) (quote _el) (nth ast 1)))
(list
(quote dom-add-class)
(quote _el)
(nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1)))
(list
(quote dom-add-class)
@@ -1345,7 +1362,11 @@
(map
(fn
(p)
(list (quote dom-set-style) tgt (first p) (nth p 1)))
(list
(quote dom-set-style)
tgt
(first p)
(nth p 1)))
pairs))))
((= head (quote multi-add-class))
(let
@@ -1381,7 +1402,10 @@
(quote set!)
(quote the-result)
(quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched))
(list
(quote set!)
(quote it)
(quote __hs-matched))
(list
(quote for-each)
(list
@@ -1416,7 +1440,10 @@
(quote set!)
(quote the-result)
(quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched))
(list
(quote set!)
(quote it)
(quote __hs-matched))
(list
(quote for-each)
(list
@@ -1436,13 +1463,17 @@
(cons
(quote do)
(map
(fn (cls) (list (quote dom-remove-class) target cls))
(fn
(cls)
(list (quote dom-remove-class) target cls))
classes))))
((= head (quote remove-class))
(let
((raw-tgt (nth ast 2)))
(if
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list
(quote for-each)
(list
@@ -1463,7 +1494,8 @@
(cond
((and (list? tgt) (= (first tgt) (quote array-index)))
(let
((coll (nth tgt 1)) (idx (hs-to-sx (nth tgt 2))))
((coll (nth tgt 1))
(idx (hs-to-sx (nth tgt 2))))
(emit-set
coll
(list (quote hs-splice-at!) (hs-to-sx coll) idx))))
@@ -1472,7 +1504,10 @@
((obj (nth tgt 1)) (prop (nth tgt 2)))
(emit-set
obj
(list (quote hs-dict-without) (hs-to-sx obj) prop))))
(list
(quote hs-dict-without)
(hs-to-sx obj)
prop))))
((and (list? tgt) (= (first tgt) (quote of)))
(let
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2)))
@@ -1669,8 +1704,13 @@
((and (or (= pos "end") (= pos "start")) (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref))))
(emit-set
raw-tgt
(list (quote hs-put-at!) val pos (hs-to-sx raw-tgt))))
(true (list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
(list
(quote hs-put-at!)
val
pos
(hs-to-sx raw-tgt))))
(true
(list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
((= head (quote if))
(if
(> (len ast) 3)
@@ -1833,7 +1873,10 @@
(list (quote fn) (list) (hs-to-sx (nth ast 1)))
(list (quote fn) (list) (hs-to-sx (nth ast 2)))))
((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
(list
(quote hs-fetch)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote fetch-gql))
(list
(quote hs-fetch-gql)
@@ -1860,7 +1903,9 @@
((val (nth ast 1)))
(if
(nil? val)
(list (quote raise) (list (quote list) "hs-return" nil))
(list
(quote raise)
(list (quote list) "hs-return" nil))
(list
(quote raise)
(list (quote list) "hs-return" (hs-to-sx val))))))
@@ -1878,7 +1923,10 @@
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote answer))
@@ -1889,7 +1937,10 @@
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote answer-alert))
@@ -1900,7 +1951,10 @@
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote __get-cmd))
@@ -1911,7 +1965,10 @@
(list (list (quote __hs-g) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-g))
(list
(quote set!)
(quote the-result)
(quote __hs-g))
(list (quote set!) (quote it) (quote __hs-g))
(quote __hs-g)))))
((= head (quote append!))
@@ -1934,7 +1991,7 @@
(list
(quote let)
(list
(list (quote me) tgt)
(list (quote beingTold) tgt)
(list (quote you) tgt)
(list (quote yourself) tgt))
(hs-to-sx (nth ast 2)))))
@@ -2202,7 +2259,10 @@
(list
(quote hs-is)
(hs-to-sx (nth ast 1))
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2)))
(list
(quote fn)
(list)
(hs-to-sx (nth (nth ast 2) 2)))
(nth ast 3)))
((= head (quote halt!))
(list (quote hs-halt!) (quote event) (nth ast 1)))

View File

@@ -19,6 +19,7 @@
(define
reserved
(list
(quote beingTold)
(quote me)
(quote it)
(quote event)
@@ -65,7 +66,10 @@
(list (quote me))
(list
(quote let)
(list (list (quote it) nil) (list (quote event) nil))
(list
(list (quote beingTold) (quote me))
(list (quote it) nil)
(list (quote event) nil))
guarded))))))))))
;; ── Activate a single element ───────────────────────────────────

View File

@@ -23,13 +23,14 @@
(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
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 {:children raw :end end-pos :kind kind :line line :src src :start start :hs-ast true :fields fields} raw)))
(define
match-kw
(fn
@@ -80,7 +81,11 @@
(base)
(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))))
(base-line
(if
(and (dict? base) (get base :hs-ast))
(get base :line)
(cur-line))))
(if
(and (= (tp-type) "class") (not (at-end?)))
(let
@@ -90,7 +95,11 @@
(parse-prop-chain
(hs-ast-wrap
(list (make-symbol ".") base prop)
"member" base-start (prev-end) base-line {:root base}))))
"member"
base-start
(prev-end)
base-line
{:root base}))))
(if
(= (tp-type) "paren-open")
(let
@@ -98,7 +107,11 @@
(parse-prop-chain
(hs-ast-wrap
(list (quote method-call) base args)
"call" base-start (prev-end) base-line {:root base})))
"call"
base-start
(prev-end)
base-line
{:root base})))
base)))))
(define
parse-trav
@@ -110,19 +123,23 @@
((and (= kind (quote closest)) (= typ "ident") (= val "parent"))
(do (adv!) (parse-trav (quote closest-parent))))
((= typ "selector")
(do (adv!) (list kind val (list (quote me)))))
(do (adv!) (list kind val (list (quote beingTold)))))
((= typ "class")
(do (adv!) (list kind (str "." val) (list (quote me)))))
(do
(adv!)
(list kind (str "." val) (list (quote beingTold)))))
((= typ "id")
(do (adv!) (list kind (str "#" val) (list (quote me)))))
(do
(adv!)
(list kind (str "#" val) (list (quote beingTold)))))
((= typ "attr")
(do
(adv!)
(list
(quote attr)
val
(list kind (str "[" val "]") (list (quote me))))))
(true (list kind "*" (list (quote me))))))))
(list kind (str "[" val "]") (list (quote beingTold))))))
(true (list kind "*" (list (quote beingTold))))))))
(define
parse-pos-kw
(fn
@@ -143,11 +160,23 @@
((typ (tp-type)) (val (tp-val)))
(cond
((= typ "number")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-dur val) "number" s (prev-end) l {}))))
(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 {}))))
(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))
@@ -212,10 +241,20 @@
((and (= typ "keyword") (= val "last"))
(do (adv!) (parse-pos-kw (quote last))))
((= typ "id")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote query) (str "#" val)) "selector" s (prev-end) l {}))))
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(list (quote query) (str "#" val))
"selector"
s
(prev-end)
l
{}))))
((= typ "selector")
(let ((s (cur-start)) (l (cur-line)))
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
@@ -226,16 +265,27 @@
(list
(quote query-scoped)
val
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
(parse-cmp
(parse-arith (parse-poss (parse-atom))))))
(list (quote query) val))
"selector" s (prev-end) l {}))))
"selector"
s
(prev-end)
l
{}))))
((= typ "attr")
(do (adv!) (list (quote attr) val (list (quote me)))))
(do
(adv!)
(list (quote attr) val (list (quote beingTold)))))
((= typ "style")
(do (adv!) (list (quote style) val (list (quote me)))))
(do
(adv!)
(list (quote style) val (list (quote beingTold)))))
((= typ "local") (do (adv!) (list (quote local) val)))
((= typ "hat")
(do (adv!) (list (quote dom-ref) val (list (quote me)))))
(do
(adv!)
(list (quote dom-ref) val (list (quote beingTold)))))
((and (= typ "keyword") (= val "dom"))
(do
(adv!)
@@ -243,13 +293,31 @@
((name (tp-val)))
(do
(adv!)
(list (quote dom-ref) name (list (quote me)))))))
(list (quote dom-ref) name (list (quote beingTold)))))))
((= typ "class")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote query) (str "." val)) "selector" s (prev-end) l {}))))
(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 {}))))
(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!)
@@ -922,7 +990,7 @@
(collect-classes!))))
(collect-classes!)
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
@@ -951,7 +1019,7 @@
(get (adv!) "value")
(parse-expr))))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(list (quote set-style) prop value tgt))))
((= (tp-type) "brace-open")
(do
@@ -977,7 +1045,7 @@
(collect-pairs!)
(when (= (tp-type) "brace-close") (adv!))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(list (quote set-styles) (reverse pairs) tgt)))))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
(do
@@ -989,7 +1057,7 @@
((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
@@ -1007,7 +1075,7 @@
(let
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) "")))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
@@ -1048,7 +1116,7 @@
(collect-classes!))))
(collect-classes!)
(let
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold)))))
(if
(empty? extra-classes)
(list (quote remove-class) cls tgt)
@@ -1059,7 +1127,7 @@
(let
((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold)))))
(list (quote remove-attr) attr-name tgt))))
((and (= (tp-type) "bracket-open") (= (tp-val) "["))
(do
@@ -1121,7 +1189,7 @@
(let
((cls2 (do (let ((v (tp-val))) (adv!) v))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(list (quote toggle-between) cls1 cls2 tgt)))
nil)))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
@@ -1146,7 +1214,7 @@
((v2 (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(if
(= n1 n2)
(list
@@ -1180,7 +1248,7 @@
(let
((extra-classes (collect-classes (list))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(cond
((> (len extra-classes) 0)
(list
@@ -1209,7 +1277,7 @@
(let
((prop (get (adv!) "value")))
(let
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "of") (parse-expr) (list (quote beingTold)))))
(if
(match-kw "between")
(let
@@ -1280,7 +1348,7 @@
(let
((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "on") (parse-expr) (list (quote beingTold)))))
(if
(match-kw "between")
(let
@@ -1305,7 +1373,7 @@
((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do
@@ -1533,7 +1601,7 @@
(let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
(if
dtl
(list (quote send) name dtl tgt)
@@ -1547,7 +1615,7 @@
(let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(if
dtl
(list (quote trigger) name dtl tgt)
@@ -1586,7 +1654,7 @@
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
(let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let
@@ -1597,7 +1665,7 @@
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
(let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let
@@ -2052,9 +2120,19 @@
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
(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)))
(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}))))))
(hs-ast-wrap
(list op left right)
"arith"
lhs-start
(prev-end)
lhs-line
{:rhs right :lhs left}))))))
left))))
(define
parse-the-expr
@@ -2069,21 +2147,21 @@
(if
(match-kw "of")
(list (quote style) val (parse-expr))
(list (quote style) val (list (quote me))))))
(list (quote style) val (list (quote beingTold))))))
((= typ "attr")
(do
(adv!)
(if
(match-kw "of")
(list (quote attr) val (parse-expr))
(list (quote attr) val (list (quote me))))))
(list (quote attr) val (list (quote beingTold))))))
((= typ "class")
(do
(adv!)
(if
(match-kw "of")
(list (quote has-class?) (parse-expr) val)
(list (quote has-class?) (list (quote me)) val))))
(list (quote has-class?) (list (quote beingTold)) val))))
((= typ "selector")
(do
(adv!)
@@ -2231,13 +2309,15 @@
()
(let
((tgt (parse-expr)))
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
(list
(quote measure)
(if (nil? tgt) (list (quote beingTold)) tgt)))))
(define
parse-scroll-cmd
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
(let
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top"))))
(list (quote scroll!) tgt pos)))))
@@ -2246,14 +2326,14 @@
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
(list (quote select!) tgt))))
(define
parse-reset-cmd
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
(list (quote reset!) tgt))))
(define
parse-default-cmd
@@ -2278,7 +2358,7 @@
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote focus!) tgt))))
(define
parse-feat-body
@@ -2392,7 +2472,7 @@
(fn
()
(let
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote empty-target) target))))
(define
parse-swap-cmd
@@ -2417,14 +2497,14 @@
(fn
()
(let
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote open-element) target))))
(define
parse-close-cmd
(fn
()
(let
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote close-element) target))))
(define
parse-cmd
@@ -2454,15 +2534,21 @@
((and (= typ "keyword") (= val "put"))
(do (adv!) (parse-put-cmd)))
((and (= typ "keyword") (= val "if"))
(let ((s (cur-start)) (l (cur-line)))
(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)}
{})))))))
(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"))
@@ -2470,8 +2556,17 @@
((and (= typ "keyword") (= val "trigger"))
(do (adv!) (parse-trigger-cmd)))
((and (= typ "keyword") (= val "log"))
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-log-cmd) "cmd" s (prev-end) l {}))))
(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"))
@@ -2511,8 +2606,17 @@
((and (= typ "keyword") (= val "tell"))
(do (adv!) (parse-tell-cmd)))
((and (= typ "keyword") (= val "for"))
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-for-cmd) "cmd" s (prev-end) l {}))))
(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"))
@@ -2642,10 +2746,13 @@
loop
(fn
(i)
(when (< i (- (len cmds-list) 1))
(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))
((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)
@@ -2810,7 +2917,9 @@
((= val "behavior") (do (adv!) (parse-behavior-feat)))
((= val "live") (do (adv!) (parse-live-feat)))
((= val "when") (do (adv!) (parse-when-feat)))
((= val "worker") (error "worker plugin is not installed — see https://hyperscript.org/features/worker"))
((= val "worker")
(error
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
(true (parse-cmd-list))))))
(define
coll-feats

View File

@@ -789,7 +789,8 @@
(cons (quote do) (map hs-to-sx body)))))))
(fn
(ast)
(let ((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
(let
((ast (if (and (dict? ast) (get ast :hs-ast)) (get ast :children) ast)))
(cond
((nil? ast) nil)
((number? ast) ast)
@@ -910,7 +911,8 @@
(append
parts
(list
(hs-to-sx (hs-compile expr-src)))))
(hs-to-sx
(hs-compile expr-src)))))
(set! i (+ close 1))
(tpl-collect)))))
(let
@@ -1081,6 +1083,7 @@
body
(list (quote fn) params body))))
((= head (quote me)) (quote me))
((= head (quote beingTold)) (quote beingTold))
((= head (quote it)) (quote it))
((= head (quote event)) (quote event))
((= head dot-sym)
@@ -1185,7 +1188,10 @@
((left (nth ast 1)) (right (nth ast 2)))
(if
(and (list? right) (= (first right) (quote query)))
(list (quote hs-matches?) (hs-to-sx left) (nth right 1))
(list
(quote hs-matches?)
(hs-to-sx left)
(nth right 1))
(list
(quote hs-matches?)
(hs-to-sx left)
@@ -1236,7 +1242,10 @@
(hs-to-sx (nth ast 1))
(hs-to-sx (nth ast 2))))
((= head (quote as))
(list (quote hs-coerce) (hs-to-sx (nth ast 1)) (nth ast 2)))
(list
(quote hs-coerce)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote in?))
(list
(quote hs-in?)
@@ -1313,19 +1322,27 @@
((= head (quote last))
(if
(> (len ast) 2)
(list (quote hs-last) (hs-to-sx (nth ast 2)) (nth ast 1))
(list
(quote hs-last)
(hs-to-sx (nth ast 2))
(nth ast 1))
(list (quote hs-query-last) (nth ast 1))))
((= head (quote add-class))
(let
((raw-tgt (nth ast 2)))
(if
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list
(quote for-each)
(list
(quote fn)
(list (quote _el))
(list (quote dom-add-class) (quote _el) (nth ast 1)))
(list
(quote dom-add-class)
(quote _el)
(nth ast 1)))
(list (quote hs-query-all) (nth raw-tgt 1)))
(list
(quote dom-add-class)
@@ -1345,7 +1362,11 @@
(map
(fn
(p)
(list (quote dom-set-style) tgt (first p) (nth p 1)))
(list
(quote dom-set-style)
tgt
(first p)
(nth p 1)))
pairs))))
((= head (quote multi-add-class))
(let
@@ -1381,7 +1402,10 @@
(quote set!)
(quote the-result)
(quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched))
(list
(quote set!)
(quote it)
(quote __hs-matched))
(list
(quote for-each)
(list
@@ -1416,7 +1440,10 @@
(quote set!)
(quote the-result)
(quote __hs-matched))
(list (quote set!) (quote it) (quote __hs-matched))
(list
(quote set!)
(quote it)
(quote __hs-matched))
(list
(quote for-each)
(list
@@ -1436,13 +1463,17 @@
(cons
(quote do)
(map
(fn (cls) (list (quote dom-remove-class) target cls))
(fn
(cls)
(list (quote dom-remove-class) target cls))
classes))))
((= head (quote remove-class))
(let
((raw-tgt (nth ast 2)))
(if
(and (list? raw-tgt) (= (first raw-tgt) (quote query)))
(and
(list? raw-tgt)
(= (first raw-tgt) (quote query)))
(list
(quote for-each)
(list
@@ -1463,7 +1494,8 @@
(cond
((and (list? tgt) (= (first tgt) (quote array-index)))
(let
((coll (nth tgt 1)) (idx (hs-to-sx (nth tgt 2))))
((coll (nth tgt 1))
(idx (hs-to-sx (nth tgt 2))))
(emit-set
coll
(list (quote hs-splice-at!) (hs-to-sx coll) idx))))
@@ -1472,7 +1504,10 @@
((obj (nth tgt 1)) (prop (nth tgt 2)))
(emit-set
obj
(list (quote hs-dict-without) (hs-to-sx obj) prop))))
(list
(quote hs-dict-without)
(hs-to-sx obj)
prop))))
((and (list? tgt) (= (first tgt) (quote of)))
(let
((prop-ast (nth tgt 1)) (obj-ast (nth tgt 2)))
@@ -1669,8 +1704,13 @@
((and (or (= pos "end") (= pos "start")) (list? raw-tgt) (or (= (first raw-tgt) (quote local)) (= (first raw-tgt) (quote ref))))
(emit-set
raw-tgt
(list (quote hs-put-at!) val pos (hs-to-sx raw-tgt))))
(true (list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
(list
(quote hs-put-at!)
val
pos
(hs-to-sx raw-tgt))))
(true
(list (quote hs-put!) val pos (hs-to-sx raw-tgt))))))
((= head (quote if))
(if
(> (len ast) 3)
@@ -1833,7 +1873,10 @@
(list (quote fn) (list) (hs-to-sx (nth ast 1)))
(list (quote fn) (list) (hs-to-sx (nth ast 2)))))
((= head (quote fetch))
(list (quote hs-fetch) (hs-to-sx (nth ast 1)) (nth ast 2)))
(list
(quote hs-fetch)
(hs-to-sx (nth ast 1))
(nth ast 2)))
((= head (quote fetch-gql))
(list
(quote hs-fetch-gql)
@@ -1860,7 +1903,9 @@
((val (nth ast 1)))
(if
(nil? val)
(list (quote raise) (list (quote list) "hs-return" nil))
(list
(quote raise)
(list (quote list) "hs-return" nil))
(list
(quote raise)
(list (quote list) "hs-return" (hs-to-sx val))))))
@@ -1878,7 +1923,10 @@
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote answer))
@@ -1889,7 +1937,10 @@
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote answer-alert))
@@ -1900,7 +1951,10 @@
(list (list (quote __hs-a) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-a))
(list
(quote set!)
(quote the-result)
(quote __hs-a))
(list (quote set!) (quote it) (quote __hs-a))
(quote __hs-a)))))
((= head (quote __get-cmd))
@@ -1911,7 +1965,10 @@
(list (list (quote __hs-g) val))
(list
(quote begin)
(list (quote set!) (quote the-result) (quote __hs-g))
(list
(quote set!)
(quote the-result)
(quote __hs-g))
(list (quote set!) (quote it) (quote __hs-g))
(quote __hs-g)))))
((= head (quote append!))
@@ -1934,7 +1991,7 @@
(list
(quote let)
(list
(list (quote me) tgt)
(list (quote beingTold) tgt)
(list (quote you) tgt)
(list (quote yourself) tgt))
(hs-to-sx (nth ast 2)))))
@@ -2202,7 +2259,10 @@
(list
(quote hs-is)
(hs-to-sx (nth ast 1))
(list (quote fn) (list) (hs-to-sx (nth (nth ast 2) 2)))
(list
(quote fn)
(list)
(hs-to-sx (nth (nth ast 2) 2)))
(nth ast 3)))
((= head (quote halt!))
(list (quote hs-halt!) (quote event) (nth ast 1)))

View File

@@ -19,6 +19,7 @@
(define
reserved
(list
(quote beingTold)
(quote me)
(quote it)
(quote event)
@@ -65,7 +66,10 @@
(list (quote me))
(list
(quote let)
(list (list (quote it) nil) (list (quote event) nil))
(list
(list (quote beingTold) (quote me))
(list (quote it) nil)
(list (quote event) nil))
guarded))))))))))
;; ── Activate a single element ───────────────────────────────────

View File

@@ -23,13 +23,14 @@
(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
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 {:children raw :end end-pos :kind kind :line line :src src :start start :hs-ast true :fields fields} raw)))
(define
match-kw
(fn
@@ -80,7 +81,11 @@
(base)
(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))))
(base-line
(if
(and (dict? base) (get base :hs-ast))
(get base :line)
(cur-line))))
(if
(and (= (tp-type) "class") (not (at-end?)))
(let
@@ -90,7 +95,11 @@
(parse-prop-chain
(hs-ast-wrap
(list (make-symbol ".") base prop)
"member" base-start (prev-end) base-line {:root base}))))
"member"
base-start
(prev-end)
base-line
{:root base}))))
(if
(= (tp-type) "paren-open")
(let
@@ -98,7 +107,11 @@
(parse-prop-chain
(hs-ast-wrap
(list (quote method-call) base args)
"call" base-start (prev-end) base-line {:root base})))
"call"
base-start
(prev-end)
base-line
{:root base})))
base)))))
(define
parse-trav
@@ -110,19 +123,23 @@
((and (= kind (quote closest)) (= typ "ident") (= val "parent"))
(do (adv!) (parse-trav (quote closest-parent))))
((= typ "selector")
(do (adv!) (list kind val (list (quote me)))))
(do (adv!) (list kind val (list (quote beingTold)))))
((= typ "class")
(do (adv!) (list kind (str "." val) (list (quote me)))))
(do
(adv!)
(list kind (str "." val) (list (quote beingTold)))))
((= typ "id")
(do (adv!) (list kind (str "#" val) (list (quote me)))))
(do
(adv!)
(list kind (str "#" val) (list (quote beingTold)))))
((= typ "attr")
(do
(adv!)
(list
(quote attr)
val
(list kind (str "[" val "]") (list (quote me))))))
(true (list kind "*" (list (quote me))))))))
(list kind (str "[" val "]") (list (quote beingTold))))))
(true (list kind "*" (list (quote beingTold))))))))
(define
parse-pos-kw
(fn
@@ -143,11 +160,23 @@
((typ (tp-type)) (val (tp-val)))
(cond
((= typ "number")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-dur val) "number" s (prev-end) l {}))))
(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 {}))))
(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))
@@ -212,10 +241,20 @@
((and (= typ "keyword") (= val "last"))
(do (adv!) (parse-pos-kw (quote last))))
((= typ "id")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote query) (str "#" val)) "selector" s (prev-end) l {}))))
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
(list (quote query) (str "#" val))
"selector"
s
(prev-end)
l
{}))))
((= typ "selector")
(let ((s (cur-start)) (l (cur-line)))
(let
((s (cur-start)) (l (cur-line)))
(do
(adv!)
(hs-ast-wrap
@@ -226,16 +265,27 @@
(list
(quote query-scoped)
val
(parse-cmp (parse-arith (parse-poss (parse-atom))))))
(parse-cmp
(parse-arith (parse-poss (parse-atom))))))
(list (quote query) val))
"selector" s (prev-end) l {}))))
"selector"
s
(prev-end)
l
{}))))
((= typ "attr")
(do (adv!) (list (quote attr) val (list (quote me)))))
(do
(adv!)
(list (quote attr) val (list (quote beingTold)))))
((= typ "style")
(do (adv!) (list (quote style) val (list (quote me)))))
(do
(adv!)
(list (quote style) val (list (quote beingTold)))))
((= typ "local") (do (adv!) (list (quote local) val)))
((= typ "hat")
(do (adv!) (list (quote dom-ref) val (list (quote me)))))
(do
(adv!)
(list (quote dom-ref) val (list (quote beingTold)))))
((and (= typ "keyword") (= val "dom"))
(do
(adv!)
@@ -243,13 +293,31 @@
((name (tp-val)))
(do
(adv!)
(list (quote dom-ref) name (list (quote me)))))))
(list (quote dom-ref) name (list (quote beingTold)))))))
((= typ "class")
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (list (quote query) (str "." val)) "selector" s (prev-end) l {}))))
(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 {}))))
(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!)
@@ -922,7 +990,7 @@
(collect-classes!))))
(collect-classes!)
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
@@ -951,7 +1019,7 @@
(get (adv!) "value")
(parse-expr))))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(list (quote set-style) prop value tgt))))
((= (tp-type) "brace-open")
(do
@@ -977,7 +1045,7 @@
(collect-pairs!)
(when (= (tp-type) "brace-close") (adv!))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(list (quote set-styles) (reverse pairs) tgt)))))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
(do
@@ -989,7 +1057,7 @@
((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
@@ -1007,7 +1075,7 @@
(let
((attr-val (if (and (= (tp-type) "op") (= (tp-val) "=")) (do (adv!) (parse-expr)) "")))
(let
((tgt (if (match-kw "to") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "to") (parse-expr) (list (quote beingTold)))))
(let
((when-clause (if (match-kw "when") (parse-expr) nil)))
(if
@@ -1048,7 +1116,7 @@
(collect-classes!))))
(collect-classes!)
(let
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold)))))
(if
(empty? extra-classes)
(list (quote remove-class) cls tgt)
@@ -1059,7 +1127,7 @@
(let
((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "from") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "from") (parse-expr) (list (quote beingTold)))))
(list (quote remove-attr) attr-name tgt))))
((and (= (tp-type) "bracket-open") (= (tp-val) "["))
(do
@@ -1121,7 +1189,7 @@
(let
((cls2 (do (let ((v (tp-val))) (adv!) v))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(list (quote toggle-between) cls1 cls2 tgt)))
nil)))
((and (= (tp-type) "bracket-open") (> (len tokens) (+ p 1)) (= (get (nth tokens (+ p 1)) "type") "attr"))
@@ -1146,7 +1214,7 @@
((v2 (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(if
(= n1 n2)
(list
@@ -1180,7 +1248,7 @@
(let
((extra-classes (collect-classes (list))))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(cond
((> (len extra-classes) 0)
(list
@@ -1209,7 +1277,7 @@
(let
((prop (get (adv!) "value")))
(let
((tgt (if (match-kw "of") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "of") (parse-expr) (list (quote beingTold)))))
(if
(match-kw "between")
(let
@@ -1280,7 +1348,7 @@
(let
((attr-name (get (adv!) "value")))
(let
((tgt (if (match-kw "on") (parse-expr) (list (quote me)))))
((tgt (if (match-kw "on") (parse-expr) (list (quote beingTold)))))
(if
(match-kw "between")
(let
@@ -1305,7 +1373,7 @@
((attr-val (parse-expr)))
(when (= (tp-type) "bracket-close") (adv!))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(list (quote toggle-attr-val) attr-name attr-val tgt))))))
((and (= (tp-type) "keyword") (= (tp-val) "my"))
(do
@@ -1533,7 +1601,7 @@
(let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let
((tgt (parse-tgt-kw "to" (list (quote me)))))
((tgt (parse-tgt-kw "to" (list (quote beingTold)))))
(if
dtl
(list (quote send) name dtl tgt)
@@ -1547,7 +1615,7 @@
(let
((dtl (if (= (tp-type) "paren-open") (parse-detail-dict) nil)))
(let
((tgt (parse-tgt-kw "on" (list (quote me)))))
((tgt (parse-tgt-kw "on" (list (quote beingTold)))))
(if
dtl
(list (quote trigger) name dtl tgt)
@@ -1586,7 +1654,7 @@
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
(let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let
@@ -1597,7 +1665,7 @@
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote me))) (true (parse-expr)))))
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end") (= (tp-val) "with") (= (tp-val) "when") (= (tp-val) "add") (= (tp-val) "remove") (= (tp-val) "set") (= (tp-val) "put") (= (tp-val) "toggle") (= (tp-val) "hide") (= (tp-val) "show") (= (tp-val) "on"))) (list (quote beingTold))) (true (parse-expr)))))
(let
((strategy (if (match-kw "with") (if (at-end?) "display" (let ((s (tp-val))) (do (adv!) (cond ((at-end?) s) ((= (tp-type) "colon") (do (adv!) (let ((v (tp-val))) (do (adv!) (str s ":" v))))) ((= (tp-type) "local") (let ((v (tp-val))) (do (adv!) (str s ":" v)))) (true s))))) "display")))
(let
@@ -2052,9 +2120,19 @@
((right (let ((a (parse-atom))) (if (nil? a) a (parse-poss a)))))
(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)))
(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}))))))
(hs-ast-wrap
(list op left right)
"arith"
lhs-start
(prev-end)
lhs-line
{:rhs right :lhs left}))))))
left))))
(define
parse-the-expr
@@ -2069,21 +2147,21 @@
(if
(match-kw "of")
(list (quote style) val (parse-expr))
(list (quote style) val (list (quote me))))))
(list (quote style) val (list (quote beingTold))))))
((= typ "attr")
(do
(adv!)
(if
(match-kw "of")
(list (quote attr) val (parse-expr))
(list (quote attr) val (list (quote me))))))
(list (quote attr) val (list (quote beingTold))))))
((= typ "class")
(do
(adv!)
(if
(match-kw "of")
(list (quote has-class?) (parse-expr) val)
(list (quote has-class?) (list (quote me)) val))))
(list (quote has-class?) (list (quote beingTold)) val))))
((= typ "selector")
(do
(adv!)
@@ -2231,13 +2309,15 @@
()
(let
((tgt (parse-expr)))
(list (quote measure) (if (nil? tgt) (list (quote me)) tgt)))))
(list
(quote measure)
(if (nil? tgt) (list (quote beingTold)) tgt)))))
(define
parse-scroll-cmd
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
(let
((pos (cond ((match-kw "top") "top") ((match-kw "bottom") "bottom") ((match-kw "left") "left") ((match-kw "right") "right") (true "top"))))
(list (quote scroll!) tgt pos)))))
@@ -2246,14 +2326,14 @@
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
(list (quote select!) tgt))))
(define
parse-reset-cmd
(fn
()
(let
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote me)) (parse-expr))))
((tgt (if (or (at-end?) (and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end")))) (list (quote beingTold)) (parse-expr))))
(list (quote reset!) tgt))))
(define
parse-default-cmd
@@ -2278,7 +2358,7 @@
(fn
()
(let
((tgt (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
((tgt (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote focus!) tgt))))
(define
parse-feat-body
@@ -2392,7 +2472,7 @@
(fn
()
(let
((target (cond ((at-end?) (list (quote ref) "me")) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote ref) "me")) (true (parse-expr)))))
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote empty-target) target))))
(define
parse-swap-cmd
@@ -2417,14 +2497,14 @@
(fn
()
(let
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote open-element) target))))
(define
parse-close-cmd
(fn
()
(let
((target (cond ((at-end?) (list (quote me))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote me))) (true (parse-expr)))))
((target (cond ((at-end?) (list (quote beingTold))) ((and (= (tp-type) "keyword") (or (= (tp-val) "then") (= (tp-val) "end"))) (list (quote beingTold))) (true (parse-expr)))))
(list (quote close-element) target))))
(define
parse-cmd
@@ -2454,15 +2534,21 @@
((and (= typ "keyword") (= val "put"))
(do (adv!) (parse-put-cmd)))
((and (= typ "keyword") (= val "if"))
(let ((s (cur-start)) (l (cur-line)))
(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)}
{})))))))
(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"))
@@ -2470,8 +2556,17 @@
((and (= typ "keyword") (= val "trigger"))
(do (adv!) (parse-trigger-cmd)))
((and (= typ "keyword") (= val "log"))
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-log-cmd) "cmd" s (prev-end) l {}))))
(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"))
@@ -2511,8 +2606,17 @@
((and (= typ "keyword") (= val "tell"))
(do (adv!) (parse-tell-cmd)))
((and (= typ "keyword") (= val "for"))
(let ((s (cur-start)) (l (cur-line)))
(do (adv!) (hs-ast-wrap (parse-for-cmd) "cmd" s (prev-end) l {}))))
(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"))
@@ -2642,10 +2746,13 @@
loop
(fn
(i)
(when (< i (- (len cmds-list) 1))
(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))
((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)
@@ -2810,7 +2917,9 @@
((= val "behavior") (do (adv!) (parse-behavior-feat)))
((= val "live") (do (adv!) (parse-live-feat)))
((= val "when") (do (adv!) (parse-when-feat)))
((= val "worker") (error "worker plugin is not installed — see https://hyperscript.org/features/worker"))
((= val "worker")
(error
"worker plugin is not installed — see https://hyperscript.org/features/worker"))
(true (parse-cmd-list))))))
(define
coll-feats