simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #200 from jolt-lang/feat/java-io-streams

Browse source 
java.io: full File API + byte/char streams over Chez ports
This commit is contained in:
Dmitri Sotnikov 2026-06-25 02:17:02 +00:00 • committed by GitHub
commit 9c48440a43
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
5 changed files with 480 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

29
docs/host-interop.md
View file

@ -70,12 +70,29 @@ aren't implemented; a few are accepted but no-ops (noted inline).
### I/O ### I/O
- **`java.io.File`** — `(File. path)` / `(File. parent child)`; `getPath` - **`java.io.File`** — `(File. path)` / `(File. parent child)`. A File keeps the
`getName` `getAbsolutePath` `getCanonicalPath` `toURI` `toURL` `exists` path as given (`(.getPath (File. "rel"))` is `"rel"`, `.isAbsolute` false); a
`isDirectory` `isFile` `listFiles` `getParent`. relative path resolves against `JOLT_PWD` only when the filesystem is touched.
- **`java.io.StringReader` / `StringWriter` / `PushbackReader`** — the Methods: `getPath` `getName` `getParent` `getParentFile` `getAbsolutePath`
`read`/`readLine`/`mark`/`reset`/`unread`/`write`/`append`/`toString` surface `getAbsoluteFile` `getCanonicalPath` `getCanonicalFile` `toURI` `toURL`
the reader and `with-out-str` rely on. `exists` `isDirectory` `isFile` `isAbsolute` `isHidden` `length` `lastModified`
`canRead` `canWrite` `canExecute` `list` `listFiles` `mkdir` `mkdirs` `delete`
`createNewFile` `renameTo` `compareTo` `equals` `hashCode`. Statics:
`File/separator` `File/separatorChar` `File/pathSeparator` `File/createTempFile`
`File/listRoots`.
- **Byte streams** — `FileInputStream` / `FileOutputStream` (over a path/File,
`append` arg), `ByteArrayInputStream` / `ByteArrayOutputStream`
(`toByteArray`/`toString`/`size`/`reset`), `BufferedInputStream` /
`BufferedOutputStream`. `read`/`read(byte[])`, `write(int)`/`write(byte[])`,
`flush`, `close`. Each is a Chez binary port underneath.
- **Char streams** — `FileReader` / `InputStreamReader` (read a byte stream as
UTF-8), `FileWriter` / `OutputStreamWriter`, `BufferedReader` (`readLine`,
`lines`) / `BufferedWriter` (`newLine`), `StringReader` / `StringWriter` /
`PushbackReader`.
- **`clojure.java.io`** — `file` `as-file` `reader` `writer` `input-stream`
`output-stream` `copy` (byte-exact for byte sources) `make-parents`
`delete-file` `resource` `as-url`. `slurp`/`spit`/`line-seq`/`with-open` work
over all of the above.
- **`java.lang.ClassLoader`** — `getSystemClassLoader`, `.getResource`, - **`java.lang.ClassLoader`** — `getSystemClassLoader`, `.getResource`,
`.getResourceAsStream` (resolved against the source roots). `.getResourceAsStream` (resolved against the source roots).

321
host/chez/io-streams.ss Normal file
View file

