giles
f828fb023b
Evaluator fixes (from broken match refactor in 8bba02f):
- Deref frame: use CEK state `value`, not `(get frame "value")`
- Deref frame: restore `(context "sx-reactive" nil)` (was undefined `get-tracking-context`)
- Scope-acc frame: restore missing `(get frame "value")` arg to make-scope-acc-frame
- Add missing `thread-insert-arg` helper for thread-first non-HO branch
Transpiler (hosts/javascript/transpiler.sx):
- Add `match` special form handler (IIFE with chained if/return, `_` wildcard)
- Replace `=`/`!=` infix `==` with `sxEq()` function call for proper symbol equality
JS platform (hosts/javascript/platform.py):
- Add `sxEq` for structural symbol/keyword comparison
- Add `componentFile`, `sort`, `defStore`/`useStore`/`clearStores` primitives
- Add `length`/`map`/`for-each`/`reduce` as VM-compatible HOF primitives
- Fix `SYM` → `makeSymbol` references
New files:
- sx/sx/stepper-lib.sx: extracted split-tag, build-code-tokens, steps-to-preview
JS tests: 0 → 1582/1585 passing (3 remaining are VM closure interop)
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
133 lines
5.7 KiB
Plaintext
133 lines
5.7 KiB
Plaintext
(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"}))))
|
|
|
|
(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)))
|
|
|
|
(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))))))))
|