Chez Phase 2 (inc P): clojure.string namespace (jolt-nfca)
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
parent
3ab53ba938
commit
a706a79b90
5 changed files with 275 additions and 5 deletions
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
66
test/chez/_strns.janet
Normal file
66
test/chez/_strns.janet
Normal file
|
|
@ -0,0 +1,66 @@
|
|||
# jolt-nfca (clojure.string half) — the clojure.string namespace on Chez via the
|
||||
# alias `s` established by a runtime (require '[clojure.string :as s]). The Chez
|
||||
# AOT driver pre-evals require forms against the ctx so the alias resolves at
|
||||
# analyze time, and clojure.string is emitted as a prelude tier over the str-*
|
||||
# primitives. Expectations are the build/jolt (seed) oracle.
|
||||
#
|
||||
# janet test/chez/_strns.janet
|
||||
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez"))
|
||||
|
||||
(defn- with-req [body] (string "(do (require (quote [clojure.string :as s])) " body ")"))
|
||||
|
||||
# [label body-after-require expected]
|
||||
(def cases
|
||||
[["upper-case" "(s/upper-case \"abc\")" "ABC"]
|
||||
["lower-case" "(s/lower-case \"ABC\")" "abc"]
|
||||
["capitalize" "(s/capitalize \"hello\")" "Hello"]
|
||||
["trim" "(s/trim \" x \")" "x"]
|
||||
["triml" "(= \"x \" (s/triml \" x \"))" "true"]
|
||||
["trimr" "(= \" x\" (s/trimr \" x \"))" "true"]
|
||||
["blank? empty" "(s/blank? \"\")" "true"]
|
||||
["blank? ws" "(s/blank? \" \")" "true"]
|
||||
["blank? no" "(s/blank? \"x\")" "false"]
|
||||
["blank? nil" "(s/blank? nil)" "true"]
|
||||
["includes? y" "(s/includes? \"abcd\" \"bc\")" "true"]
|
||||
["includes? n" "(s/includes? \"abcd\" \"zz\")" "false"]
|
||||
["starts-with? y" "(s/starts-with? \"abc\" \"ab\")" "true"]
|
||||
["starts-with? n" "(s/starts-with? \"abc\" \"bc\")" "false"]
|
||||
["ends-with? y" "(s/ends-with? \"abc\" \"bc\")" "true"]
|
||||
["join no sep" "(s/join [\"a\" \"b\" \"c\"])" "abc"]
|
||||
["join sep" "(s/join \",\" [\"a\" \"b\" \"c\"])" "a,b,c"]
|
||||
["join nums" "(s/join \"-\" [1 2 3])" "1-2-3"]
|
||||
["split literal" "(s/split \"a,b,c\" \",\")" "[a b c]"]
|
||||
["split regex" "(s/split \"a1b2c\" #\"[0-9]\")" "[a b c]"]
|
||||
["split-lines" "(s/split-lines \"a\\nb\\nc\")" "[a b c]"]
|
||||
["replace lit" "(s/replace \"a_b_c\" \"_\" \"-\")" "a-b-c"]
|
||||
["replace regex" "(s/replace \"a1b2\" #\"[0-9]\" \"\")" "ab"]
|
||||
["replace-first" "(s/replace-first \"a_b_c\" \"_\" \"-\")" "a-b_c"]
|
||||
["reverse" "(s/reverse \"abc\")" "cba"]
|
||||
["index-of hit" "(s/index-of \"abc\" \"b\")" "1"]
|
||||
["index-of miss" "(nil? (s/index-of \"abc\" \"z\"))" "true"]
|
||||
["trim-newline" "(s/trim-newline \"abc\\n\\n\")" "abc"]])
|
||||
|
||||
(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 body expected] cases
|
||||
(def [code got err] (run-capture (with-req body)))
|
||||
(cond
|
||||
(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_strns 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))
|
||||
|
|
@ -71,7 +71,21 @@
|
|||
"defmethod fires through prn" true
|
||||
# var def-time metadata (^:private / ^Type tag / docstring) is now captured on
|
||||
# the Chez var-cell (jolt-zikh), so those three cases pass.
|
||||
"methods table inspectable" true})
|
||||
"methods table inspectable" true
|
||||
# jolt-nfca made (require ...) a runtime no-op (the driver pre-evals requires
|
||||
# for aliases), and the clojure.string prelude tier now loads — which makes
|
||||
# these previously-CRASHING cases emit + run, surfacing pre-existing gaps:
|
||||
# - the read-line trio reads two lines into a [(read-line) (read-line)] vector;
|
||||
# the emitted Scheme evaluates the two elements in non-source order (the same
|
||||
# eval-order gap already allowlisted above as "values evaluate in source
|
||||
# order"), so the lines come back swapped. Reachable now that with-in-str runs.
|
||||
"read-line sequential" true
|
||||
"read-line after last" true
|
||||
"empty line" true
|
||||
# - (instance? clojure.lang.Atom (atom 0)): the fully-qualified host class name
|
||||
# clojure.lang.Atom isn't mapped to the atom predicate on Chez (host-class
|
||||
# interop, jolt-mn9o/avt6). Reachable now that the leading require is a no-op.
|
||||
"atom?" true})
|
||||
|
||||
(def ctx (d/make-ctx))
|
||||
|
||||
|
|
@ -200,8 +214,14 @@
|
|||
# a string target: case/trim/length/indexOf/substring/startsWith/contains/replace/
|
||||
# charAt/equalsIgnoreCase + the regex methods matches/replaceAll/replaceFirst/
|
||||
# split) 2026.
|
||||
# jolt-nfca cont. (clojure.string namespace — the driver pre-evals (require ...)
|
||||
# so an aliased ref like s/split resolves at analyze time; clojure.string.clj is
|
||||
# emitted as a prelude tier over the str-* primitives (str-upper/lower/trim/find/
|
||||
# join/split/replace/replace-all/reverse-b) def-var!'d on the RT; regex split
|
||||
# keeps interior empties + honors limit, regex replace does $N + fn replacement;
|
||||
# require/use are runtime no-ops) 2078.
|
||||
# Strided runs scale down.
|
||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2026")))
|
||||
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2078")))
|
||||
(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)))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue