Step 10c: fix bind subscriber re-evaluation — track names not frames

Root cause: context called inside lambdas (e.g. swap!) went through
nested cek_run with empty kont, so provide frames weren't found and
never tracked to *bind-tracking*.

Three changes in evaluator.sx:
- step-sf-context: track context names (not frames) to *bind-tracking*
  — names work across cek_run boundaries via scope-peek fallback
- bind continue: resolve tracked names to frames via kont-find-provide
  on rest-k before registering subscribers
- subscriber: use empty kont instead of kont-extract-provides — old
  approach created provide frames whose continue handlers called
  scope-pop!, corrupting the scope stack

2752/2768 OCaml tests pass (all 7 bind subscriber tests fixed).
32/32 WASM native tests pass.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-05 11:05:17 +00:00
parent a965731a33
commit 44b520a9e9
6 changed files with 5366 additions and 8054 deletions

File diff suppressed because one or more lines are too long

View File

@@ -1,6 +1,7 @@
(define-library (sx highlight)
(define-library
(sx highlight)
(export
sx-specials
sx-special?
@@ -16,204 +17,184 @@
highlight-sx
highlight)
(begin
(define
sx-specials
(list
"defcomp"
"defrelation"
"defisland"
"defpage"
"defhelper"
"define"
"defmacro"
"defconfig"
"deftest"
"if"
"when"
"cond"
"case"
"and"
"or"
"not"
"let"
"let*"
"lambda"
"fn"
"do"
"begin"
"quote"
"quasiquote"
"->"
"map"
"filter"
"reduce"
"some"
"every?"
"map-indexed"
"for-each"
"&key"
"&rest"
"set!"))
(define sx-special? (fn (s) (some (fn (x) (= x s)) sx-specials)))
(define hl-digit? (fn (c) (and (>= c "0") (<= c "9"))))
(define
hl-alpha?
(fn (c) (or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z")))))
(define
hl-sym-char?
(fn
(c)
(or
(hl-alpha? c)
(hl-digit? c)
(= c "_")
(= c "-")
(= c "?")
(= c "!")
(= c "+")
(= c "*")
(= c "/")
(= c "<")
(= c ">")
(= c "=")
(= c "&")
(= c "."))))
(define hl-ws? (fn (c) (or (= c " ") (= c "\n") (= c "\t") (= c "\r"))))
(define hl-escape (fn (s) s))
(define
hl-span
(fn
(class text)
(if
(= class "")
(list (quote span) text)
(list (quote span) (make-keyword "class") class text))))
(define
tokenize-sx
(fn
(code)
(let
((tokens (list)) (i 0) (len (string-length code)))
(let
loop
()
(when
(< i len)
(define
sx-specials
(list
"defcomp"
"defrelation"
"defisland"
"defpage"
"defhelper"
"define"
"defmacro"
"defconfig"
"deftest"
"if"
"when"
"cond"
"case"
"and"
"or"
"not"
"let"
"let*"
"lambda"
"fn"
"do"
"begin"
"quote"
"quasiquote"
"->"
"map"
"filter"
"reduce"
"some"
"every?"
"map-indexed"
"for-each"
"&key"
"&rest"
"set!"
"satisfies?"
"match"
"let-match"
"define-protocol"
"implement"
"->>"
"|>"
"as->"
"define-library"
"import"
"perform"
"guard"
"call/cc"
"raise"
"define-syntax"
"syntax-rules"
"make-parameter"
"parameterize"))
(define sx-special? (fn (s) (some (fn (x) (= x s)) sx-specials)))
(define hl-digit? (fn (c) (and (>= c "0") (<= c "9"))))
(define
hl-alpha?
(fn
(c)
(or (and (>= c "a") (<= c "z")) (and (>= c "A") (<= c "Z")))))
(define
hl-sym-char?
(fn
(c)
(or
(hl-alpha? c)
(hl-digit? c)
(= c "_")
(= c "-")
(= c "?")
(= c "!")
(= c "+")
(= c "*")
(= c "/")
(= c "<")
(= c ">")
(= c "=")
(= c "&")
(= c "."))))
(define
hl-ws?
(fn (c) (or (= c " ") (= c "\n") (= c "\t") (= c "\r"))))
(define hl-escape (fn (s) s))
(define
hl-span
(fn
(class text)
(if
(= class "")
(list (quote span) text)
(list (quote span) (make-keyword "class") class text))))
(define
tokenize-sx
(fn
(code)
(let
((tokens (list)) (i 0) (len (string-length code)))
(let
((c (substring code i (+ i 1))))
(if
(= c ";")
loop
()
(when
(< i len)
(let
((start i))
(set! i (+ i 1))
(let
scan
()
(when
(and
(< i len)
(not (= (substring code i (+ i 1)) "\n")))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "comment" (substring code start i))))))
(if
(= c "\"")
(let
((start i))
(set! i (+ i 1))
(let
sloop
()
(when
(< i len)
(let
((sc (substring code i (+ i 1))))
(if
(= sc "\\")
(do (set! i (+ i 2)) (sloop))
(if
(= sc "\"")
(set! i (+ i 1))
(do (set! i (+ i 1)) (sloop)))))))
(set!
tokens
(append
tokens
(list (list "string" (substring code start i))))))
((c (substring code i (+ i 1))))
(if
(= c ":")
(= c ";")
(let
((start i))
(set! i (+ i 1))
(when
(and
(< i len)
(hl-alpha? (substring code i (+ i 1))))
(let
scan
()
(when
(and
(< i len)
(hl-sym-char? (substring code i (+ i 1))))
(set! i (+ i 1))
(scan))))
(let
scan
()
(when
(and
(< i len)
(not (= (substring code i (+ i 1)) "\n")))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "keyword" (substring code start i))))))
(list (list "comment" (substring code start i))))))
(if
(= c "~")
(= c "\"")
(let
((start i))
(set! i (+ i 1))
(let
scan
sloop
()
(when
(and
(< i len)
(let
((x (substring code i (+ i 1))))
(or (hl-sym-char? x) (= x "/"))))
(set! i (+ i 1))
(scan)))
(< i len)
(let
((sc (substring code i (+ i 1))))
(if
(= sc "\\")
(do (set! i (+ i 2)) (sloop))
(if
(= sc "\"")
(set! i (+ i 1))
(do (set! i (+ i 1)) (sloop)))))))
(set!
tokens
(append
tokens
(list (list "component" (substring code start i))))))
(list (list "string" (substring code start i))))))
(if
(or
(= c "(")
(= c ")")
(= c "[")
(= c "]")
(= c "{")
(= c "}"))
(do
(= c ":")
(let
((start i))
(set! i (+ i 1))
(when
(and
(< i len)
(hl-alpha? (substring code i (+ i 1))))
(let
scan
()
(when
(and
(< i len)
(hl-sym-char? (substring code i (+ i 1))))
(set! i (+ i 1))
(scan))))
(set!
tokens
(append tokens (list (list "paren" c))))
(set! i (+ i 1)))
(append
tokens
(list (list "keyword" (substring code start i))))))
(if
(hl-digit? c)
(= c "~")
(let
((start i))
(set! i (+ i 1))
(let
scan
()
@@ -222,53 +203,30 @@
(< i len)
(let
((x (substring code i (+ i 1))))
(or (hl-digit? x) (= x "."))))
(or (hl-sym-char? x) (= x "/"))))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "number" (substring code start i))))))
(list
(list "component" (substring code start i))))))
(if
(hl-sym-char? c)
(let
((start i))
(let
scan
()
(when
(and
(< i len)
(hl-sym-char? (substring code i (+ i 1))))
(set! i (+ i 1))
(scan)))
(let
((text (substring code start i)))
(if
(or
(= text "true")
(= text "false")
(= text "nil"))
(set!
tokens
(append
tokens
(list (list "boolean" text))))
(if
(sx-special? text)
(set!
tokens
(append
tokens
(list (list "special" text))))
(set!
tokens
(append
tokens
(list (list "symbol" text))))))))
(or
(= c "(")
(= c ")")
(= c "[")
(= c "]")
(= c "{")
(= c "}"))
(do
(set!
tokens
(append tokens (list (list "paren" c))))
(set! i (+ i 1)))
(if
(hl-ws? c)
(hl-digit? c)
(let
((start i))
(let
@@ -277,49 +235,106 @@
(when
(and
(< i len)
(hl-ws? (substring code i (+ i 1))))
(let
((x (substring code i (+ i 1))))
(or (hl-digit? x) (= x "."))))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list (list "ws" (substring code start i))))))
(do
(set!
tokens
(append tokens (list (list "other" c))))
(set! i (+ i 1))))))))))))
(loop)))
tokens)))
(define sx-token-classes {:boolean "text-orange-600" :component "text-rose-600 font-semibold" :number "text-amber-700" :string "text-emerald-700" :special "text-sky-700 font-semibold" :paren "text-stone-400" :keyword "text-violet-600" :comment "text-stone-400 italic"})
(define
render-sx-tokens
(fn
(tokens)
(map
(list
(list "number" (substring code start i))))))
(if
(hl-sym-char? c)
(let
((start i))
(let
scan
()
(when
(and
(< i len)
(hl-sym-char?
(substring code i (+ i 1))))
(set! i (+ i 1))
(scan)))
(let
((text (substring code start i)))
(if
(or
(= text "true")
(= text "false")
(= text "nil"))
(set!
tokens
(append
tokens
(list (list "boolean" text))))
(if
(sx-special? text)
(set!
tokens
(append
tokens
(list (list "special" text))))
(set!
tokens
(append
tokens
(list (list "symbol" text))))))))
(if
(hl-ws? c)
(let
((start i))
(let
scan
()
(when
(and
(< i len)
(hl-ws? (substring code i (+ i 1))))
(set! i (+ i 1))
(scan)))
(set!
tokens
(append
tokens
(list
(list "ws" (substring code start i))))))
(do
(set!
tokens
(append tokens (list (list "other" c))))
(set! i (+ i 1))))))))))))
(loop)))
tokens)))
(define sx-token-classes {:boolean "text-orange-600" :component "text-rose-600 font-semibold" :number "text-amber-700" :string "text-emerald-700" :special "text-sky-700 font-semibold" :paren "text-stone-400" :keyword "text-violet-600" :comment "text-stone-400 italic"})
(define
render-sx-tokens
(fn
(tok)
(let
((cls (or (dict-get sx-token-classes (first tok)) "")))
(hl-span cls (nth tok 1))))
tokens)))
(define highlight-sx (fn (code) (render-sx-tokens (tokenize-sx code))))
(define
highlight
(fn
(code lang)
(if
(or (= lang "lisp") (= lang "sx") (= lang "sexp") (= lang "scheme"))
(highlight-sx code)
(list (quote code) code))))
)) ;; end define-library
(tokens)
(map
(fn
(tok)
(let
((cls (or (dict-get sx-token-classes (first tok)) "")))
(hl-span cls (nth tok 1))))
tokens)))
(define highlight-sx (fn (code) (-> code tokenize-sx render-sx-tokens)))
(define
highlight
(fn
(code lang)
(if
(or
(= lang "lisp")
(= lang "sx")
(= lang "sexp")
(= lang "scheme"))
(highlight-sx code)
(list (quote code) code)))))) ;; end define-library
;; Re-export to global namespace for backward compatibility
(import (sx highlight))

File diff suppressed because one or more lines are too long

View File

@@ -1792,7 +1792,7 @@
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
}
(globalThis))
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-418217b8",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-0734e8ba",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-b2cc3269",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-9b135b3a",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new