Chez Phase 2 (inc O): host String methods (jolt-nfca)

Port the java.lang.String/CharSequence method surface to the Chez RT so
(.toUpperCase s), (.substring s a b), (.indexOf s x), the regex methods
(.matches/.replaceAll/.replaceFirst/.split), etc. run on a string target.

natives-str.ss holds jolt-string-method, ported from the seed's surface in
eval_resolve.janet: ASCII case mapping (byte-oriented like the seed), -1 on
indexOf miss, flonum numeric returns to match jolt's number model, Scheme
chars for charAt, and the regex methods over the irregex compiled via
jolt-re-pattern. record-method-dispatch gains a string? arm that falls
through to it (unsupported methods still throw).

Corpus prelude floor 2002 -> 2026 (+24), 0 new divergences. _str 27/27 vs
build/jolt; full jpm test + conformance x3 green.

The (. x m) dot-form (the . special form, distinct from .method sugar) and
the clojure.string namespace (needs prelude plumbing + Pattern) stay deferred.

host/chez/jolt-chez.janet

@@ -20,7 +20,8 @@
   (each f ["host/chez/emit.janet" "host/chez/driver.janet" "host/chez/rt.ss"
            "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/ns.ss" "host/chez/post-prelude.ss" "host/chez/natives-meta.ss"
+           "host/chez/natives-str.ss" "host/chez/records.ss"]
     (array/push parts (slurp f)))
   (string/slice (string (hash (string/join parts))) 0))
 

host/chez/natives-str.ss

@@ -0,0 +1,127 @@
+;; 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")))))

host/chez/records.ss

