diff --git a/docs/host-interop.md b/docs/host-interop.md index 46ef4b3..b405a98 100644 --- a/docs/host-interop.md +++ b/docs/host-interop.md @@ -70,12 +70,29 @@ aren't implemented; a few are accepted but no-ops (noted inline). ### I/O -- **`java.io.File`** — `(File. path)` / `(File. parent child)`; `getPath` - `getName` `getAbsolutePath` `getCanonicalPath` `toURI` `toURL` `exists` - `isDirectory` `isFile` `listFiles` `getParent`. -- **`java.io.StringReader` / `StringWriter` / `PushbackReader`** — the - `read`/`readLine`/`mark`/`reset`/`unread`/`write`/`append`/`toString` surface - the reader and `with-out-str` rely on. +- **`java.io.File`** — `(File. path)` / `(File. parent child)`. A File keeps the + path as given (`(.getPath (File. "rel"))` is `"rel"`, `.isAbsolute` false); a + relative path resolves against `JOLT_PWD` only when the filesystem is touched. + Methods: `getPath` `getName` `getParent` `getParentFile` `getAbsolutePath` + `getAbsoluteFile` `getCanonicalPath` `getCanonicalFile` `toURI` `toURL` + `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`, `.getResourceAsStream` (resolved against the source roots). diff --git a/host/chez/io-streams.ss b/host/chez/io-streams.ss new file mode 100644 index 0000000..00a843b --- /dev/null +++ b/host/chez/io-streams.ss @@ -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) "#")))) + +;; --- 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) "#")))) + +;; --- 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) "#")))) + +;; --- 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)))))) diff --git a/host/chez/io.ss b/host/chez/io.ss index 8d0e38b..f08caa6 100644 --- a/host/chez/io.ss +++ b/host/chez/io.ss @@ -39,11 +39,16 @@ (let ((pwd (getenv "JOLT_PWD"))) (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) - (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) (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) (let loop ((i (- (string-length p) 1))) @@ -53,16 +58,44 @@ ;; directory children as full paths, sorted (the __list-dir seed primitive). (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)) (sort string (string-length p) 0) (char=? (string-ref p 0) #\/)) 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)) ---------------------------- ;; A File.toURL value: .toString / .toExternalForm give the spec, .getPath / ;; .getFile strip the "file:" scheme. @@ -88,20 +121,54 @@ ;; --- 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))) + (let ((p (jfile-path f)) ; the path as given (display methods) + (fp (jfile-fs f))) ; JOLT_PWD-resolved on-disk path (FS methods) (cond ((string=? name "getPath") (list p)) ((string=? name "getName") (list (path-last-segment p))) ((string=? name "toString") (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))) + ((string=? name "getAbsolutePath")(list (jfile-abs fp))) + ((string=? name "getCanonicalPath")(list (jfile-abs fp))) + ((string=? name "toURI") (list (string-append "file:" (jfile-abs fp)))) + ((string=? name "toURL") (list (make-url (string-append "file:" (jfile-abs fp))))) + ((string=? name "exists") (list (if (file-exists? fp) #t #f))) + ((string=? name "isDirectory") (list (if (file-directory? fp) #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 "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 stringnum (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) (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") (let loop ((i (- (string-length p) 1))) (cond ((< i 0) (list jolt-nil)) @@ -126,7 +193,7 @@ (lambda (method target . args) (cond ((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")) (list->cseq (map make-jfile (jolt-list-dir target)))) (else (apply %io-host-call method target args))))) @@ -201,7 +268,7 @@ (loop (cons (bitwise-and (jnum->exact b) #xff) acc)))))) (define (jolt-slurp src . opts) (cond - ((jfile? src) (read-file-string (jfile-path src))) + ((jfile? src) (read-file-string (jfile-fs src))) ((embedded-res? src) (embedded-res-content src)) ((reader-jhost? src) (drain-reader src)) ;; bytes (a bytevector or a jolt byte-array): decode with :encoding (UTF-8 @@ -223,7 +290,7 @@ (else (loop (cddr o)))))) (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)))) (put-string port (jolt-str-render-one content)) (close-port port) @@ -275,7 +342,8 @@ (define (jolt-close x) (cond ((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) ;; a library's stream shim (tagged-table) closes via its registered .close ;; 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. (define (seq-source->string 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) (cond ((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))) ((and (jhost? x) (string=? (jhost-tag x) "url")) (host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x))))) @@ -393,6 +465,32 @@ (if (pair? rest) (jolt-make-file (string-append (file-path-of a) "/" (file-path-of (car rest)))) (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. (register-class-statics! "UUID" (list (cons "randomUUID" (lambda () (jolt-random-uuid))) diff --git a/host/chez/rt.ss b/host/chez/rt.ss index 9f1875c..1fb57a5 100644 --- a/host/chez/rt.ss +++ b/host/chez/rt.ss @@ -376,6 +376,11 @@ ;; it. After the dispatchers it chains. (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. ;; Chains seq/count/empty?/peek/pop/conj/sequential?/class/instance?/printer, so ;; load after natives-array (the dispatchers it extends). diff --git a/test/chez/corpus.edn b/test/chez/corpus.edn index d721b18..42b9d69 100644 --- a/test/chez/corpus.edn +++ b/test/chez/corpus.edn @@ -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 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.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))"} ]