From b38a7dd0076a2b499cda14c04cd544de9ac50674 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Fri, 19 Jun 2026 10:02:12 -0400 Subject: [PATCH] Chez Phase 2 (inc V): java.io.File + slurp/spit/flush/file-seq (jolt-yyud) A File is a path-backed jfile record: (instance? java.io.File f) is true, str/slurp coerce it to its path, and the File method surface (getName/ getPath/exists/isDirectory/isFile/listFiles/getParent) dispatches through record-method-dispatch. slurp/spit/flush run over Chez's filesystem primitives; file-seq's dir primitives (__file?/__dir?/__list-dir) and the overlay's File branch (.isDirectory/.listFiles, which emit to jolt-host-call) are jfile-aware. clojure.java.io/file + as-file are def-var!'d natively. New host/chez/io.ss, a Chez-native implementation -- the seed's clojure.java.io (io.clj) is a Janet-backed shim over janet.*/janet.file, so it can't be reused. The analyzer resolves io/file because the seed ctx has clojure.java.io loaded; only a runtime def-var! is needed. type/instance- check/str-render/jolt-host-call are extended via the set!-wrap pattern (type also re-def-var!'d since the var cell captured the old value). Reader/StringReader-coupled io (io/reader, line-seq over a file, .toURL, slurp over a reader) deferred to jolt-at0a. Parity 2176 -> 2191, 0 new divergences. New test/chez/_io.janet 20/20. --- host/chez/io.ss | 149 +++++++++++++++++++++++++++++ host/chez/jolt-chez.janet | 2 +- host/chez/rt.ss | 6 ++ test/chez/_io.janet | 65 +++++++++++++ test/chez/run-corpus-prelude.janet | 6 +- 5 files changed, 226 insertions(+), 2 deletions(-) create mode 100644 host/chez/io.ss create mode 100644 test/chez/_io.janet diff --git a/host/chez/io.ss b/host/chez/io.ss new file mode 100644 index 0000000..0f5027d --- /dev/null +++ b/host/chez/io.ss @@ -0,0 +1,149 @@ +;; java.io.File + host file I/O (jolt-yyud). The seed's clojure.java.io (io.clj) +;; is a Janet-backed shim (janet.*/janet.file) — not reusable here, so this is a +;; Chez-native implementation over Chez's filesystem primitives. A File is a +;; path-backed jfile record: (instance? java.io.File f) is true, str/slurp coerce +;; it to its path, and the File method surface (getName/getPath/exists/ +;; isDirectory/isFile/listFiles) dispatches through record-method-dispatch. +;; +;; Mirrors src/jolt/core_io.janet (core-make-file/file?/slurp/spit/flush/dir?/ +;; list-dir) and the overlay file-seq (20-coll.clj), which calls __file?/__dir?/ +;; __list-dir + the .isDirectory/.listFiles/.isFile method surface. +;; +;; Reader/StringReader-coupled io (io/reader, line-seq over a file, .toURL, +;; slurp over a reader) is deferred to jolt-at0a. Loaded LAST in rt.ss, after +;; dot-forms.ss (so the jfile method arm wraps the fully-built dispatch) and +;; natives-meta.ss / records.ss / printing.ss (jolt-type / instance-check / +;; jolt-str-render-one, which it extends). + +(define-record-type jfile (fields path) (nongenerative jolt-jfile-v1)) +(define (jolt-file? x) (jfile? x)) + +;; path string of any value: a jfile -> its path, else its str rendering. +(define (file-path-of x) (if (jfile? x) (jfile-path x) (jolt-str-render-one x))) + +;; (io/file path) / (io/file parent child) — join children with "/". +(define (jolt-make-file path . rest) + (let loop ((p (file-path-of path)) (cs rest)) + (if (null? cs) (make-jfile p) + (loop (string-append p "/" (file-path-of (car cs))) (cdr cs))))) + +(define (path-last-segment p) + (let loop ((i (- (string-length p) 1))) + (cond ((< i 0) p) + ((char=? (string-ref p i) #\/) (substring p (+ i 1) (string-length p))) + (else (loop (- i 1)))))) + +;; directory children as full paths, sorted (the __list-dir seed primitive). +(define (jolt-list-dir path) + (let ((p (file-path-of path))) + (map (lambda (e) (string-append p "/" e)) + (sort string boxed result, or #f to fall through + (let ((p (jfile-path f))) + (cond + ((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 "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))) + ((string=? name "listFiles") (list (list->cseq (map make-jfile (jolt-list-dir p))))) + ((string=? name "getParent") + (let loop ((i (- (string-length p) 1))) + (cond ((< i 0) (list jolt-nil)) + ((char=? (string-ref p i) #\/) (list (if (= i 0) "/" (substring p 0 i)))) + (else (loop (- i 1)))))) + (else #f)))) + +(define %io-rmd record-method-dispatch) +(set! record-method-dispatch + (lambda (obj method-name rest-args) + (if (jfile? obj) + (let* ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args))) + (r (jfile-method obj method-name rest))) + (if r (car r) (error #f "no File method" method-name))) + (%io-rmd obj method-name rest-args)))) + +;; .isDirectory / .listFiles emit to jolt-host-call (rt.ss), not record-method- +;; dispatch (emit.janet supported-host-methods) — the Phase-1 shims there assume a +;; path STRING target. Make them jfile-aware so file-seq's File branch works. +(define %io-host-call jolt-host-call) +(set! jolt-host-call + (lambda (method target . args) + (cond + ((and (jfile? target) (string=? method "isDirectory")) + (if (file-directory? (jfile-path target)) #t #f)) + ((and (jfile? target) (string=? method "listFiles")) + (list->cseq (map make-jfile (jolt-list-dir target)))) + (else (apply %io-host-call method target args))))) + +;; --- slurp / spit / flush --------------------------------------------------- +(define (read-file-string path) + (let ((p (open-input-file path))) + (let ((s (get-string-all p))) (close-port p) (if (eof-object? s) "" s)))) + +(define (jolt-slurp src . opts) + (cond + ((jfile? src) (read-file-string (jfile-path src))) + ((string? src) (read-file-string src)) + (else (error #f "slurp: unsupported source (reader io is jolt-at0a)" src)))) + +(define (spit-append? opts) + (let loop ((o opts)) + (cond ((or (null? o) (null? (cdr o))) #f) + ((and (keyword-t? (car o)) (string=? (keyword-t-name (car o)) "append") + (jolt-truthy? (cadr o))) #t) + (else (loop (cddr o)))))) + +(define (jolt-spit path content . opts) + (let* ((p (file-path-of path)) + (port (open-output-file p (if (spit-append? opts) 'append 'truncate)))) + (put-string port (jolt-str-render-one content)) + (close-port port) + jolt-nil)) + +(define (jolt-flush) (flush-output-port (current-output-port)) jolt-nil) + +;; --- str / type / instance? integration ------------------------------------ +;; str of a jfile is its path (Clojure's File.toString). +(define %io-str-render jolt-str-render-one) +(set! jolt-str-render-one + (lambda (v) (if (jfile? v) (jfile-path v) (%io-str-render v)))) + +;; (type f) -> :jolt/file, matching the seed's tagged-file :jolt/type. Re-def-var! +;; "type": natives-meta.ss already bound the var to the old jolt-type value, so the +;; set! alone (which updates the symbol for internal callers) wouldn't reach it. +(define io-kw-file (keyword "jolt" "file")) +(define %io-type jolt-type) +(set! jolt-type (lambda (x) (if (jfile? x) io-kw-file (%io-type x)))) +(def-var! "clojure.core" "type" jolt-type) + +;; (instance? java.io.File f): the instance? macro passes the class-name symbol; +;; match "File" / "java.io.File" (and any *.File) against a jfile. +(define %io-instance-check instance-check) +(set! instance-check + (lambda (type-sym val) + (let ((tname (symbol-t-name type-sym))) + (if (and (jfile? val) + (or (string=? tname "File") (string=? tname "java.io.File") + (string=? (path-last-segment tname) "File"))) + #t + (%io-instance-check type-sym val))))) +(def-var! "clojure.core" "instance-check" instance-check) + +;; --- def-var! the seed-native names the overlay file-seq + str/slurp use ---- +(def-var! "clojure.core" "__make-file" jolt-make-file) +(def-var! "clojure.core" "__file?" jolt-file?) +(def-var! "clojure.core" "__dir?" jolt-dir?) +(def-var! "clojure.core" "__list-dir" (lambda (p) (list->cseq (jolt-list-dir p)))) +(def-var! "clojure.core" "slurp" jolt-slurp) +(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) --------- +(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))))) diff --git a/host/chez/jolt-chez.janet b/host/chez/jolt-chez.janet index bbc24e3..4977fe6 100644 --- a/host/chez/jolt-chez.janet +++ b/host/chez/jolt-chez.janet @@ -22,7 +22,7 @@ "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/host-class.ss" + "host/chez/host-class.ss" "host/chez/io.ss" "host/chez/host-static.ss" "host/chez/dot-forms.ss" "src/jolt/clojure/string.clj" "src/jolt/clojure/walk.clj" "src/jolt/clojure/template.clj"] diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 0d32861..baa824d 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -287,3 +287,9 @@ ;; for the `.` / `.-field` desugar. Loads after host-static.ss so it wraps every ;; record-method-dispatch arm (jhost/number/regex/jrec/string) and falls through. (load "host/chez/dot-forms.ss") + +;; java.io.File + host file I/O (jolt-yyud): path-backed jfile record, slurp/spit/ +;; flush, file-seq dir primitives, clojure.java.io/file. Loads LAST so its jfile +;; arm wraps the fully-built record-method-dispatch and the str/type/instance-check +;; extensions sit over every prior shim. +(load "host/chez/io.ss") diff --git a/test/chez/_io.janet b/test/chez/_io.janet new file mode 100644 index 0000000..e29a82b --- /dev/null +++ b/test/chez/_io.janet @@ -0,0 +1,65 @@ +# jolt-yyud — clojure.java.io/file + java.io.File interop + slurp/spit/flush/ +# file-seq on Chez. A File is a path-backed jfile record (instance? java.io.File, +# str -> path, the File method surface). io.clj is a Janet-backed shim (janet.*), +# so this is a Chez-native implementation, not a port of it. Reader/StringReader- +# coupled cases (line-seq, slurp over a reader, toURL) are deferred to jolt-at0a. +# Oracle = build/jolt. +# +# janet test/chez/_io.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 + [# --- File construction + method surface --- + [(io "(str (io/file \"/a/b\"))") "/a/b"] + [(io "(str (io/file \"/a\" \"b\"))") "/a/b"] + [(io "(.getName (io/file \"/a/b/c.txt\"))") "c.txt"] + [(io "(.getPath (io/file \"/a\" \"b\"))") "/a/b"] + [(io "(.isDirectory (io/file \"docs\"))") "true"] + [(io "(.isFile (io/file \"project.janet\"))") "true"] + [(io "(.isFile (io/file \"docs\"))") "false"] + [(io "(.exists (io/file \"/no/such/path/xyz\"))") "false"] + [(io "(.exists (io/file \"project.janet\"))") "true"] + # --- instance? + type --- + [(io "(instance? java.io.File (io/file \"/a/b\"))") "true"] + [(io "(instance? java.io.File \"/a/b\")") "false"] + [(io "(str (type (io/file \"/a\")))") ":jolt/file"] + # --- file-seq --- + [(io "(every? (fn [f] (instance? java.io.File f)) (file-seq (io/file \"docs\")))") "true"] + [(io "(pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\")))))") "true"] + ["(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))" "true"] + # --- slurp / spit / flush --- + ["(string? (slurp \"project.janet\"))" "true"] + ["(do (spit \"/tmp/jolt-io-test.txt\" \"hello\") (slurp \"/tmp/jolt-io-test.txt\"))" "hello"] + ["(do (spit \"/tmp/jolt-io-test.txt\" \"a\") (spit \"/tmp/jolt-io-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-io-test.txt\"))" "ab"] + ["(flush)" ""] + [(io "(string? (slurp (io/file \"project.janet\")))") "true"]]) + +(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_io 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 7c39dba..287afd4 100644 --- a/test/chez/run-corpus-prelude.janet +++ b/test/chez/run-corpus-prelude.janet @@ -253,8 +253,12 @@ # map-entry is now vector? matching Clojure's MapEntry; clojure.walk + clojure. # template added to the prelude stdlib tier, the driver evals each ns's requires # to register aliases at emit time) 2176. +# jolt-yyud (java.io.File as a path-backed jfile record + the File method surface, +# 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. # Strided runs scale down. -(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2176"))) +(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2191"))) (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)))