From 3ab53ba93847fa1c0afa6eea64df1834da1e4cb0 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Thu, 18 Jun 2026 20:36:39 -0400 Subject: [PATCH] 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 | 3 +- host/chez/natives-str.ss | 127 +++++++++++++++++++++++++++++ host/chez/records.ss | 3 + host/chez/rt.ss | 6 ++ test/chez/_str.janet | 65 +++++++++++++++ test/chez/run-corpus-prelude.janet | 7 +- 6 files changed, 209 insertions(+), 2 deletions(-) create mode 100644 host/chez/natives-str.ss create mode 100644 test/chez/_str.janet diff --git a/host/chez/jolt-chez.janet b/host/chez/jolt-chez.janet index 2af3560..4ffa8ee 100644 --- a/host/chez/jolt-chez.janet +++ b/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)) diff --git a/host/chez/natives-str.ss b/host/chez/natives-str.ss new file mode 100644 index 0000000..20d60c0 --- /dev/null +++ b/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? (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 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) (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"))))) diff --git a/host/chez/records.ss b/host/chez/records.ss index 447f2b5..abaa2da 100644 --- a/host/chez/records.ss +++ b/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 + diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 00ac8ff..e2b4794 100644 --- a/host/chez/rt.ss +++ b/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") diff --git a/test/chez/_str.janet b/test/chez/_str.janet new file mode 100644 index 0000000..49c6266 --- /dev/null +++ b/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)) \ No newline at end of file diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index 0f340ff..c728e8c 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/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)))