@@ -209,6 +209,9 @@
       ((reified-methods obj)
        => (lambda (rm) (let ((f (hashtable-ref rm method-name #f)))
                          (if f (apply jolt-invoke f obj rest) (error #f (string-append "No method " method-name))))))
+      ;; java.lang.String interop (jolt-nfca): defined in natives-str.ss, loaded
+      ;; after this file (free reference, resolved at call time).
+      ((string? obj) (jolt-string-method method-name obj rest))
       (else (error #f (string-append "No method " method-name " for value"))))))
 
 ;; reify: instance-local method table. obj is a jreify carrying a method ht +

host/chez/rt.ss

@@ -265,3 +265,9 @@
 ;; frame is seen by every var read. Loaded LAST: needs the fully-extended var-read
 ;; paths + jolt-hash-map/pmap-fold/pmap-assoc (collections.ss).
 (load "host/chez/dyn-binding.ss")
+
+;; java.lang.String method interop (jolt-nfca, Phase 2): jolt-string-method, the
+;; portable String/CharSequence surface record-method-dispatch falls through to on
+;; a string target. After regex.ss (jolt-re-pattern/regex-t-irx) + records.ss
+;; (which references jolt-string-method).
+(load "host/chez/natives-str.ss")

test/chez/_str.janet

@@ -0,0 +1,65 @@
+# jolt-nfca — host java.lang.String method interop on Chez: (.toUpperCase s),
+# (.indexOf s x), (.substring s a b), the regex methods (.matches/.replaceAll/
+# .replaceFirst), etc. Ported from the seed's string-methods surface
+# (src/jolt/eval_resolve.janet). Expectations are the build/jolt (seed) oracle.
+# An expected of :throws asserts a non-zero exit (unsupported method).
+#
+#   janet test/chez/_str.janet
+(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
+
+(def cases
+  [["toLowerCase"      "(.toLowerCase \"HI\")"                  "hi"]
+   ["toUpperCase"      "(.toUpperCase \"hi\")"                  "HI"]
+   ["trim"             "(.trim \"  x  \")"                      "x"]
+   ["length"           "(.length \"abc\")"                      "3"]
+   ["isEmpty"          "[(.isEmpty \"\") (.isEmpty \"a\")]"     "[true false]"]
+   ["indexOf hit"      "(.indexOf \"abc\" \"b\")"               "1"]
+   ["indexOf miss"     "(.indexOf \"abc\" \"z\")"               "-1"]
+   ["indexOf from"     "(.indexOf \"abab\" \"a\" 1)"            "2"]
+   ["indexOf int code" "(.indexOf \"a=b\" 61)"                  "1"]
+   ["lastIndexOf"      "(.lastIndexOf \"abab\" \"b\")"          "3"]
+   ["substring 1"      "(.substring \"abc\" 1)"                 "bc"]
+   ["substring 1 2"    "(.substring \"abc\" 1 2)"               "b"]
+   ["startsWith"       "(.startsWith \"abc\" \"ab\")"           "true"]
+   ["endsWith"         "(.endsWith \"abc\" \"bc\")"             "true"]
+   ["contains"         "(.contains \"abc\" \"b\")"              "true"]
+   ["replace literal"  "(.replace \"abc\" \"b\" \"x\")"         "axc"]
+   ["replace all occ"  "(.replace \"aaa\" \"a\" \"b\")"         "bbb"]
+   ["charAt"           "(.charAt \"abc\" 1)"                    "\\b"]
+   ["equalsIgnoreCase" "(.equalsIgnoreCase \"AbC\" \"aBc\")"    "true"]
+   ["toString"         "(.toString \"hi\")"                     "hi"]
+   ["concat"           "(.concat \"ab\" \"cd\")"                "abcd"]
+   ["matches whole"    "(.matches \"abc\" \"a.c\")"             "true"]
+   ["matches partial"  "(.matches \"abcd\" \"a.c\")"            "false"]
+   ["replaceAll"       "(.replaceAll \"a_b_c\" \"_\" \"-\")"    "a-b-c"]
+   ["replaceFirst"     "(.replaceFirst \"a_b_c\" \"_\" \"-\")"  "a-b_c"]
+   ["split regex"      "(vec (.split \"a,b,c\" \",\"))"         "[a b c]"]
+   ["unsupported"      "(.frobnicate \"abc\")"                  :throws]])
+
+(defn run-capture [expr]
+  (def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
+  (def out (ev/read (proc :out) 0x100000))
+  (def err (ev/read (proc :err) 0x100000))
+  (def code (os/proc-wait proc))
+  (def lines (filter (fn [l] (not (empty? l)))
+                     (string/split "\n" (string/trim (if out (string out) "")))))
+  [code (if (empty? lines) "" (last lines)) (if err (string err) "")])
+
+(var pass 0)
+(def fails @[])
+(each [label expr expected] cases
+  (def [code got err] (run-capture expr))
+  (cond
+    (= expected :throws)
+      (if (not= code 0) (++ pass)
+        (array/push fails [label (string "want throw, got `" got "` (exit 0)")]))
+    (not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
+    (= got expected) (++ pass)
+    (array/push fails [label (string "want `" expected "`, got `" got "`")])))
+
+(printf "\n_str parity [%s]: %d/%d passed" jolt-bin pass (length cases))
+(when (> (length fails) 0)
+  (printf "%d FAIL(s):" (length fails))
+  (each [l m] fails (printf "  FAIL [%s] %s" l m)))
+(flush)
+(os/exit (if (empty? fails) 0 1))

test/chez/run-corpus-prelude.janet

@@ -195,8 +195,13 @@
 # with-in-str/line-seq) 2000.
 # jolt-fmm4 ((type x) — :type meta override, record ns-qualified class-name
 # symbol, total value->taxonomy keyword mapping) 2002.
+# jolt-nfca (host java.lang.String method interop — jolt-string-method, the
+# portable String/CharSequence surface record-method-dispatch falls through to on
+# a string target: case/trim/length/indexOf/substring/startsWith/contains/replace/
+# charAt/equalsIgnoreCase + the regex methods matches/replaceAll/replaceFirst/
+# split) 2026.
 # Strided runs scale down.
-(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2002")))
+(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2026")))
 (def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
 (when (or (> (length diverged) 0) (< pass floor))
   (printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))