@ -0,0 +1,321 @@
;; java.io byte/char streams over Chez ports. Each stream is a jhost wrapping a
;; Chez port, so buffering, EOF and binary<->char transcoding come from Chez
;; rather than a hand-rolled buffer.
;;
;; in-stream #(binary-input-port) FileInputStream / ByteArrayInputStream
;; out-stream #(binary-output-port extract acc) FileOutputStream / ByteArrayOutputStream
;; char-reader #(textual-input-port) FileReader / InputStreamReader
;; char-writer #(textual-output-port) FileWriter / OutputStreamWriter
;;
;; Buffered{Reader,Writer,Input,Output}Stream are buffering wrappers; Chez ports
;; are already buffered, so their constructors return the wrapped stream.
;;
;; Loaded after io.ss + natives-array.ss (uses make-jfile/slurp helpers + the
;; byte-array <-> bytevector bridge), and extends io.ss's reader-jhost? / slurp /
;; __close so the new readers/streams flow through slurp / line-seq / with-open.
;; --- byte input stream ------------------------------------------------------
(define (in-stream-port self) (vector-ref (jhost-state self) 0))
(define (make-in-stream port) (make-jhost "in-stream" (vector port)))
(define (in-stream? x) (and (jhost? x) (string=? (jhost-tag x) "in-stream")))
(register-host-methods! "in-stream"
(list
(cons "read"
(lambda (self . rest)
(let ((port (in-stream-port self)))
(if (null? rest)
(let ((b (get-u8 port))) (if (eof-object? b) -1 (->num b)))
(let* ((buf (car rest))
(vec (jolt-array-vec buf))
(off (if (>= (length rest) 3) (jnum->exact (cadr rest)) 0))
(len (if (>= (length rest) 3) (jnum->exact (caddr rest)) (vector-length vec))))
(let loop ((i 0))
(if (>= i len) (->num i)
(let ((b (get-u8 port)))
(if (eof-object? b)
(if (= i 0) -1 (->num i))
(begin (vector-set! vec (+ off i) b) (loop (+ i 1))))))))))))
(cons "readAllBytes" (lambda (self) (let ((bv (get-bytevector-all (in-stream-port self))))
(na-byte-array (if (eof-object? bv) (make-bytevector 0) bv)))))
(cons "skip" (lambda (self n) (let ((bv (get-bytevector-n (in-stream-port self) (jnum->exact n))))
(->num (if (eof-object? bv) 0 (bytevector-length bv))))))
(cons "available" (lambda (self) (->num 0)))
(cons "close" (lambda (self) (close-port (in-stream-port self)) jolt-nil))
(cons "mark" (lambda (self . _) jolt-nil))
(cons "reset" (lambda (self) (guard (e (#t jolt-nil)) (set-port-position! (in-stream-port self) 0) jolt-nil)))
(cons "markSupported" (lambda (self) #f))
(cons "toString" (lambda (self) "#<InputStream>"))))
;; --- byte output stream -----------------------------------------------------
;; state #(port extract acc): extract/acc are #f for a file/passthrough stream;
;; a ByteArrayOutputStream carries the R6RS extraction proc + an accumulator
;; bytevector (Chez's extract resets the port, so snapshot on demand, not per write).
(define (out-stream-port self) (vector-ref (jhost-state self) 0))
(define (out-stream? x) (and (jhost? x) (string=? (jhost-tag x) "out-stream")))
(define (make-out-stream port) (make-jhost "out-stream" (vector port #f #f)))
(define (bv-concat a b)
(if (= 0 (bytevector-length b)) a
(let ((m (make-bytevector (+ (bytevector-length a) (bytevector-length b)))))
(bytevector-copy! a 0 m 0 (bytevector-length a))
(bytevector-copy! b 0 m (bytevector-length a) (bytevector-length b))
m)))
;; all bytes written to a ByteArrayOutputStream so far (folds the latest extract
;; into the accumulator).
(define (baos-bytes self)
(let* ((st (jhost-state self)) (port (vector-ref st 0)) (extract (vector-ref st 1)) (acc (vector-ref st 2)))
(flush-output-port port)
(let ((merged (bv-concat acc (extract))))
(vector-set! st 2 merged) merged)))
(register-host-methods! "out-stream"
(list
(cons "write"
(lambda (self x . rest)
(let ((port (out-stream-port self)))
(cond
((number? x) (put-u8 port (bitwise-and (jnum->exact x) #xff)))
((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte))
(let ((bv (na-bytearray->bv x)))
(if (pair? rest)
(put-bytevector port bv (jnum->exact (car rest)) (jnum->exact (cadr rest)))
(put-bytevector port bv))))
((bytevector? x) (put-bytevector port x))
(else (error #f "OutputStream/write: unsupported" x)))
jolt-nil)))
(cons "flush" (lambda (self) (flush-output-port (out-stream-port self)) jolt-nil))
(cons "close" (lambda (self) (flush-output-port (out-stream-port self))
;; a ByteArrayOutputStream's close is a no-op (toByteArray stays valid);
;; a file stream's port is closed.
(unless (vector-ref (jhost-state self) 1) (close-port (out-stream-port self))) jolt-nil))
(cons "toByteArray" (lambda (self) (na-byte-array (bytevector-copy (baos-bytes self)))))
(cons "size" (lambda (self) (->num (bytevector-length (baos-bytes self)))))
(cons "reset" (lambda (self) (baos-bytes self) (vector-set! (jhost-state self) 2 (make-bytevector 0)) jolt-nil))
(cons "toString" (lambda (self . cs) (decode-bytevector (baos-bytes self)
(if (pair? cs) (list (jolt-str-render-one (car cs))) '()))))))
;; --- char input (Reader) ----------------------------------------------------
(define (char-reader-port self) (vector-ref (jhost-state self) 0))
(define (char-reader? x) (and (jhost? x) (string=? (jhost-tag x) "char-reader")))
(define (make-char-reader port) (make-jhost "char-reader" (vector port)))
(register-host-methods! "char-reader"
(list
(cons "read"
(lambda (self . rest)
(let ((port (char-reader-port self)))
(if (null? rest)
(let ((c (get-char port))) (if (eof-object? c) -1 (->num (char->integer c))))
(let* ((buf (car rest))
(vec (jolt-array-vec buf))
(off (if (>= (length rest) 3) (jnum->exact (cadr rest)) 0))
(len (if (>= (length rest) 3) (jnum->exact (caddr rest)) (vector-length vec))))
(let loop ((i 0))
(if (>= i len) (->num i)
(let ((c (get-char port)))
(if (eof-object? c)
(if (= i 0) -1 (->num i))
(begin (vector-set! vec (+ off i) c) (loop (+ i 1))))))))))))
(cons "readLine" (lambda (self) (let ((l (get-line (char-reader-port self)))) (if (eof-object? l) jolt-nil l))))
(cons "lines" (lambda (self)
(let loop ((acc '()))
(let ((l (get-line (char-reader-port self))))
(if (eof-object? l) (list->cseq (reverse acc)) (loop (cons l acc)))))))
(cons "ready" (lambda (self) #t))
(cons "skip" (lambda (self n) (let loop ((i 0) (k (jnum->exact n)))
(if (or (>= i k) (eof-object? (get-char (char-reader-port self)))) (->num i)
(loop (+ i 1) k)))))
(cons "close" (lambda (self) (close-port (char-reader-port self)) jolt-nil))
(cons "mark" (lambda (self . _) jolt-nil))
(cons "reset" (lambda (self) (guard (e (#t jolt-nil)) (set-port-position! (char-reader-port self) 0) jolt-nil)))
(cons "toString" (lambda (self) "#<Reader>"))))
;; --- char output (Writer) ---------------------------------------------------
(define (char-writer-port self) (vector-ref (jhost-state self) 0))
(define (char-writer? x) (and (jhost? x) (string=? (jhost-tag x) "char-writer")))
(define (make-char-writer port) (make-jhost "char-writer" (vector port)))
(define (cw-text x) (if (number? x) (string (integer->char (jnum->exact x))) (jolt-str-render-one x)))
(register-host-methods! "char-writer"
(list
(cons "write" (lambda (self x . rest)
;; (write str) | (write int) | (write str off len)
(let ((s (cw-text x)))
(put-string (char-writer-port self)
(if (>= (length rest) 2) (substring s (jnum->exact (car rest))
(+ (jnum->exact (car rest)) (jnum->exact (cadr rest)))) s)))
jolt-nil))
(cons "append" (lambda (self x . rest) (put-string (char-writer-port self) (cw-text x)) self))
(cons "newLine" (lambda (self) (put-char (char-writer-port self) #\newline) jolt-nil))
(cons "flush" (lambda (self) (flush-output-port (char-writer-port self)) jolt-nil))
(cons "close" (lambda (self) (close-port (char-writer-port self)) jolt-nil))
(cons "toString" (lambda (self) "#<Writer>"))))
;; --- constructors -----------------------------------------------------------
(define utf8-tx (make-transcoder (utf-8-codec)))
(define (path-of x) (project-relative (file-path-of x)))
(define (src-bytevector x) ; a byte[] or Chez bytevector -> bytevector
(cond ((bytevector? x) x)
((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (na-bytearray->bv x))
(else (error #f "expected a byte array" x))))
(define (reg-ctor! names ctor) (for-each (lambda (n) (register-class-ctor! n ctor)) names))
(reg-ctor! '("FileInputStream" "java.io.FileInputStream")
(lambda (src . _) (make-in-stream (open-file-input-port (path-of src) (file-options) (buffer-mode block)))))
(reg-ctor! '("FileOutputStream" "java.io.FileOutputStream")
(lambda (src . rest)
(let ((append? (and (pair? rest) (jolt-truthy? (car rest)))))
(make-out-stream (open-file-output-port (path-of src)
(if append? (file-options no-fail no-truncate append) (file-options no-fail))
(buffer-mode block))))))
(reg-ctor! '("ByteArrayInputStream" "java.io.ByteArrayInputStream")
(lambda (bytes . rest)
(let ((bv (src-bytevector bytes)))
(make-in-stream (open-bytevector-input-port
(if (>= (length rest) 2)
(let ((off (jnum->exact (car rest))) (len (jnum->exact (cadr rest))))
(let ((sub (make-bytevector len))) (bytevector-copy! bv off sub 0 len) sub))
bv))))))
(reg-ctor! '("ByteArrayOutputStream" "java.io.ByteArrayOutputStream")
(lambda _
(call-with-values open-bytevector-output-port
(lambda (port extract) (make-jhost "out-stream" (vector port extract (make-bytevector 0)))))))
(reg-ctor! '("FileReader" "java.io.FileReader")
(lambda (src . _) (make-char-reader (transcoded-port (open-file-input-port (path-of src) (file-options) (buffer-mode block)) utf8-tx))))
(reg-ctor! '("FileWriter" "java.io.FileWriter")
(lambda (src . rest)
(let ((append? (and (pair? rest) (jolt-truthy? (car rest)))))
(make-char-writer (transcoded-port (open-file-output-port (path-of src)
(if append? (file-options no-fail no-truncate append) (file-options no-fail))
(buffer-mode block)) utf8-tx)))))
;; InputStreamReader / OutputStreamWriter take ownership of the wrapped byte
;; stream's port and transcode it (UTF-8 default; an explicit charset is honored
;; only as UTF-8 here).
(reg-ctor! '("InputStreamReader" "java.io.InputStreamReader")
(lambda (in . _) (make-char-reader (transcoded-port (in-stream-port in) utf8-tx))))
(reg-ctor! '("OutputStreamWriter" "java.io.OutputStreamWriter")
(lambda (out . _) (make-char-writer (transcoded-port (out-stream-port out) utf8-tx))))
;; Buffered* — Chez ports are buffered already; the wrapper is the wrapped stream.
(for-each (lambda (n) (register-class-ctor! n (lambda (inner . _) inner)))
'("BufferedReader" "java.io.BufferedReader"
"BufferedWriter" "java.io.BufferedWriter"
"BufferedInputStream" "java.io.BufferedInputStream"
"BufferedOutputStream" "java.io.BufferedOutputStream"))
;; --- integration: slurp / line-seq / with-open ------------------------------
;; a char-reader joins the reader-jhost set (drain-reader / line-seq read it via
;; its .read method).
(let ((prev reader-jhost?))
(set! reader-jhost? (lambda (x) (or (char-reader? x) (prev x)))))
;; slurp a char-reader (drain chars) or a byte in-stream (drain bytes -> decode).
(let ((prev jolt-slurp))
(set! jolt-slurp
(lambda (src . opts)
(cond
((char-reader? src) (drain-reader src))
((in-stream? src) (decode-bytevector (let ((bv (get-bytevector-all (in-stream-port src))))
(if (eof-object? bv) (make-bytevector 0) bv))
(slurp-encoding opts)))
(else (apply prev src opts)))))
(def-var! "clojure.core" "slurp" jolt-slurp))
;; with-open closes the new stream jhosts via their .close method.
(let ((prev jolt-close))
(set! jolt-close
(lambda (x)
(if (and (jhost? x) (member (jhost-tag x) '("in-stream" "out-stream" "char-reader" "char-writer")))
(begin (record-method-dispatch x "close" jolt-nil) jolt-nil)
(prev x))))
(def-var! "clojure.core" "__close" jolt-close))
;; --- clojure.java.io: byte streams + copy / make-parents / delete-file -------
;; input-stream/output-stream now yield real byte streams (were char reader/writer).
(define (jio-input-stream x)
(cond ((in-stream? x) x)
((jfile? x) (make-in-stream (open-file-input-port (jfile-fs x) (file-options) (buffer-mode block))))
((and (jolt-array? x) (eq? (jolt-array-kind x) 'byte)) (make-in-stream (open-bytevector-input-port (na-bytearray->bv x))))
((bytevector? x) (make-in-stream (open-bytevector-input-port x)))
((and (jhost? x) (string=? (jhost-tag x) "url")) (make-in-stream (open-file-input-port (url-strip-scheme (url-spec x)) (file-options) (buffer-mode block))))
((string? x) (make-in-stream (open-file-input-port (project-relative x) (file-options) (buffer-mode block))))
(else (error #f "io/input-stream: don't know how to open" x))))
(define (jio-output-stream x . rest)
(cond ((out-stream? x) x)
((or (jfile? x) (string? x))
(let ((append? (let loop ((o rest)) (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)))))))
(make-out-stream (open-file-output-port (path-of x)
(if append? (file-options no-fail no-truncate append) (file-options no-fail))
(buffer-mode block)))))
(else (error #f "io/output-stream: don't know how to open" x))))
(def-var! "clojure.java.io" "input-stream" jio-input-stream)
(def-var! "clojure.java.io" "output-stream" jio-output-stream)
;; io/make-parents: create the parent directories of the last path segment.
(define (jio-make-parents . args)
(let ((p (apply-make-file-path args)))
(let loop ((i (- (string-length p) 1)))
(cond ((<= i 0) #f)
((char=? (string-ref p i) #\/) (mkdirs! (substring p 0 i)))
(else (loop (- i 1)))))))
(define (apply-make-file-path args)
(jfile-path (apply jolt-make-file args)))
(def-var! "clojure.java.io" "make-parents" jio-make-parents)
;; io/delete-file: delete the file; raise unless :silently truthy.
(define (jio-delete-file f . opts)
(let ((p (file-path-of f)))
(if (delete-path! p) jolt-nil
(if (and (pair? opts) (jolt-truthy? (car opts))) jolt-nil
(error #f (string-append "Couldn't delete " p))))))
(def-var! "clojure.java.io" "delete-file" jio-delete-file)
;; io/copy: file/path/reader/stream/string/byte[] -> writer/stream/file/path.
;; A byte source copies byte-exact to a byte/file destination (no lossy text
;; round-trip); otherwise the content is read as text. UTF-8 bridges byte<->char.
(define (input-bytes input) ; bytevector for a byte source, else #f
(cond ((in-stream? input) (let ((bv (get-bytevector-all (in-stream-port input)))) (if (eof-object? bv) (make-bytevector 0) bv)))
((bytevector? input) input)
((and (jolt-array? input) (eq? (jolt-array-kind input) 'byte)) (na-bytearray->bv input))
(else #f)))
(define (input-text input)
(cond ((string? input) input)
((or (char-reader? input) (reader-jhost? input)) (drain-reader input))
((jfile? input) (jolt-slurp input))
((input-bytes input) => (lambda (bv) (decode-bytevector bv '())))
(else (jolt-str-render-one input))))
(define (jio-copy input output . opts)
(cond
((out-stream? output)
(put-bytevector (out-stream-port output)
(or (input-bytes input) (string->utf8 (input-text input)))))
((char-writer? output) (put-string (char-writer-port output) (input-text input)))
((and (jhost? output) (member (jhost-tag output) '("writer" "file-writer" "port-writer" "print-writer")))
(record-method-dispatch output "write" (list->cseq (list (input-text input)))))
((or (jfile? output) (string? output))
(let ((bv (and (not (string? input)) (not (jfile? input)) (input-bytes input))))
(if bv
(let ((port (open-file-output-port (path-of output) (file-options no-fail) (buffer-mode block))))
(put-bytevector port bv) (close-port port))
(jolt-spit output (input-text input)))))
(else (error #f "io/copy: don't know how to write to" output)))
jolt-nil)
(def-var! "clojure.java.io" "copy" jio-copy)
;; --- instance? for the java.io stream taxonomy ------------------------------
(register-class-arm! in-stream? (lambda (x) "java.io.InputStream"))
(register-class-arm! out-stream? (lambda (x) "java.io.OutputStream"))
(register-class-arm! char-reader? (lambda (x) "java.io.Reader"))
(register-class-arm! char-writer? (lambda (x) "java.io.Writer"))
(register-instance-check-arm!
(lambda (type-sym val)
(if (not (symbol-t? type-sym)) 'pass
(let ((short (last-dot (symbol-t-name type-sym))))
(cond
((and (in-stream? val) (member short '("InputStream" "FileInputStream" "ByteArrayInputStream"
"BufferedInputStream" "FilterInputStream" "Closeable" "AutoCloseable"))) #t)
((and (out-stream? val) (member short '("OutputStream" "FileOutputStream" "ByteArrayOutputStream"
"BufferedOutputStream" "FilterOutputStream" "Closeable" "AutoCloseable" "Flushable"))) #t)
((and (char-reader? val) (member short '("Reader" "BufferedReader" "FileReader" "InputStreamReader"
"Closeable" "AutoCloseable" "Readable"))) #t)
((and (char-writer? val) (member short '("Writer" "BufferedWriter" "FileWriter" "OutputStreamWriter"
"Closeable" "AutoCloseable" "Flushable" "Appendable"))) #t)
(else 'pass))))))

134
host/chez/io.ss
View file

@ -39,11 +39,16 @@
(let ((pwd (getenv "JOLT_PWD"))) (let ((pwd (getenv "JOLT_PWD")))
(if (and pwd (> (string-length pwd) 0)) (string-append pwd "/" p) p)))) (if (and pwd (> (string-length pwd) 0)) (string-append pwd "/" p) p))))
;; (io/file path) / (io/file parent child) — join children with "/". ;; (io/file path) / (io/file parent child) — join children with "/". The File
;; keeps the path AS GIVEN (like the JVM: new File("rel").getPath() is "rel");
;; a relative path resolves against JOLT_PWD only when the filesystem is touched
;; (jfile-fs / slurp / spit / the stream constructors).
(define (jolt-make-file path . rest) (define (jolt-make-file path . rest)
(let loop ((p (project-relative (file-path-of path))) (cs rest)) (let loop ((p (file-path-of path)) (cs rest))
(if (null? cs) (make-jfile p) (if (null? cs) (make-jfile p)
(loop (string-append p "/" (file-path-of (car cs))) (cdr cs))))) (loop (string-append p "/" (file-path-of (car cs))) (cdr cs)))))
;; the on-disk path of a value: a relative path resolves against JOLT_PWD.
(define (jfile-fs f) (project-relative (file-path-of f)))
(define (path-last-segment p) (define (path-last-segment p)
(let loop ((i (- (string-length p) 1))) (let loop ((i (- (string-length p) 1)))
@ -53,16 +58,44 @@
;; directory children as full paths, sorted (the __list-dir seed primitive). ;; directory children as full paths, sorted (the __list-dir seed primitive).
(define (jolt-list-dir path) (define (jolt-list-dir path)
(let ((p (file-path-of path))) (let ((p (project-relative (file-path-of path))))
(map (lambda (e) (string-append p "/" e)) (map (lambda (e) (string-append p "/" e))
(sort string<? (directory-list p))))) (sort string<? (directory-list p)))))
(define (jolt-dir? path) (if (file-directory? (file-path-of path)) #t #f)) (define (jolt-dir? path) (if (file-directory? (project-relative (file-path-of path))) #t #f))
;; absolute path string (cwd-relative paths resolved against current-directory). ;; absolute path string (cwd-relative paths resolved against current-directory).
(define (jfile-abs p) (define (jfile-abs p)
(if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/)) p (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/)) p
(string-append (current-directory) "/" p))) (string-append (current-directory) "/" p)))
;; --- file metadata over Chez filesystem ops ---------------------------------
;; byte size of a regular file (0 for a directory or a missing file).
(define (file-byte-size p)
(if (or (not (file-exists? p)) (file-directory? p)) 0
(let ((port (open-file-input-port p))) (let ((n (file-length port))) (close-port port) n))))
;; last-modified as epoch milliseconds (0 if the file is absent).
(define (file-mtime-millis p)
(if (file-exists? p)
(let ((t (file-modification-time p)))
(+ (* (time-second t) 1000) (div (time-nanosecond t) 1000000)))
0))
;; mkdir -p: create p and any missing parents. Returns #t if p ends up a dir.
(define (mkdirs! p)
(unless (or (= 0 (string-length p)) (file-exists? p))
(let loop ((i (- (string-length p) 1)))
(cond ((<= i 0) #f)
((char=? (string-ref p i) #\/)
(let ((parent (substring p 0 i))) (unless (file-exists? parent) (mkdirs! parent))))
(else (loop (- i 1)))))
(guard (e (#t #f)) (mkdir p)))
(and (file-exists? p) (file-directory? p)))
;; delete a file or an (empty) directory; #t on success.
(define (delete-path! p)
(guard (e (#t #f))
(cond ((not (file-exists? p)) #f)
((file-directory? p) (delete-directory p) #t)
(else (delete-file p) #t))))
;; --- java.net.URL (a jhost "url", state #(spec)) ---------------------------- ;; --- java.net.URL (a jhost "url", state #(spec)) ----------------------------
;; A File.toURL value: .toString / .toExternalForm give the spec, .getPath / ;; A File.toURL value: .toString / .toExternalForm give the spec, .getPath /
;; .getFile strip the "file:" scheme. ;; .getFile strip the "file:" scheme.
@ -88,20 +121,54 @@
;; --- File method surface (record-method-dispatch arm) ----------------------- ;; --- File method surface (record-method-dispatch arm) -----------------------
(define (jfile-method f name args) ; -> boxed result, or #f to fall through (define (jfile-method f name args) ; -> boxed result, or #f to fall through
(let ((p (jfile-path f))) (let ((p (jfile-path f)) ; the path as given (display methods)
(fp (jfile-fs f))) ; JOLT_PWD-resolved on-disk path (FS methods)
(cond (cond
((string=? name "getPath") (list p)) ((string=? name "getPath") (list p))
((string=? name "getName") (list (path-last-segment p))) ((string=? name "getName") (list (path-last-segment p)))
((string=? name "toString") (list p)) ((string=? name "toString") (list p))
((string=? name "getAbsolutePath")(list (jfile-abs p))) ((string=? name "getAbsolutePath")(list (jfile-abs fp)))
((string=? name "getCanonicalPath")(list (jfile-abs p))) ((string=? name "getCanonicalPath")(list (jfile-abs fp)))
((string=? name "toURI") (list (string-append "file:" (jfile-abs p)))) ((string=? name "toURI") (list (string-append "file:" (jfile-abs fp))))
((string=? name "toURL") (list (make-url (string-append "file:" (jfile-abs p))))) ((string=? name "toURL") (list (make-url (string-append "file:" (jfile-abs fp)))))
((string=? name "exists") (list (if (file-exists? p) #t #f))) ((string=? name "exists") (list (if (file-exists? fp) #t #f)))
((string=? name "isDirectory") (list (if (file-directory? p) #t #f))) ((string=? name "isDirectory") (list (if (file-directory? fp) #t #f)))
((string=? name "isFile") (list (if (and (file-exists? p) (not (file-directory? p))) #t #f))) ((string=? name "isFile") (list (if (and (file-exists? fp) (not (file-directory? fp))) #t #f)))
((string=? name "isAbsolute") (list (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/)) #t #f))) ((string=? name "isAbsolute") (list (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/)) #t #f)))
((string=? name "listFiles") (list (list->cseq (map make-jfile (jolt-list-dir p))))) ((string=? name "listFiles") (list (list->cseq (map make-jfile (jolt-list-dir fp)))))
;; .list -> the child NAMES (a String[]), nil if not a directory.
((string=? name "list")
(list (if (file-directory? fp)
(apply jolt-vector (sort string<? (directory-list fp)))
jolt-nil)))
((string=? name "length") (list (->num (file-byte-size fp))))
((string=? name "lastModified") (list (->num (file-mtime-millis fp))))
((string=? name "canRead") (list (if (file-exists? fp) #t #f)))
((string=? name "canWrite") (list (if (file-exists? fp) #t #f)))
((string=? name "canExecute") (list (if (file-exists? fp) #t #f)))
((string=? name "isHidden") (list (let ((nm (path-last-segment p)))
(if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\.)) #t #f))))
((string=? name "mkdir") (list (guard (e (#t #f)) (and (not (file-exists? fp)) (begin (mkdir fp) #t)))))
((string=? name "mkdirs") (list (if (mkdirs! fp) #t #f)))
((string=? name "delete") (list (if (delete-path! fp) #t #f)))
((string=? name "deleteOnExit") (list jolt-nil))
((string=? name "setLastModified")(list #t))
((string=? name "createNewFile")
(list (if (file-exists? fp) #f
(guard (e (#t #f)) (close-port (open-output-file fp 'truncate)) #t))))
((string=? name "renameTo")
(list (let ((dst (jfile-fs (car args)))) (guard (e (#t #f)) (rename-file fp dst) #t))))
((string=? name "getParentFile")
(let loop ((i (- (string-length p) 1)))
(cond ((< i 0) (list jolt-nil))
((char=? (string-ref p i) #\/) (list (make-jfile (if (= i 0) "/" (substring p 0 i)))))
(else (loop (- i 1))))))
((string=? name "getAbsoluteFile") (list (make-jfile (jfile-abs p))))
((string=? name "getCanonicalFile") (list (make-jfile (jfile-abs p))))
((string=? name "compareTo") (list (->num (let ((o (file-path-of (car args))))
(cond ((string<? p o) -1) ((string>? p o) 1) (else 0))))))
((string=? name "equals") (list (and (jfile? (car args)) (string=? p (jfile-path (car args))))))
((string=? name "hashCode") (list (->num (string-hash p))))
((string=? name "getParent") ((string=? name "getParent")
(let loop ((i (- (string-length p) 1))) (let loop ((i (- (string-length p) 1)))
(cond ((< i 0) (list jolt-nil)) (cond ((< i 0) (list jolt-nil))
@ -126,7 +193,7 @@
(lambda (method target . args) (lambda (method target . args)
(cond (cond
((and (jfile? target) (string=? method "isDirectory")) ((and (jfile? target) (string=? method "isDirectory"))
(if (file-directory? (jfile-path target)) #t #f)) (if (file-directory? (jfile-fs target)) #t #f))
((and (jfile? target) (string=? method "listFiles")) ((and (jfile? target) (string=? method "listFiles"))
(list->cseq (map make-jfile (jolt-list-dir target)))) (list->cseq (map make-jfile (jolt-list-dir target))))
(else (apply %io-host-call method target args))))) (else (apply %io-host-call method target args)))))
@ -201,7 +268,7 @@
(loop (cons (bitwise-and (jnum->exact b) #xff) acc)))))) (loop (cons (bitwise-and (jnum->exact b) #xff) acc))))))
(define (jolt-slurp src . opts) (define (jolt-slurp src . opts)
(cond (cond
((jfile? src) (read-file-string (jfile-path src))) ((jfile? src) (read-file-string (jfile-fs src)))
((embedded-res? src) (embedded-res-content src)) ((embedded-res? src) (embedded-res-content src))
((reader-jhost? src) (drain-reader src)) ((reader-jhost? src) (drain-reader src))
;; bytes (a bytevector or a jolt byte-array): decode with :encoding (UTF-8 ;; bytes (a bytevector or a jolt byte-array): decode with :encoding (UTF-8
@ -223,7 +290,7 @@
(else (loop (cddr o)))))) (else (loop (cddr o))))))
(define (jolt-spit path content . opts) (define (jolt-spit path content . opts)
(let* ((p (file-path-of path)) (let* ((p (project-relative (file-path-of path)))
(port (open-output-file p (if (spit-append? opts) 'append 'truncate)))) (port (open-output-file p (if (spit-append? opts) 'append 'truncate))))
(put-string port (jolt-str-render-one content)) (put-string port (jolt-str-render-one content))
(close-port port) (close-port port)
@ -275,7 +342,8 @@
(define (jolt-close x) (define (jolt-close x)
(cond (cond
((jolt-nil? x) jolt-nil) ((jolt-nil? x) jolt-nil)
((and (jhost? x) (member (jhost-tag x) '("string-reader" "pushback-reader" "writer"))) ((and (jhost? x) (member (jhost-tag x) '("string-reader" "pushback-reader" "writer"
"file-writer" "port-writer" "print-writer")))
(record-method-dispatch x "close" jolt-nil) jolt-nil) (record-method-dispatch x "close" jolt-nil) jolt-nil)
;; a library's stream shim (tagged-table) closes via its registered .close ;; a library's stream shim (tagged-table) closes via its registered .close
;; method (a no-op for in-memory streams); absent method -> no-op. ;; method (a no-op for in-memory streams); absent method -> no-op.
@ -294,10 +362,14 @@
;; a StringReader (host-static.ss jhost) so .read/.mark/.reset and slurp work. ;; a StringReader (host-static.ss jhost) so .read/.mark/.reset and slurp work.
(define (seq-source->string x) (define (seq-source->string x)
(apply string-append (map jolt-str-render-one (seq->list x)))) (apply string-append (map jolt-str-render-one (seq->list x))))
;; io/reader returns an in-memory StringReader (the full Reader contract incl.
;; (read), mark/reset and pushback). The streaming java.io.FileReader /
;; BufferedReader classes (io-streams.ss) read a Chez port directly when a caller
;; wants to avoid loading the whole source.
(define (jolt-io-reader x) (define (jolt-io-reader x)
(cond (cond
((reader-jhost? x) x) ((reader-jhost? x) x)
((jfile? x) (host-new "StringReader" (read-file-string (jfile-path x)))) ((jfile? x) (host-new "StringReader" (read-file-string (jfile-fs x))))
((embedded-res? x) (host-new "StringReader" (embedded-res-content x))) ((embedded-res? x) (host-new "StringReader" (embedded-res-content x)))
((and (jhost? x) (string=? (jhost-tag x) "url")) ((and (jhost? x) (string=? (jhost-tag x) "url"))
(host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x))))) (host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x)))))
@ -393,6 +465,32 @@
(if (pair? rest) (if (pair? rest)
(jolt-make-file (string-append (file-path-of a) "/" (file-path-of (car rest)))) (jolt-make-file (string-append (file-path-of a) "/" (file-path-of (car rest))))
(jolt-make-file a)))) (jolt-make-file a))))
;; File statics: the platform separators plus createTempFile / listRoots.
(define temp-file-counter 0)
(define (file-create-temp prefix suffix . dir)
(let* ((d (cond ((pair? dir) (file-path-of (car dir)))
((getenv "TMPDIR") => (lambda (t) t))
(else "/tmp")))
(sfx (if (or (null? (list suffix)) (jolt-nil? suffix)) ".tmp" (jolt-str-render-one suffix))))
(set! temp-file-counter (+ temp-file-counter 1))
(let loop ((n temp-file-counter))
(let ((p (string-append d "/" (jolt-str-render-one prefix)
(number->string (now-millis)) "-" (number->string n) sfx)))
(if (file-exists? p) (loop (+ n 1))
(begin (close-port (open-output-file p 'truncate)) (make-jfile p)))))))
(let ((statics (list (cons "separator" "/")
(cons "separatorChar" #\/)
(cons "pathSeparator" ":")
(cons "pathSeparatorChar" #\:)
(cons "createTempFile" file-create-temp)
(cons "listRoots" (lambda () (jolt-vector (make-jfile "/")))))))
(register-class-statics! "File" statics)
(register-class-statics! "java.io.File" statics))
(register-class-ctor! "java.io.File"
(lambda (a . rest)
(if (pair? rest)
(jolt-make-file (string-append (file-path-of a) "/" (file-path-of (car rest))))
(jolt-make-file a))))
;; UUID: randomUUID / fromString statics + a (UUID. s) string ctor. ;; UUID: randomUUID / fromString statics + a (UUID. s) string ctor.
(register-class-statics! "UUID" (register-class-statics! "UUID"
(list (cons "randomUUID" (lambda () (jolt-random-uuid))) (list (cons "randomUUID" (lambda () (jolt-random-uuid)))

5
host/chez/rt.ss
View file

@ -376,6 +376,11 @@
;; it. After the dispatchers it chains. ;; it. After the dispatchers it chains.
(load "host/chez/natives-array.ss") (load "host/chez/natives-array.ss")
;; java.io byte/char streams (FileInputStream/…/ByteArrayOutputStream/Buffered*)
;; over Chez ports. After io.ss (extends its slurp/__close/reader-jhost?) and
;; natives-array.ss (the byte-array <-> bytevector bridge).
(load "host/chez/io-streams.ss")
;; clojure.lang.PersistentQueue: a functional queue + EMPTY static. ;; clojure.lang.PersistentQueue: a functional queue + EMPTY static.
;; Chains seq/count/empty?/peek/pop/conj/sequential?/class/instance?/printer, so ;; Chains seq/count/empty?/peek/pop/conj/sequential?/class/instance?/printer, so
;; load after natives-array (the dispatchers it extends). ;; load after natives-array (the dispatchers it extends).

15
test/chez/corpus.edn
View file

@ -3048,4 +3048,19 @@
{:suite "interop / java.time" :label "Instant getNano of negative nano" :expected "999999999" :actual "(.getNano (.plusNanos (java.time.Instant/ofEpochSecond 0) -1))"} {:suite "interop / java.time" :label "Instant getNano of negative nano" :expected "999999999" :actual "(.getNano (.plusNanos (java.time.Instant/ofEpochSecond 0) -1))"}
{:suite "interop / java.time" :label "Instant toEpochMilli floors sub-milli" :expected "1000" :actual "(.toEpochMilli (.plusNanos (java.time.Instant/ofEpochSecond 1) 999999))"} {:suite "interop / java.time" :label "Instant toEpochMilli floors sub-milli" :expected "1000" :actual "(.toEpochMilli (.plusNanos (java.time.Instant/ofEpochSecond 1) 999999))"}
{:suite "interop / java.time" :label "Instant truncatedTo SECONDS drops nanos" :expected "\"1970-01-01T00:00:05Z\"" :actual "(str (.truncatedTo (.plusNanos (java.time.Instant/ofEpochSecond 5) 123) java.time.temporal.ChronoUnit/SECONDS))"} {:suite "interop / java.time" :label "Instant truncatedTo SECONDS drops nanos" :expected "\"1970-01-01T00:00:05Z\"" :actual "(str (.truncatedTo (.plusNanos (java.time.Instant/ofEpochSecond 5) 123) java.time.temporal.ChronoUnit/SECONDS))"}
{:suite "interop / java.io File" :label "getName" :expected "\"c.txt\"" :actual "(.getName (java.io.File. \"/a/b/c.txt\"))"}
{:suite "interop / java.io File" :label "getParent" :expected "\"/a/b\"" :actual "(.getParent (java.io.File. \"/a/b/c.txt\"))"}
{:suite "interop / java.io File" :label "getPath keeps relative path" :expected "\"rel/x\"" :actual "(.getPath (java.io.File. \"rel/x\"))"}
{:suite "interop / java.io File" :label "relative File is not absolute" :expected "false" :actual "(.isAbsolute (java.io.File. \"rel\"))"}
{:suite "interop / java.io File" :label "parent+child constructor joins" :expected "\"/a/b\"" :actual "(.getPath (java.io.File. \"/a\" \"b\"))"}
{:suite "interop / java.io File" :label "File/separator" :expected "\"/\"" :actual "java.io.File/separator"}
{:suite "interop / java.io File" :label "str of File is its path" :expected "\"a/b\"" :actual "(str (java.io.File. \"a/b\"))"}
{:suite "interop / java.io File" :label "mkdir then delete a temp dir" :expected "[true true true]" :actual "(let [d (java.io.File/createTempFile \"jd\" \"\")] (.delete d) [(.mkdir d) (.isDirectory d) (.delete d)])"}
{:suite "interop / java.io streams" :label "ByteArrayOutputStream toString" :expected "\"hi!\"" :actual "(let [b (java.io.ByteArrayOutputStream.)] (.write b (.getBytes \"hi\")) (.write b 33) (.toString b))"}
{:suite "interop / java.io streams" :label "ByteArrayOutputStream size" :expected "4" :actual "(let [b (java.io.ByteArrayOutputStream.)] (.write b (.getBytes \"abcd\")) (.size b))"}
{:suite "interop / java.io streams" :label "ByteArrayOutputStream toByteArray round-trips" :expected "\"yo\"" :actual "(String. (.toByteArray (doto (java.io.ByteArrayOutputStream.) (.write (.getBytes \"yo\")))))"}
{:suite "interop / java.io streams" :label "ByteArrayInputStream read to EOF" :expected "[65 66 -1]" :actual "(let [in (java.io.ByteArrayInputStream. (.getBytes \"AB\"))] [(.read in) (.read in) (.read in)])"}
{:suite "interop / java.io streams" :label "BufferedReader over StringReader readLine" :expected "[\"a\" \"b\" nil]" :actual "(let [r (java.io.BufferedReader. (java.io.StringReader. \"a\\nb\\n\"))] [(.readLine r) (.readLine r) (.readLine r)])"}
{:suite "interop / java.io streams" :label "instance? InputStream" :expected "true" :actual "(instance? java.io.InputStream (java.io.ByteArrayInputStream. (.getBytes \"x\")))"}
{:suite "interop / java.io streams" :label "FileOutputStream then FileInputStream round-trip" :expected "90" :actual "(let [f (java.io.File/createTempFile \"jc\" \".t\") o (java.io.FileOutputStream. f)] (.write o (byte-array [90])) (.close o) (let [in (java.io.FileInputStream. f) b (.read in)] (.close in) (.delete f) b))"}
] ]