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

HS parser: fix number+comparison keyword collision, eval-hs uses hs-compile

Browse Source 
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:
giles
2026-04-15 11:29:01 +00:00
parent a93e5924df
commit 4f02f82f4e
377 changed files with 9517 additions and 8694 deletions
Download Patch File Download Diff File Expand all files Collapse all files

71
sx/sx/stepper-lib/build-code-tokens.sx Normal file
View File

@@ -0,0 +1,71 @@
(define 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)))

38
sx/sx/stepper-lib/split-tag.sx Normal file
View File

@@ -0,0 +1,38 @@
(define 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"}))))

18
sx/sx/stepper-lib/steps-to-preview.sx Normal file
View File

@@ -0,0 +1,18 @@
(define 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))))))))