simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Chez Phase 2 (inc P): clojure.string namespace (jolt-nfca)

Browse source 
Bring the clojure.string namespace up on Chez so aliased refs like s/split,
s/upper-case, s/join, s/replace resolve and run.

Three pieces. (1) The Chez AOT driver analyzes the whole user form before any
require runs, so a (require '[clojure.string :as s]) never registered the
alias in time; eval-e-with-prelude now recursively pre-evals require/use forms
against the ctx, which loads the aliased ns and registers the alias so the
analyzer resolves s/X to a clojure.string var. (2) emit-core-prelude emits
stdlib namespaces (clojure.string) as their own def-var! tier through the same
analyze->emit pipeline, so the runtime var-deref resolves. (3) natives-str.ss
def-var!s the str-* primitives clojure.string.clj is written over (upper/lower/
trim/triml/trimr/find/reverse-b/join/split/replace/replace-all), plus no-op
require/use. Regex split keeps interior empties and honors the limit (ported
the seed re-split); regex replace does $N backref expansion and fn replacement
(ported replacement-for). new RT/clj files added to the prelude fingerprint.

Corpus prelude floor 2026 -> 2078 (+52), 0 new divergences. _strns 28/28 vs
build/jolt. Four previously-CRASHING cases now emit+run and surface pre-existing
gaps (read-line vector eval-order x3, instance? clojure.lang.Atom) — allowlisted
with notes. full jpm test + conformance x3 green.
This commit is contained in:
Yogthos 2026-06-18 21:38:13 -04:00
parent 3ab53ba938
commit a706a79b90
5 changed files with 275 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

35
host/chez/driver.janet
View file

@ -102,6 +102,13 @@
(def core-tier-files
["00-syntax" "00-kernel" "10-seq" "20-coll" "25-sorted" "30-macros" "40-lazy" "50-io"])
# stdlib namespaces (beyond clojure.core) emitted into the prelude as their own
# def-var! tier. Each is pure Clojure over clojure.core + host natives, so the
# same analyze->emit pipeline lowers it; an aliased ref resolves via var-deref at
# runtime once the alias is registered (the driver pre-evals requires). jolt-nfca.
(def stdlib-ns-files
[["clojure.string" "src/jolt/clojure/string.clj"]])
(defn- sym-name [x]
(when (and (struct? x) (= :symbol (get x :jolt/type))) (get x :name)))
@ -127,8 +134,9 @@
(tctx/ctx-set-current-ns ctx "clojure.core")
(def out @[])
(var total 0) (var emitted 0)
(each tf core-tier-files
(def src (slurp (string core-dir tf ".clj")))
(defn- emit-ns-forms [ns-name src]
(tctx/create-ns ctx ns-name)
(tctx/ctx-set-current-ns ctx ns-name)
(each f (parse-all src)
(unless (macro-form? f)
(++ total)
@ -142,6 +150,13 @@
# Silent to keep a real -e's stderr clean; the known set is documented.
(array/push out
(string "(guard (e (#t #f))\n " (res 1) ")"))))))
(each tf core-tier-files
(emit-ns-forms "clojure.core" (slurp (string core-dir tf ".clj"))))
# stdlib namespaces beyond clojure.core that are pure Clojure over core/host
# natives — emitted as their own def-var! tier so an aliased ref (e.g. s/split
# after (require '[clojure.string :as s])) resolves at runtime (jolt-nfca).
(each [ns-name path] stdlib-ns-files
(emit-ns-forms ns-name (slurp path)))
(tctx/ctx-set-current-ns ctx prev-ns)
(emit/set-prelude-mode! false)
[(string/join out "\n") emitted total])
@ -164,6 +179,21 @@
"(set-chez-ns! \"user\")\n"
"(printf \"~a\\n\" (jolt-final-str " final-scm "))\n"))
(defn- require-head? [f]
(and (indexed? f) (> (length f) 0)
(let [h (sym-name (in f 0))] (and h (or (= h "require") (= h "use"))))))
(defn- scan-eval-requires! [ctx form]
"Recursively eval any (require ...)/(use ...) sub-form against the ctx so the
alias registers + the aliased ns loads BEFORE the AOT analyzer resolves its
qualified refs — the whole user form is analyzed up front, before any require
would run at eval time (jolt-nfca). Failures are swallowed (the ref then stays
an emit-err, the prior behavior)."
(when (indexed? form)
(if (require-head? form)
(protect (api/eval-one ctx form))
(each sub form (scan-eval-requires! ctx sub)))))
(defn eval-e-with-prelude
"Run a single user expression `src` on Chez with the full clojure.core prelude
(loaded from `prelude-path`). Emits `src` in prelude mode so any core ref
@ -172,6 +202,7 @@
[ctx src prelude-path &opt scheme-out]
(emit/set-prelude-mode! true)
(def form (in (r/parse-next src) 0))
(scan-eval-requires! ctx form)
(def res (protect (emit/emit (backend/analyze-form ctx form))))
(emit/set-prelude-mode! false)
(if (not (res 0))

3
host/chez/jolt-chez.janet
View file

@ -21,7 +21,8 @@
"host/chez/values.ss" "host/chez/collections.ss" "host/chez/seq.ss"
"host/chez/atoms.ss" "host/chez/predicates.ss" "host/chez/regex.ss"
"host/chez/ns.ss" "host/chez/post-prelude.ss" "host/chez/natives-meta.ss"
"host/chez/natives-str.ss" "host/chez/records.ss"]
"host/chez/natives-str.ss" "host/chez/records.ss"
"src/jolt/clojure/string.clj"]
(array/push parts (slurp f)))
(string/slice (string (hash (string/join parts))) 0))

