java.io: full File API + byte/char streams over Chez ports
Expand java.io so libraries that touch the filesystem work unchanged.
File: the full method surface — length, lastModified, can{Read,Write,Execute},
isHidden, list, mkdir(s), delete, createNewFile, renameTo, getParentFile,
get{Absolute,Canonical}File, compareTo/equals/hashCode — plus the statics
separator / pathSeparator / createTempFile / listRoots. A File now keeps the
path as given (new File("rel").getPath() is "rel", .isAbsolute false); a
relative path resolves against JOLT_PWD only when the filesystem is touched,
matching the JVM. slurp/spit and the dir helpers go through the same
resolution, fixing a spit-vs-slurp inconsistency.
Streams (host/chez/io-streams.ss) — each a jhost wrapping a Chez port, so
buffering, EOF and binary<->char transcoding come from Chez:
- FileInputStream / FileOutputStream / ByteArrayInputStream /
ByteArrayOutputStream / BufferedInputStream / BufferedOutputStream
- FileReader / FileWriter / InputStreamReader / OutputStreamWriter /
BufferedReader / BufferedWriter
Buffered* return the wrapped stream (Chez ports are already buffered).
clojure.java.io: input-stream/output-stream now yield real byte streams (were
aliased to the char reader/writer); added copy (byte-exact for byte sources),
make-parents, delete-file. with-open also closes file-writer/port-writer/
print-writer (a pre-existing gap).
All runtime shims, no re-mint. 15 JVM-certified corpus rows; make test +
shakesmoke green.
This commit is contained in:
Yogthos
parent
7bc4288e98
commit
1853d827bd
5 changed files with 480 additions and 24 deletions
321
host/chez/io-streams.ss
Normal file
321
host/chez/io-streams.ss
Normal 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
134
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<? (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).
|
||||
(define (jfile-abs p)
|
||||
(if (and (> (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 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")
|
||||
(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)))
|
||||
|
|
|
|||
|
|
@ -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).
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue