a706a79b90
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.
279 lines
14 KiB
Scheme
279 lines
14 KiB
Scheme
;; natives-str.ss (jolt-nfca) — java.lang.String method interop on Chez.
|
|
;;
|
|
;; (.method s arg*) on a string target lowers to record-method-dispatch (emit.ss),
|
|
;; which falls through to jolt-string-method here when the target is a string.
|
|
;; Ported from the seed surface (src/jolt/eval_resolve.janet string-methods): the
|
|
;; portable java.lang.String/CharSequence methods cljc libraries actually call.
|
|
;; Case mapping is ASCII (the whole engine is byte-oriented), indexOf returns -1
|
|
;; on miss as on the JVM, indices come in as flonums, char results are Scheme
|
|
;; chars, and numeric results are flonums to match jolt's number model.
|
|
;;
|
|
;; Loaded from rt.ss AFTER regex.ss (the regex methods reuse jolt-re-pattern /
|
|
;; regex-t-irx) and records.ss (which calls jolt-string-method).
|
|
|
|
;; --- ASCII case mapping (match the seed's byte-oriented string/ascii-*) -------
|
|
(define (ascii-up-char c)
|
|
(if (and (char<=? #\a c) (char<=? c #\z))
|
|
(integer->char (fx- (char->integer c) 32)) c))
|
|
(define (ascii-down-char c)
|
|
(if (and (char<=? #\A c) (char<=? c #\Z))
|
|
(integer->char (fx+ (char->integer c) 32)) c))
|
|
(define (ascii-string-up s) (list->string (map ascii-up-char (string->list s))))
|
|
(define (ascii-string-down s) (list->string (map ascii-down-char (string->list s))))
|
|
|
|
;; --- ASCII trim: drop leading/trailing chars with code <= space (JVM .trim) ---
|
|
(define (str-trim s)
|
|
(let ((len (string-length s)))
|
|
(let scan-l ((i 0))
|
|
(cond ((fx=? i len) "")
|
|
((char<=? (string-ref s i) #\space) (scan-l (fx+ i 1)))
|
|
(else (let scan-r ((j (fx- len 1)))
|
|
(if (char<=? (string-ref s j) #\space)
|
|
(scan-r (fx- j 1))
|
|
(substring s i (fx+ j 1)))))))))
|
|
(define (str-triml s)
|
|
(let ((len (string-length s)))
|
|
(let loop ((i 0))
|
|
(cond ((fx=? i len) "")
|
|
((char<=? (string-ref s i) #\space) (loop (fx+ i 1)))
|
|
(else (substring s i len))))))
|
|
(define (str-trimr s)
|
|
(let loop ((j (fx- (string-length s) 1)))
|
|
(cond ((fx<? j 0) "")
|
|
((char<=? (string-ref s j) #\space) (loop (fx- j 1)))
|
|
(else (substring s 0 (fx+ j 1))))))
|
|
|
|
;; --- substring search: first index of `needle` in `s` at/after `from`, or -1 --
|
|
(define (str-index-of s needle from)
|
|
(let ((nlen (string-length needle)) (slen (string-length s)))
|
|
(let loop ((i (max 0 from)))
|
|
(cond ((fx>? (fx+ i nlen) slen) -1)
|
|
((string=? (substring s i (fx+ i nlen)) needle) i)
|
|
(else (loop (fx+ i 1)))))))
|
|
(define (str-last-index-of s needle)
|
|
(let ((nlen (string-length needle)) (slen (string-length s)))
|
|
(let loop ((i (fx- slen nlen)) (found -1))
|
|
(cond ((fx<? i 0) found)
|
|
((string=? (substring s i (fx+ i nlen)) needle) i)
|
|
(else (loop (fx- i 1) found))))))
|
|
|
|
;; A needle arg: a char value -> its 1-char string; a number -> the char at that
|
|
;; code point (JVM treats an int arg to indexOf as a char code); else a string.
|
|
(define (str-needle x)
|
|
(cond ((char? x) (string x))
|
|
((number? x) (string (integer->char (exact (truncate x)))))
|
|
((string? x) x)
|
|
(else (jolt-str x))))
|
|
|
|
;; literal replace-all (JVM String.replace(CharSequence,CharSequence)).
|
|
(define (str-replace-literal s a b)
|
|
(let ((alen (string-length a)) (slen (string-length s)))
|
|
(if (fx=? alen 0) s
|
|
(let loop ((i 0) (acc '()))
|
|
(cond ((fx>? (fx+ i alen) slen)
|
|
(apply string-append (reverse (cons (substring s i slen) acc))))
|
|
((string=? (substring s i (fx+ i alen)) a)
|
|
(loop (fx+ i alen) (cons b acc)))
|
|
(else (loop (fx+ i 1) (cons (substring s i (fx+ i 1)) acc))))))))
|
|
|
|
;; A compiled irregex for a plain-string Java-regex pattern (or a jolt-regex).
|
|
(define (str-irx pat) (regex-t-irx (jolt-re-pattern pat)))
|
|
|
|
;; JVM String.split: split fully, then drop trailing empty strings.
|
|
(define (str-split-drop-trailing parts)
|
|
(let loop ((p (reverse parts)))
|
|
(if (and (pair? p) (string=? (car p) "")) (loop (cdr p)) (reverse p))))
|
|
|
|
(define (jolt-string-method method s rest)
|
|
(define (arg n) (list-ref rest n))
|
|
(cond
|
|
((string=? method "toString") s)
|
|
((string=? method "toLowerCase") (ascii-string-down s))
|
|
((string=? method "toUpperCase") (ascii-string-up s))
|
|
((string=? method "trim") (str-trim s))
|
|
((string=? method "length") (exact->inexact (string-length s)))
|
|
((string=? method "isEmpty") (fx=? (string-length s) 0))
|
|
((string=? method "charAt") (string-ref s (jolt->idx (arg 0))))
|
|
((string=? method "substring")
|
|
(substring s (jolt->idx (arg 0))
|
|
(if (fx>? (length rest) 1) (jolt->idx (arg 1)) (string-length s))))
|
|
((string=? method "indexOf")
|
|
(exact->inexact
|
|
(str-index-of s (str-needle (arg 0))
|
|
(if (fx>? (length rest) 1) (jolt->idx (arg 1)) 0))))
|
|
((string=? method "lastIndexOf")
|
|
(exact->inexact (str-last-index-of s (str-needle (arg 0)))))
|
|
((string=? method "startsWith")
|
|
(let ((p (arg 0))) (and (fx>=? (string-length s) (string-length p))
|
|
(string=? (substring s 0 (string-length p)) p))))
|
|
((string=? method "endsWith")
|
|
(let ((p (arg 0)) (slen (string-length s)))
|
|
(and (fx>=? slen (string-length p))
|
|
(string=? (substring s (fx- slen (string-length p)) slen) p))))
|
|
((string=? method "contains")
|
|
(fx>=? (str-index-of s (str-needle (arg 0)) 0) 0))
|
|
((string=? method "concat") (string-append s (arg 0)))
|
|
((string=? method "replace") (str-replace-literal s (str-needle (arg 0)) (str-needle (arg 1))))
|
|
((string=? method "equalsIgnoreCase")
|
|
(string=? (ascii-string-down s) (ascii-string-down (arg 0))))
|
|
((string=? method "compareTo")
|
|
(let ((o (arg 0))) (cond ((string<? s o) -1.0) ((string>? s o) 1.0) (else 0.0))))
|
|
((string=? method "getBytes") (string->utf8 s))
|
|
((string=? method "matches") (if (irregex-match (str-irx (arg 0)) s) #t #f))
|
|
((string=? method "replaceAll") (irregex-replace/all (str-irx (arg 0)) s (arg 1)))
|
|
((string=? method "replaceFirst") (irregex-replace (str-irx (arg 0)) s (arg 1)))
|
|
((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))
|