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

@@ -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<? (directory-list p)))))
+(define (jolt-dir? path) (if (file-directory? (file-path-of path)) #t #f))
+
+;; --- 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)))
+    (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)))))

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"]

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")

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))

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)))