152
host/chez/natives-str.ss
View file

@ -125,3 +125,155 @@
((string=? method "split")
(apply jolt-vector (str-split-drop-trailing (irregex-split (str-irx (arg 0)) s))))
(else (error #f (string-append "No method " method " for value")))))
;; --- clojure.core str-* primitives (the substrate clojure.string.clj calls) ---
;; clojure.string.clj (src/jolt/clojure/string.clj) is pure Clojure over these
;; seed natives (core.janet core-bindings); def-var!'d here so the emitted
;; clojure.string prelude tier's var-derefs resolve. Ported from the seed:
;; string/ascii-* (ASCII), string/find (index or nil), core-str-* (regex|literal).
;; (string/split sep s) -> parts, splitting on each non-overlapping sep.
(define (str-literal-split s sep)
(let ((slen (string-length s)) (plen (string-length sep)))
(if (fx=? plen 0)
(map string (string->list s))
(let loop ((i 0) (start 0) (acc '()))
(cond ((fx>? (fx+ i plen) slen)
(reverse (cons (substring s start slen) acc)))
((string=? (substring s i (fx+ i plen)) sep)
(loop (fx+ i plen) (fx+ i plen) (cons (substring s start i) acc)))
(else (loop (fx+ i 1) start acc)))))))
(define (str-upper s) (ascii-string-up s))
(define (str-lower s) (ascii-string-down s))
(define (str-reverse-b s) (list->string (reverse (string->list s))))
;; (str-find needle haystack) -> flonum index of first occurrence, or nil.
(define (str-find needle s)
(let ((i (str-index-of s needle 0)))
(if (fx<? i 0) jolt-nil (exact->inexact i))))
;; (str-join coll [sep]) -> stringify each element (Clojure str), join by sep.
(define (str-join coll . opt)
(let ((sep (if (pair? opt) (jolt-str-render-one (car opt)) ""))
(items (map jolt-str-render-one (seq->list coll))))
(let loop ((xs items) (first #t) (acc '()))
(cond ((null? xs) (apply string-append (reverse acc)))
(first (loop (cdr xs) #f (cons (car xs) acc)))
(else (loop (cdr xs) #f (cons (car xs) (cons sep acc))))))))
;; (re-split irx s limit) -> parts, splitting at each match. Keeps interior AND
;; trailing empty strings (the clojure.string wrapper drops trailing for limit 0);
;; a positive limit yields at most `limit` parts (the rest kept unsplit). Mirrors
;; the seed re-split (src/jolt/regex.janet); the clojure.string.clj split wrapper
;; layers the trailing-empty trim on top.
(define (re-split irx s limit)
(let ((len (string-length s)))
(let loop ((start 0) (last 0) (out '()))
(if (and limit (fx>=? (length out) (fx- limit 1)))
(reverse (cons (substring s last len) out))
(let ((m (and (fx<=? start len) (irregex-search irx s start))))
(if (not m)
(reverse (cons (substring s last len) out))
(let ((ms (irregex-match-start-index m 0))
(me (irregex-match-end-index m 0)))
(if (fx=? me ms) ; zero-width: step past to avoid a stall
(if (fx>=? start len)
(reverse (cons (substring s last len) out))
(loop (fx+ start 1) last out))
(loop me me (cons (substring s last ms) out))))))))))
;; (str-split pat s [limit]) -> parts. Regex or literal separator; a positive
;; limit caps the part count (the unsplit tail kept), matching core-str-split.
(define (str-split pat s . opt)
(let ((limit (if (and (pair? opt) (not (jolt-nil? (car opt)))) (jolt->idx (car opt)) #f)))
(if (jolt-regex? pat)
(apply jolt-vector (re-split (regex-t-irx pat) s limit))
(let ((parts (str-literal-split s pat)))
(apply jolt-vector
(if (and limit (fx>? limit 0) (fx>? (length parts) limit))
(append (list-head parts (fx- limit 1))
(list (str-join-strs (list-tail parts (fx- limit 1)) pat)))
parts))))))
(define (str-join-strs strs sep)
(let loop ((xs strs) (first #t) (acc '()))
(cond ((null? xs) (apply string-append (reverse acc)))
(first (loop (cdr xs) #f (cons (car xs) acc)))
(else (loop (cdr xs) #f (cons (car xs) (cons sep acc)))))))
;; $0/$1... expansion in a string replacement against an irregex match (the
;; JVM/seed replacement syntax). $N -> group N's text (dropped if non-matching).
(define (expand-dollar repl m)
(let ((len (string-length repl)))
(let loop ((i 0) (acc '()))
(if (fx>=? i len)
(apply string-append (reverse acc))
(let ((c (string-ref repl i)))
(if (and (char=? c #\$) (fx<? (fx+ i 1) len)
(char<=? #\0 (string-ref repl (fx+ i 1)))
(char<=? (string-ref repl (fx+ i 1)) #\9))
(let* ((n (fx- (char->integer (string-ref repl (fx+ i 1))) 48))
(g (and (fx<=? n (irregex-match-num-submatches m))
(irregex-match-substring m n))))
(loop (fx+ i 2) (if g (cons g acc) acc)))
(loop (fx+ i 1) (cons (string c) acc))))))))
;; One match's replacement text. A string gets $N expansion; a fn (jolt closure)
;; is called with the match result (whole string, or [whole g1 ...] when grouped)
;; and its result stringified (mirrors the seed replacement-for).
(define (replacement-text replacement m)
(cond
((string? replacement) (expand-dollar replacement m))
((procedure? replacement) (jolt-str-render-one (jolt-invoke replacement (irx-result m))))
(else (jolt-str-render-one replacement))))
;; regex replace, first or all matches. Mirrors the seed re-replace-all/first.
(define (re-replace irx s replacement all?)
(let ((len (string-length s)))
(let loop ((start 0) (last 0) (acc '()))
(let ((m (and (fx<=? start len) (irregex-search irx s start))))
(if (not m)
(apply string-append (reverse (cons (substring s last len) acc)))
(let ((ms (irregex-match-start-index m 0))
(me (irregex-match-end-index m 0)))
(if (fx=? me ms) ; zero-width: step past
(if (fx>=? start len)
(apply string-append (reverse (cons (substring s last len) acc)))
(loop (fx+ start 1) last acc))
(let ((acc2 (cons (replacement-text replacement m)
(cons (substring s last ms) acc))))
(if all?
(loop me me acc2)
(apply string-append (reverse (cons (substring s me len) acc2))))))))))))
;; (str-replace-all pat repl s) / (str-replace pat repl s) — regex or literal.
(define (str-replace-all pat repl s)
(if (jolt-regex? pat)
(re-replace (regex-t-irx pat) s repl #t)
(str-replace-literal s pat repl)))
(define (str-replace-literal-first s a b)
(let ((alen (string-length a)) (i (str-index-of s a 0)))
(if (fx<? i 0) s
(string-append (substring s 0 i) b (substring s (fx+ i alen) (string-length s))))))
(define (str-replace pat repl s)
(if (jolt-regex? pat)
(re-replace (regex-t-irx pat) s repl #f)
(str-replace-literal-first s pat repl)))
(def-var! "clojure.core" "str-upper" str-upper)
(def-var! "clojure.core" "str-lower" str-lower)
(def-var! "clojure.core" "str-trim" str-trim)
(def-var! "clojure.core" "str-triml" str-triml)
(def-var! "clojure.core" "str-trimr" str-trimr)
(def-var! "clojure.core" "str-find" str-find)
(def-var! "clojure.core" "str-reverse-b" str-reverse-b)
(def-var! "clojure.core" "str-join" str-join)
(def-var! "clojure.core" "str-split" str-split)
(def-var! "clojure.core" "str-replace" str-replace)
(def-var! "clojure.core" "str-replace-all" str-replace-all)
;; (require ...) / (use ...) at runtime: the Chez AOT driver pre-evals these
;; against the analyzer ctx to register aliases + load aliased nss (driver.janet),
;; so the emitted call only needs to not crash. A no-op returning nil.
(def-var! "clojure.core" "require" (lambda args jolt-nil))
(def-var! "clojure.core" "use" (lambda args jolt-nil))