From 62e636e52cf3c18fdf337b9acb54d4f69cc0a85e Mon Sep 17 00:00:00 2001 From: Yogthos Date: Fri, 19 Jun 2026 10:40:19 -0400 Subject: [PATCH] Chez Phase 2 (inc W): reader-coupled io (jolt-at0a) clojure.java.io/reader as an in-memory StringReader over slurp/string/char[]/ File; File .toURL/.toURI returning a url jhost (.toString/.getPath); slurp drains a StringReader; char-array; with-open's __close seam over jhost readers and plain :close maps. All in host/chez/io.ss (Chez-native, no analyzer change). Corpus 2191->2202, 0 new divergences. clojure.edn/read over a PushbackReader stays jolt-r8ku (runtime read). --- host/chez/io.ss | 90 +++++++++++++++++++++++++++++- test/chez/_ioreader.janet | 64 +++++++++++++++++++++ test/chez/run-corpus-prelude.janet | 6 +- 3 files changed, 156 insertions(+), 4 deletions(-) create mode 100644 test/chez/_ioreader.janet diff --git a/host/chez/io.ss b/host/chez/io.ss index 0f5027d..b5bed88 100644 --- a/host/chez/io.ss +++ b/host/chez/io.ss @@ -40,6 +40,25 @@ (sort string (string-length p) 0) (char=? (string-ref p 0) #\/)) p + (string-append (current-directory) "/" p))) + +;; --- java.net.URL (a jhost "url", state #(spec)) ---------------------------- +;; A File.toURL value: .toString / .toExternalForm give the spec, .getPath / +;; .getFile strip the "file:" scheme. (Mirrors host_io.janet's :jolt/url.) +(define (make-url spec) (make-jhost "url" (vector spec))) +(define (url-spec u) (vector-ref (jhost-state u) 0)) +(define (url-strip-scheme spec) + (if (and (>= (string-length spec) 5) (string=? (substring spec 0 5) "file:")) + (substring spec 5 (string-length spec)) spec)) +(register-host-methods! "url" + (list (cons "toString" (lambda (self) (url-spec self))) + (cons "toExternalForm" (lambda (self) (url-spec self))) + (cons "getPath" (lambda (self) (url-strip-scheme (url-spec self)))) + (cons "getFile" (lambda (self) (url-strip-scheme (url-spec self)))))) + ;; --- File method surface (record-method-dispatch arm) ----------------------- (define (jfile-method f name args) ; -> boxed result, or #f to fall through (let ((p (jfile-path f))) @@ -47,7 +66,10 @@ ((string=? name "getPath") (list p)) ((string=? name "getName") (list (path-last-segment p))) ((string=? name "toString") (list p)) - ((string=? name "getAbsolutePath")(list p)) + ((string=? name "getAbsolutePath")(list (jfile-abs p))) + ((string=? name "getCanonicalPath")(list (jfile-abs p))) + ((string=? name "toURI") (list (string-append "file:" (jfile-abs p)))) + ((string=? name "toURL") (list (make-url (string-append "file:" (jfile-abs p))))) ((string=? name "exists") (list (if (file-exists? p) #t #f))) ((string=? name "isDirectory") (list (if (file-directory? p) #t #f))) ((string=? name "isFile") (list (if (and (file-exists? p) (not (file-directory? p))) #t #f))) @@ -86,11 +108,25 @@ (let ((p (open-input-file path))) (let ((s (get-string-all p))) (close-port p) (if (eof-object? s) "" s)))) +;; Drain a jhost reader (StringReader / PushbackReader): read code units from the +;; current position to EOF (-1) and assemble the string. Used by slurp; advances +;; the reader, as on the JVM. +(define (drain-reader r) + (let loop ((acc '())) + (let ((u (record-method-dispatch r "read" jolt-nil))) + (if (or (jolt-nil? u) (and (number? u) (< u 0))) + (list->string (reverse acc)) + (loop (cons (integer->char (exact (truncate u))) acc)))))) + +(define (reader-jhost? x) + (and (jhost? x) (member (jhost-tag x) '("string-reader" "pushback-reader")))) + (define (jolt-slurp src . opts) (cond ((jfile? src) (read-file-string (jfile-path src))) + ((reader-jhost? src) (drain-reader src)) ((string? src) (read-file-string src)) - (else (error #f "slurp: unsupported source (reader io is jolt-at0a)" src)))) + (else (error #f "slurp: unsupported source" src)))) (define (spit-append? opts) (let loop ((o opts)) @@ -144,6 +180,54 @@ (def-var! "clojure.core" "spit" jolt-spit) (def-var! "clojure.core" "flush" jolt-flush) -;; --- clojure.java.io ns (file/as-file; reader/writer are jolt-at0a) --------- +;; --- char-array: a seq of chars over a string (the JVM char[]). io/reader's +;; char[] branch + selmer's (char-array template) feed on this. Mirrors the seed +;; core-char-array (string -> chars). A leaf array native; lives here as io/reader +;; is its only Chez consumer so far. +(define (jolt-char-array a . rest) + (cond + ((string? a) (list->cseq (string->list a))) + ((number? a) (list->cseq (make-list (exact (truncate a)) #\nul))) + (else (list->cseq (map (lambda (c) (if (char? c) c (integer->char (exact (truncate c))))) + (seq->list a)))))) +(def-var! "clojure.core" "char-array" jolt-char-array) + +;; --- with-open's close seam (__close): a map-like value closes via its :close +;; fn; a jhost reader/writer/file via its .close method (a no-op here); anything +;; else is an error. Mirrors core_extra.janet core-close-resource. +(define (jolt-close x) + (cond + ((jolt-nil? x) jolt-nil) + ((and (jhost? x) (member (jhost-tag x) '("string-reader" "pushback-reader" "writer"))) + (record-method-dispatch x "close" jolt-nil) jolt-nil) + ((jfile? x) jolt-nil) + (else + (let ((closef (jolt-get x (keyword #f "close") jolt-nil))) + (if (and (not (jolt-nil? closef)) (procedure? closef)) + (begin (jolt-invoke closef) jolt-nil) + (error #f "with-open: don't know how to close" x)))))) +(def-var! "clojure.core" "__close" jolt-close) + +;; --- clojure.java.io/reader: an in-memory java.io.Reader over the source. An +;; existing reader passes through; a File / path / URL is slurped; a char[] (or +;; any seq) becomes a reader over (apply str …). Mirrors io.clj's reader. Returns +;; a StringReader (host-static.ss jhost) so .read/.mark/.reset and slurp work. +(define (seq-source->string x) + (apply string-append (map jolt-str-render-one (seq->list x)))) +(define (jolt-io-reader x) + (cond + ((reader-jhost? x) x) + ((jfile? x) (host-new "StringReader" (read-file-string (jfile-path x)))) + ((and (jhost? x) (string=? (jhost-tag x) "url")) + (host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x))))) + ((string? x) (host-new "StringReader" (read-file-string x))) + ((or (cseq? x) (empty-list-t? x) (pvec? x)) + (host-new "StringReader" (seq-source->string x))) + (else (host-new "StringReader" (jolt-str-render-one x))))) + +;; --- clojure.java.io ns ----------------------------------------------------- (def-var! "clojure.java.io" "file" jolt-make-file) (def-var! "clojure.java.io" "as-file" (lambda (x) (if (jfile? x) x (make-jfile (file-path-of x))))) +(def-var! "clojure.java.io" "reader" jolt-io-reader) +(def-var! "clojure.java.io" "input-stream" jolt-io-reader) +(def-var! "clojure.java.io" "as-url" (lambda (x) (if (and (jhost? x) (string=? (jhost-tag x) "url")) x (make-url (jolt-str-render-one x))))) diff --git a/test/chez/_ioreader.janet b/test/chez/_ioreader.janet new file mode 100644 index 0000000..c066d6e --- /dev/null +++ b/test/chez/_ioreader.janet @@ -0,0 +1,64 @@ +# jolt-at0a (inc W) — reader-coupled io deferred from inc V (jolt-yyud): +# clojure.java.io/reader (a StringReader over slurp/string/char[]/File/path), +# char-array, File.toURL/.toURI (-> a java.net.URL jhost), slurp draining a +# StringReader, and with-open's __close seam over both jhost readers and plain +# :close maps. All Chez-native (host/chez/io.ss); no analyzer change. Reader/edn +# runtime read (clojure.edn/read over a PushbackReader) stays jolt-r8ku. +# Oracle = build/jolt. +# +# janet test/chez/_ioreader.janet +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) + +(defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")")) + +(def cases + [# --- char-array --- + ["(str (char-array \"abc\"))" "(\\a \\b \\c)"] + ["(.read (StringReader. (apply str (char-array \"Qz\"))))" "81"] + # --- io/reader: char[] / string-reader passthrough / path --- + [(io "(.read (io/reader (char-array \"abc\")))") "97"] + [(io "(.read (io/reader (StringReader. \"k\")))") "107"] + [(io "(slurp (io/reader (char-array \"xyz\")))") "xyz"] + [(io "(string? (slurp (io/reader \"project.janet\")))") "true"] + # --- File.toURL / .toURI --- + [(io "(.toString (.toURL (io/file \"/tmp/x\")))") "file:/tmp/x"] + [(io "(.toURI (io/file \"/tmp/x\"))") "file:/tmp/x"] + [(io "(.getPath (.toURL (io/file \"/tmp/x\")))") "/tmp/x"] + [(io "(.getAbsolutePath (io/file \"/a/b\"))") "/a/b"] + # --- slurp drains a StringReader (+ ignores :encoding opts) --- + ["(slurp (StringReader. \"a=1\"))" "a=1"] + ["(slurp (StringReader. \"b\") :encoding \"UTF-8\")" "b"] + # --- with-open: jhost reader + plain :close map --- + ["(with-open [r (StringReader. \"a\")] (.read r))" "97"] + ["(let [log (atom [])] (with-open [c {:close (fn [] (swap! log conj :closed))}] :r) (deref log))" "[:closed]"] + ["(let [log (atom [])] (try (with-open [c {:close (fn [] (swap! log conj :closed))}] (throw (ex-info \"boom\" {}))) (catch Exception e nil)) (deref log))" "[:closed]"] + ["(let [log (atom [])] (with-open [a {:close (fn [] (swap! log conj :outer))} b {:close (fn [] (swap! log conj :inner))}] :r) (deref log))" "[:inner :outer]"] + ["(with-open [c {:close (fn [] nil) :v 5}] (:v c))" "5"]]) + +(defn run-capture [bin expr] + (def proc (os/spawn [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)) (string/trim (if err (string err) ""))]) + +(var pass 0) +(def fails @[]) +(each [expr expected] cases + (def [ocode oracle _] (run-capture "build/jolt" expr)) + (def [code got err] (run-capture jolt-bin expr)) + (cond + (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) + (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) + (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) + (= got expected) (++ pass) + (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) + +(printf "\n_ioreader parity [%s]: %d/%d passed" jolt-bin pass (length cases)) +(when (> (length fails) 0) + (printf "%d FAIL(s):" (length fails)) + (each [e m] fails (printf " FAIL %s\n %s" e m))) +(flush) +(os/exit (if (empty? fails) 0 1)) diff --git a/test/chez/run-corpus-prelude.janet b/test/chez/run-corpus-prelude.janet index 287afd4..6933814 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -257,8 +257,12 @@ # slurp/spit/flush over Chez file I/O, file-seq dir primitives, clojure.java.io/ # file — host/chez/io.ss, a Chez-native impl since io.clj is a janet.* shim; # reader/StringReader-coupled io deferred to jolt-at0a) 2191. +# jolt-at0a inc W (reader-coupled io — clojure.java.io/reader over a StringReader +# (slurp/string/char[]/File), File .toURL/.toURI + a url jhost, slurp draining a +# StringReader, char-array, and with-open's __close seam over jhost readers + plain +# :close maps; all in host/chez/io.ss, no analyzer change) 2202. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2191"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2202"))) (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)))