HS parser: fix number+comparison keyword collision, eval-hs uses hs-compile
Parser: skip unit suffix when next ident is a comparison keyword (starts, ends, contains, matches, is, does, in, precedes, follows). Fixes "123 starts with '12'" returning "123starts" instead of true. eval-hs: use hs-compile directly instead of hs-to-sx-from-source with "return " prefix, which was causing the parser to consume the comparison as a string suffix. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
4
sx/sx/home/index.sx
Normal file
4
sx/sx/home/index.sx
Normal file
@@ -0,0 +1,4 @@
|
||||
;; Docs page content — fully self-contained, no Python intermediaries
|
||||
(defcomp ()
|
||||
(div :id "main-content" (~tw :tokens "max-w-3xl mx-auto px-4 py-6")
|
||||
(~home/stepper)))
|
||||
406
sx/sx/home/stepper.sx
Normal file
406
sx/sx/home/stepper.sx
Normal file
@@ -0,0 +1,406 @@
|
||||
(defisland
|
||||
()
|
||||
(let
|
||||
((source "(div (~tw :tokens \"text-center\")\n (h1 (~tw :tokens \"text-3xl font-bold mb-2\")\n (span (~tw :tokens \"text-rose-500\") \"the \")\n (span (~tw :tokens \"text-amber-500\") \"joy \")\n (span (~tw :tokens \"text-emerald-500\") \"of \")\n (span (~tw :tokens \"text-violet-600 text-4xl\") \"sx\")))")
|
||||
(steps (signal (list)))
|
||||
(store
|
||||
(if
|
||||
(client?)
|
||||
(def-store
|
||||
"home-stepper"
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((raw (host-get (host-global "document") "cookie"))
|
||||
(prefix "sx-home-stepper="))
|
||||
(let
|
||||
((val (when (and (string? raw) (contains? raw prefix)) (let ((start (+ (index-of raw prefix) (len prefix)))) (let ((rest (slice raw start)) (end-pos (index-of (slice raw start) ";"))) (if (> end-pos -1) (slice rest 0 end-pos) rest))))))
|
||||
(let ((n (if val (parse-number val) 0))) {:step-idx (signal (if (and (number? n) (>= n 0) (<= n 16)) n 0))})))))
|
||||
nil))
|
||||
(step-idx
|
||||
(if
|
||||
store
|
||||
(get store "step-idx")
|
||||
(let
|
||||
((cv (get-cookie "sx-home-stepper")))
|
||||
(let
|
||||
((n (if cv (parse-number cv) 0)))
|
||||
(signal (if (and (number? n) (>= n 0) (<= n 16)) n 0))))))
|
||||
(dom-stack-sig (signal (list)))
|
||||
(code-tokens (signal (list))))
|
||||
(letrec
|
||||
((split-tag (fn (expr result) (cond (not (list? expr)) (append! result {:expr expr :type "leaf"}) (empty? expr) nil (not (= (type-of (first expr)) "symbol")) (append! result {:expr expr :type "leaf"}) (is-html-tag? (symbol-name (first expr))) (let ((ctag (symbol-name (first expr))) (cargs (rest expr)) (cch (list)) (cat (list)) (spreads (list)) (ckw false)) (for-each (fn (a) (cond (= (type-of a) "keyword") (do (set! ckw true) (append! cat a)) ckw (do (set! ckw false) (append! cat a)) (and (list? a) (not (empty? a)) (= (type-of (first a)) "symbol") (starts-with? (symbol-name (first a)) "~")) (do (set! ckw false) (append! spreads a)) :else (do (set! ckw false) (append! cch a)))) cargs) (append! result {:spreads spreads :tag ctag :type "open" :attrs cat}) (for-each (fn (c) (split-tag c result)) cch) (append! result {:open-attrs cat :open-spreads spreads :tag ctag :type "close"})) :else (append! result {:expr expr :type "expr"}))))
|
||||
(build-code-tokens
|
||||
(fn
|
||||
(expr tokens step-ref indent)
|
||||
(cond
|
||||
(string? expr)
|
||||
(do
|
||||
(append! tokens {:cls "text-emerald-700" :step (get step-ref "v") :text (str "\"" expr "\"")})
|
||||
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))
|
||||
(number? expr)
|
||||
(do
|
||||
(append! tokens {:cls "text-amber-700" :step (get step-ref "v") :text (str expr)})
|
||||
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))
|
||||
(= (type-of expr) "keyword")
|
||||
(append! tokens {:cls "text-violet-600" :step (get step-ref "v") :text (str ":" (keyword-name expr))})
|
||||
(= (type-of expr) "symbol")
|
||||
(let ((name (symbol-name expr))) (append! tokens {:cls (cond (is-html-tag? name) "text-sky-700 font-semibold" (starts-with? name "~") "text-rose-600 font-semibold" :else "text-stone-700") :step (get step-ref "v") :text name}))
|
||||
(list? expr)
|
||||
(when
|
||||
(not (empty? expr))
|
||||
(let
|
||||
((head (first expr))
|
||||
(is-tag
|
||||
(and
|
||||
(= (type-of head) "symbol")
|
||||
(is-html-tag? (symbol-name head))))
|
||||
(is-comp
|
||||
(and
|
||||
(= (type-of head) "symbol")
|
||||
(starts-with? (symbol-name head) "~")))
|
||||
(open-step (get step-ref "v")))
|
||||
(append! tokens {:cls "text-stone-400" :step open-step :text "("})
|
||||
(build-code-tokens head tokens step-ref indent)
|
||||
(when
|
||||
is-tag
|
||||
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))
|
||||
(for-each
|
||||
(fn
|
||||
(a)
|
||||
(let
|
||||
((is-child (and (list? a) (not (empty? a)) (= (type-of (first a)) "symbol") (or (is-html-tag? (symbol-name (first a))) (starts-with? (symbol-name (first a)) "~"))))
|
||||
(is-spread
|
||||
(and
|
||||
(list? a)
|
||||
(not (empty? a))
|
||||
(= (type-of (first a)) "symbol")
|
||||
(starts-with? (symbol-name (first a)) "~"))))
|
||||
(if
|
||||
is-spread
|
||||
(let
|
||||
((saved (get step-ref "v"))
|
||||
(saved-tokens-len (len tokens)))
|
||||
(append! tokens {:cls "" :step -1 :text " "})
|
||||
(build-code-tokens a tokens step-ref indent)
|
||||
(let
|
||||
mark-loop
|
||||
((j saved-tokens-len))
|
||||
(when
|
||||
(< j (len tokens))
|
||||
(dict-set! (nth tokens j) "spread" true)
|
||||
(mark-loop (+ j 1))))
|
||||
(dict-set! step-ref "v" saved))
|
||||
(if
|
||||
(and is-tag is-child)
|
||||
(do
|
||||
(append! tokens {:cls "" :step -1 :text (str "\n" (join "" (map (fn (_) " ") (range 0 (+ indent 1)))))})
|
||||
(build-code-tokens
|
||||
a
|
||||
tokens
|
||||
step-ref
|
||||
(+ indent 1)))
|
||||
(do
|
||||
(append! tokens {:cls "" :step -1 :text " "})
|
||||
(build-code-tokens a tokens step-ref indent))))))
|
||||
(rest expr))
|
||||
(append! tokens {:cls "text-stone-400" :step open-step :text ")"})
|
||||
(when
|
||||
is-tag
|
||||
(dict-set! step-ref "v" (+ (get step-ref "v") 1)))))
|
||||
:else nil)))
|
||||
(steps-to-preview
|
||||
(fn
|
||||
(all-steps target)
|
||||
(if
|
||||
(or (empty? all-steps) (<= target 0))
|
||||
nil
|
||||
(let
|
||||
((pos (dict "i" 0)) (max-i (min target (len all-steps))))
|
||||
(letrec
|
||||
((bc-loop (fn (children) (if (>= (get pos "i") max-i) children (let ((step (nth all-steps (get pos "i"))) (stype (get step "type"))) (cond (= stype "open") (do (dict-set! pos "i" (+ (get pos "i") 1)) (let ((tag (get step "tag")) (attrs (or (get step "attrs") (list))) (spreads (or (get step "spreads") (list))) (inner (bc-loop (list)))) (append! children (concat (list (make-symbol tag)) spreads attrs inner))) (bc-loop children)) (= stype "close") (do (dict-set! pos "i" (+ (get pos "i") 1)) children) (= stype "leaf") (do (dict-set! pos "i" (+ (get pos "i") 1)) (append! children (get step "expr")) (bc-loop children)) (= stype "expr") (do (dict-set! pos "i" (+ (get pos "i") 1)) (append! children (get step "expr")) (bc-loop children)) :else (do (dict-set! pos "i" (+ (get pos "i") 1)) (bc-loop children))))))))
|
||||
(let
|
||||
((root (bc-loop (list))))
|
||||
(cond
|
||||
(= (len root) 1)
|
||||
(first root)
|
||||
(empty? root)
|
||||
nil
|
||||
:else (concat (list (make-symbol "<>")) root))))))))
|
||||
(get-preview (fn () (dom-query "[data-sx-lake=\"home-preview\"]")))
|
||||
(get-code-view (fn () (dom-query "[data-code-view]")))
|
||||
(get-stack (fn () (deref dom-stack-sig)))
|
||||
(set-stack (fn (v) (reset! dom-stack-sig v)))
|
||||
(push-stack
|
||||
(fn
|
||||
(el)
|
||||
(reset! dom-stack-sig (append (deref dom-stack-sig) (list el)))))
|
||||
(pop-stack
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((s (deref dom-stack-sig)))
|
||||
(when
|
||||
(> (len s) 1)
|
||||
(reset! dom-stack-sig (slice s 0 (- (len s) 1)))))))
|
||||
(build-code-dom (fn () nil))
|
||||
(update-code-highlight
|
||||
(fn
|
||||
()
|
||||
(let
|
||||
((code-el (get-code-view))
|
||||
(cur (deref step-idx))
|
||||
(tokens (deref code-tokens)))
|
||||
(when
|
||||
(and code-el (not (empty? tokens)))
|
||||
(dom-set-prop
|
||||
code-el
|
||||
"innerHTML"
|
||||
(join
|
||||
""
|
||||
(map
|
||||
(fn
|
||||
(tok)
|
||||
(let
|
||||
((step-num (get tok "step"))
|
||||
(base (get tok "cls"))
|
||||
(text (replace (get tok "text") "&" "&")))
|
||||
(str
|
||||
"<span class=\""
|
||||
base
|
||||
(cond
|
||||
(= step-num -1)
|
||||
""
|
||||
(= step-num cur)
|
||||
" bg-amber-100 rounded px-0.5 font-bold text-sm"
|
||||
(< step-num cur)
|
||||
" font-bold text-xs"
|
||||
:else " opacity-40")
|
||||
"\">"
|
||||
text
|
||||
"</span>")))
|
||||
tokens)))))))
|
||||
(do-step
|
||||
(fn
|
||||
()
|
||||
(build-code-dom)
|
||||
(when
|
||||
(< (deref step-idx) (len (deref steps)))
|
||||
(when
|
||||
(empty? (get-stack))
|
||||
(let ((p (get-preview))) (when p (set-stack (list p)))))
|
||||
(let
|
||||
((step (nth (deref steps) (deref step-idx)))
|
||||
(step-type (get step "type"))
|
||||
(parent
|
||||
(if
|
||||
(empty? (get-stack))
|
||||
(get-preview)
|
||||
(last (get-stack)))))
|
||||
(cond
|
||||
(= step-type "open")
|
||||
(let
|
||||
((el (dom-create-element (get step "tag") nil))
|
||||
(attrs (get step "attrs"))
|
||||
(spreads (or (get step "spreads") (list))))
|
||||
(let
|
||||
loop
|
||||
((i 0))
|
||||
(when
|
||||
(< i (len attrs))
|
||||
(dom-set-attr
|
||||
el
|
||||
(keyword-name (nth attrs i))
|
||||
(nth attrs (+ i 1)))
|
||||
(loop (+ i 2))))
|
||||
(for-each
|
||||
(fn
|
||||
(sp)
|
||||
(when
|
||||
(and
|
||||
(list? sp)
|
||||
(>= (len sp) 3)
|
||||
(= (type-of (nth sp 1)) "keyword")
|
||||
(= (keyword-name (nth sp 1)) "tokens")
|
||||
(string? (nth sp 2)))
|
||||
(let
|
||||
((result (trampoline (~tw :tokens (nth sp 2)))))
|
||||
(when
|
||||
(spread? result)
|
||||
(let
|
||||
((sattrs (spread-attrs result)))
|
||||
(for-each
|
||||
(fn
|
||||
(k)
|
||||
(if
|
||||
(= k "class")
|
||||
(dom-set-attr
|
||||
el
|
||||
"class"
|
||||
(str
|
||||
(or (dom-get-attr el "class") "")
|
||||
" "
|
||||
(get sattrs k)))
|
||||
(dom-set-attr el k (get sattrs k))))
|
||||
(keys sattrs)))))))
|
||||
spreads)
|
||||
(when parent (dom-append parent el))
|
||||
(push-stack el))
|
||||
(= step-type "close")
|
||||
(pop-stack)
|
||||
(= step-type "leaf")
|
||||
(when
|
||||
parent
|
||||
(let
|
||||
((val (get step "expr")))
|
||||
(dom-append
|
||||
parent
|
||||
(create-text-node (if (string? val) val (str val))))))
|
||||
(= step-type "expr")
|
||||
nil))
|
||||
(swap! step-idx inc)
|
||||
(update-code-highlight)
|
||||
(host-set!
|
||||
(dom-document)
|
||||
"cookie"
|
||||
(str
|
||||
"sx-home-stepper="
|
||||
(deref step-idx)
|
||||
";path=/;max-age=31536000;SameSite=Lax")))))
|
||||
(rebuild-preview
|
||||
(fn
|
||||
(target)
|
||||
(let
|
||||
((container (get-preview)))
|
||||
(when
|
||||
container
|
||||
(dom-set-prop container "innerHTML" "")
|
||||
(let
|
||||
((expr (steps-to-preview (deref steps) target)))
|
||||
(when
|
||||
expr
|
||||
(let
|
||||
((dom (render-to-dom expr (get-render-env nil) nil)))
|
||||
(when dom (dom-append container dom)))))
|
||||
(let
|
||||
((depth 0) (all (deref steps)))
|
||||
(let
|
||||
loop
|
||||
((i 0))
|
||||
(when
|
||||
(< i target)
|
||||
(let
|
||||
((stype (get (nth all i) "type")))
|
||||
(cond
|
||||
(= stype "open")
|
||||
(set! depth (+ depth 1))
|
||||
(= stype "close")
|
||||
(set! depth (- depth 1))))
|
||||
(loop (+ i 1))))
|
||||
(let
|
||||
((stack (list container)) (node container))
|
||||
(let
|
||||
walk
|
||||
((d 0))
|
||||
(when
|
||||
(< d depth)
|
||||
(let
|
||||
((child (host-get node "lastElementChild")))
|
||||
(when
|
||||
child
|
||||
(append! stack child)
|
||||
(set! node child)))
|
||||
(walk (+ d 1))))
|
||||
(set-stack stack)))))))
|
||||
(do-back
|
||||
(fn
|
||||
()
|
||||
(when
|
||||
(> (deref step-idx) 0)
|
||||
(let
|
||||
((target (- (deref step-idx) 1)))
|
||||
(rebuild-preview target)
|
||||
(reset! step-idx target)
|
||||
(update-code-highlight)
|
||||
(host-set!
|
||||
(dom-document)
|
||||
"cookie"
|
||||
(str
|
||||
"sx-home-stepper="
|
||||
target
|
||||
";path=/;max-age=31536000;SameSite=Lax")))))))
|
||||
nil
|
||||
(let
|
||||
((parsed (sx-parse source)))
|
||||
(when
|
||||
(not (empty? parsed))
|
||||
(let
|
||||
((result (list)) (step-ref (dict "v" 0)))
|
||||
(split-tag (first parsed) result)
|
||||
(reset! steps result)
|
||||
(let
|
||||
((tokens (list)))
|
||||
(dict-set! step-ref "v" 0)
|
||||
(build-code-tokens (first parsed) tokens step-ref 0)
|
||||
(reset! code-tokens tokens)))))
|
||||
(let
|
||||
((_eff (let ((first-run (signal true))) (effect (fn () (let ((cur (deref step-idx))) (if (deref first-run) (do (reset! first-run false) (host-call (host-global "queueMicrotask") (host-callback (fn () (update-code-highlight) (rebuild-preview cur) (run-post-render-hooks))))) (schedule-idle (fn () (build-code-dom) (rebuild-preview cur) (update-code-highlight) (run-post-render-hooks))))))))))
|
||||
(div
|
||||
(~tw :tokens "space-y-4 text-center")
|
||||
(div
|
||||
:data-code-view true
|
||||
(~tw
|
||||
:tokens "font-mono bg-stone-50 rounded p-2 overflow-x-auto leading-relaxed whitespace-pre-wrap")
|
||||
:style "font-size:0.85rem"
|
||||
(when
|
||||
(not (client?))
|
||||
(map
|
||||
(fn
|
||||
(tok)
|
||||
(let
|
||||
((step (get tok "step"))
|
||||
(cur (deref step-idx))
|
||||
(is-spread (get tok "spread"))
|
||||
(cls
|
||||
(str
|
||||
(get tok "cls")
|
||||
(cond
|
||||
(= step -1)
|
||||
""
|
||||
(= step cur)
|
||||
" bg-amber-100 rounded px-0.5 font-bold text-sm"
|
||||
(< step cur)
|
||||
" font-bold text-xs"
|
||||
:else " opacity-40"))))
|
||||
(span :class cls (get tok "text"))))
|
||||
(deref code-tokens))))
|
||||
(div
|
||||
(~tw :tokens "flex items-center justify-center gap-2 md:gap-3")
|
||||
(button
|
||||
:on-click (fn (e) (do-back))
|
||||
:class (str
|
||||
"px-2 py-1 rounded text-3xl "
|
||||
(if
|
||||
(> (deref step-idx) 0)
|
||||
"text-stone-600 hover:text-stone-800 hover:bg-stone-100"
|
||||
"text-stone-300 cursor-not-allowed"))
|
||||
"◀")
|
||||
(span
|
||||
(~tw :tokens "text-sm text-stone-500 font-mono tabular-nums")
|
||||
(deref step-idx)
|
||||
" / "
|
||||
(len (deref steps)))
|
||||
(button
|
||||
:on-click (fn (e) (do-step))
|
||||
:class (str
|
||||
"px-2 py-1 rounded text-3xl "
|
||||
(if
|
||||
(< (deref step-idx) (len (deref steps)))
|
||||
"text-violet-600 hover:text-violet-800 hover:bg-violet-50"
|
||||
"text-violet-300 cursor-not-allowed"))
|
||||
"▶"))
|
||||
(lake
|
||||
:id "home-preview"
|
||||
(when
|
||||
(not (client?))
|
||||
(steps-to-preview (deref steps) (deref step-idx)))))))))
|
||||
Reference in New Issue
Block a user