giles
2d7dd7d582
Wraps all core .sx files in R7RS define-library with explicit export lists, plus (import ...) at end for backward-compatible global re-export. Libraries registered: (sx bytecode) — 83 opcode constants (sx render) — 15 tag registries + render helpers (sx signals) — 23 reactive signal primitives (sx r7rs) — 21 R7RS aliases (sx compiler) — 42 compiler functions (sx vm) — 32 VM functions (sx freeze) — 9 freeze/thaw functions (sx content) — 6 content store functions (sx callcc) — 1 call/cc wrapper (sx highlight) — 13 syntax highlighting functions (sx stdlib) — 47 stdlib functions (sx swap) — 13 swap algebra functions (sx render-trace) — 8 render trace functions (sx harness) — 21 test harness functions (sx canonical) — 12 canonical serialization functions (web adapter-html) — 13 HTML renderer functions (web adapter-sx) — 13 SX wire format functions (web engine) — 33 hypermedia engine functions (web request-handler) — 4 request handling functions (web page-helpers) — 12 page helper functions (web router) — 36 routing functions (web deps) — 19 dependency analysis functions (web orchestration) — 59 page orchestration functions Key changes: - define-library now inherits parent env (env-extend env instead of env-extend make-env) so library bodies can access platform primitives - sx_server.ml: added resolve_library_path + load_library_file for import resolution (maps library specs to file paths) - cek_run_with_io: handles "import" locally instead of sending to Python bridge 2608/2608 tests passing. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
326 lines
9.3 KiB
Plaintext
326 lines
9.3 KiB
Plaintext
|
|
|
|
(define-library (sx highlight)
|
|
(export
|
|
sx-specials
|
|
sx-special?
|
|
hl-digit?
|
|
hl-alpha?
|
|
hl-sym-char?
|
|
hl-ws?
|
|
hl-escape
|
|
hl-span
|
|
tokenize-sx
|
|
sx-token-classes
|
|
render-sx-tokens
|
|
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)
|
|
(let
|
|
((c (substring code i (+ i 1))))
|
|
(if
|
|
(= c ";")
|
|
(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))))))
|
|
(if
|
|
(= 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 "keyword" (substring code start i))))))
|
|
(if
|
|
(= c "~")
|
|
(let
|
|
((start i))
|
|
(set! i (+ i 1))
|
|
(let
|
|
scan
|
|
()
|
|
(when
|
|
(and
|
|
(< i len)
|
|
(let
|
|
((x (substring code i (+ i 1))))
|
|
(or (hl-sym-char? x) (= x "/"))))
|
|
(set! i (+ i 1))
|
|
(scan)))
|
|
(set!
|
|
tokens
|
|
(append
|
|
tokens
|
|
(list (list "component" (substring code start i))))))
|
|
(if
|
|
(or
|
|
(= c "(")
|
|
(= c ")")
|
|
(= c "[")
|
|
(= c "]")
|
|
(= c "{")
|
|
(= c "}"))
|
|
(do
|
|
(set!
|
|
tokens
|
|
(append tokens (list (list "paren" c))))
|
|
(set! i (+ i 1)))
|
|
(if
|
|
(hl-digit? c)
|
|
(let
|
|
((start i))
|
|
(let
|
|
scan
|
|
()
|
|
(when
|
|
(and
|
|
(< i len)
|
|
(let
|
|
((x (substring code i (+ i 1))))
|
|
(or (hl-digit? x) (= x "."))))
|
|
(set! i (+ i 1))
|
|
(scan)))
|
|
(set!
|
|
tokens
|
|
(append
|
|
tokens
|
|
(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
|
|
(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) (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
|
|
|
|
;; Re-export to global namespace for backward compatibility
|
|
(import (sx highlight))
|