From b905fe8123c70efd46cba3ec1814285a4da5670a Mon Sep 17 00:00:00 2001 From: Noah Pederson Date: Thu, 4 Jan 2024 11:13:30 -0600 Subject: [PATCH] Seekable IO Interface (#1097) Adds seekable interface and implementation for file io --- src/std/io/file-test.ss | 26 +++++++++++++++++++++++++- src/std/io/file.ss | 9 ++++++++- src/std/io/interface.ss | 13 +++++++++++++ src/std/os/fdio.ss | 33 ++++++++++++++++++++++++++++++--- 4 files changed, 76 insertions(+), 5 deletions(-) diff --git a/src/std/io/file-test.ss b/src/std/io/file-test.ss index 330022336..60e13c196 100644 --- a/src/std/io/file-test.ss +++ b/src/std/io/file-test.ss @@ -63,4 +63,28 @@ (check (BufferedWriter-write bwr (string->utf8 text)) => text-length) (BufferedWriter-close bwr)) ;; read the file and make sure it matches the expected text - (check (read-file-string tmp) => text)))))) + (check (read-file-string tmp) => text)))) + + (test-case "file seek" + (call-with-temporary-file-name "text" + (lambda (tmp) + (let* ((wr (open-file-writer tmp)) + (re (open-file-reader tmp)) + (buf (make-u8vector 3))) + (Seeker-seek wr 8) + (check (Writer-write wr #u8(1 123 255)) => 3) + (Reader-read re buf) + (check buf => #u8(0 0 0)) + (Seeker-seek re 8) + (Reader-read re buf) + (check buf => #u8(1 123 255)) + (Seeker-seek wr -1 'current) + (Writer-write wr #u8(55)) + (Seeker-seek re 8) + (Reader-read re buf) + (check buf => #u8(1 123 55)) + (Seeker-seek re -3 'current) + (Seeker-seek wr -2 'current) + (Writer-write wr #u8(6)) + (Reader-read re buf) + (check buf => #u8(1 6 55)))))))) diff --git a/src/std/io/file.ss b/src/std/io/file.ss index 447550afb..a67b38e75 100644 --- a/src/std/io/file.ss +++ b/src/std/io/file.ss @@ -53,7 +53,7 @@ (let (fd self.fd) (let lp ((input-start input-start) (result 0)) (when self.closed? - (raise-io-closed file-io-wrte "file is closed")) + (raise-io-closed output-file-io "file is closed")) (if (fx< input-start input-end) (let (wrote (fdwrite fd input input-start input-end)) (cond @@ -71,6 +71,13 @@ (set! self.closed? #t) (close-port self.fd))))) +(defmethod {seek file-io} + (lambda (self position from) + (using (self :- file-io) + (when self.closed? + (raise-io-closed file-io "file is closed")) + (fdseek self.fd position from)))) + (defrule (open-file-io path flags mode make) (let (fd (open path flags mode)) (make fd #f))) diff --git a/src/std/io/interface.ss b/src/std/io/interface.ss index 076d9858b..37f3e2615 100644 --- a/src/std/io/interface.ss +++ b/src/std/io/interface.ss @@ -11,6 +11,16 @@ (interface Closer (close)) +;; Cursor-based IO +(interface Seeker + ;; Seek to a particular position in the backing IO source. + ;; - position denotes where, relative to `from` that the cursor should be moved to. + ;; When `'start` is supplied, `position` must be positive. + ;; When `'end` `'current` is supplied, `position` may be positive or negative + ;; - from is one of 3 possible origins to seek about. Defaults to `'start`. + (seek (position :~ fixnum?) + (from :~ whence? := 'start))) + ;; generic binary IO (interface (Reader Closer) ;; read into a buffer; it _must_ be a u8vector. @@ -216,3 +226,6 @@ (lambda (o) (or (type? o) ((list-of? type?) o)))) + +(defrule (whence? p) + (cut <> memq '(start end current))) diff --git a/src/std/os/fdio.ss b/src/std/os/fdio.ss index c48766d14..4f8bf597e 100644 --- a/src/std/os/fdio.ss +++ b/src/std/os/fdio.ss @@ -43,6 +43,23 @@ (do-retry-nonblock (_close raw) (close raw)))) +(def (fdsync raw) + (if (fd? raw) + (let (fd (if (fd? raw) (fd-e raw) raw)) + (check-os-error (_fsync fd) + (fdsync raw))))) + +; TODO: this should probably use the port position functions instead of C FFI +(def (fdseek raw position from) + (let ((fd (if (fd? raw) (fd-e raw) raw)) + (whence (case from + ((start) SEEK_SET) + ((current) SEEK_CUR) + ((end) SEEK_END) + (else (error "Unknown from to seek about" from))))) + (check-os-error (_seek fd position whence) + (seek fd position whence)))) + (def (file-direction flags) (cond ((##fx= (##fxand flags O_RDWR) O_RDWR) @@ -55,10 +72,11 @@ (raise-bad-argument fdio "file direction: unspecified" flags)))) ;;; FFI impl -(begin-ffi (_read _write _open _close +(begin-ffi (_read _write _open _close _seek _fsync S_IRWXU S_IWUSR S_IRUSR S_IXUSR S_IRWXG S_IRGRP S_IWGRP S_IXGRP - S_IRWXO S_IROTH S_IWOTH S_IXOTH) + S_IRWXO S_IROTH S_IWOTH S_IXOTH + SEEK_SET SEEK_CUR SEEK_END) (c-declare "#include ") (c-declare "#include ") @@ -77,9 +95,12 @@ (define-const S_IROTH) (define-const S_IWOTH) (define-const S_IXOTH) + (define-const SEEK_SET) + (define-const SEEK_CUR) + (define-const SEEK_END) ;; private - (namespace ("std/os/fdio#" __read __write __open __close)) + (namespace ("std/os/fdio#" __read __write __open __close __seek __fsync)) (c-declare "static int ffi_fdio_read (int fd, ___SCMOBJ bytes, int start, int end);") (c-declare "static int ffi_fdio_write (int fd, ___SCMOBJ bytes, int start, int end);") @@ -92,10 +113,16 @@ "open") (define-c-lambda __close (int) int "close") + (define-c-lambda __fsync (int) int + "fsync") + (define-c-lambda __seek (int int int) int + "lseek") (define-with-errno _read __read (fd bytes start end)) (define-with-errno _write __write (fd bytes start end)) (define-with-errno _open __open (path flags mode)) + (define-with-errno _seek __seek (fd offset whence)) + (define-with-errno _fsync __fsync (fd)) (define-with-errno _close __close (fd)) (c-declare #<