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

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

Browse Source 
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:
giles
2026-04-26 13:38:19 +00:00
parent 835fffb834
commit 11ee71d846
6 changed files with 3220 additions and 2874 deletions
Download Patch File Download Diff File Expand all files Collapse all files

108
lib/hyperscript/compiler.sx
View File

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

6
lib/hyperscript/integration.sx
View File

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

263
lib/hyperscript/parser.sx
View File

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

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

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

6
shared/static/wasm/sx/hs-integration.sx
View File

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

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

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