diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-08 00:17:52 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-03-08 00:17:52 +0100 |
commit | 7931a1bcaccfc50ec0e1358b0fc80518b3c00a29 (patch) | |
tree | 2f31fb99d41f7045876769e72383f1b4caad8733 /module/hnh/util | |
parent | Add test for begin1 and set! interaction. (diff) | |
download | calp-7931a1bcaccfc50ec0e1358b0fc80518b3c00a29.tar.gz calp-7931a1bcaccfc50ec0e1358b0fc80518b3c00a29.tar.xz |
Respecificy return value of with-atomic-output-to-file.
Diffstat (limited to 'module/hnh/util')
-rw-r--r-- | module/hnh/util/io.scm | 28 |
1 files changed, 15 insertions, 13 deletions
diff --git a/module/hnh/util/io.scm b/module/hnh/util/io.scm index 161e09a0..3a595b67 100644 --- a/module/hnh/util/io.scm +++ b/module/hnh/util/io.scm @@ -1,4 +1,5 @@ (define-module (hnh util io) + :use-module ((hnh util) :select (begin1)) :use-module ((ice-9 rdelim) :select (read-line))) (define-public (open-input-port str) @@ -13,18 +14,18 @@ (define-public (read-lines port) - (with-input-from-port port - (lambda () - (let loop ((line (read-line))) - (if (eof-object? line) - '() (cons line (loop (read-line)))))))) + (let ((line (read-line port))) + (if (eof-object? line) + '() (cons line (read-lines port))))) ;; Same functionality as the regular @var{with-output-to-file}, but ;; with the difference that either everything is written, or nothing ;; is written, and if anything is written it's all written atomicaly at ;; once (the original file will never contain an intermidiate state). ;; Does NOT handle race conditions between threads. -;; Return #f on failure, something truthy otherwise +;; +;; propagates the return value of @var{thunk} upon successfully writing +;; the file, and @code{#f} otherwise. (define-public (with-atomic-output-to-file filename thunk) ;; copy to enusre writable string (define tmpfile (string-copy (string-append @@ -36,13 +37,14 @@ (dynamic-wind (lambda () (set! port (mkstemp! tmpfile))) (lambda () - (with-output-to-port port thunk) - ;; Closing a port forces a write, due to buffering - ;; some of the errors that logically would come - ;; from write calls are first raised here. But since - ;; crashing is acceptable here, that's fine. - (close-port port) - (rename-file tmpfile filename)) + (begin1 + (with-output-to-port port thunk) + ;; Closing a port forces a write, due to buffering + ;; some of the errors that logically would come + ;; from write calls are first raised here. But since + ;; crashing is acceptable here, that's fine. + (close-port port) + (rename-file tmpfile filename))) (lambda () (when (access? tmpfile F_OK) ;; I'm a bit unclear on how to trash our write buffer. |