diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-01-25 09:47:48 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-25 09:47:48 +0100 |
| commit | 9c96852c6046b6c4d1b2bd1bc3002e134a4bd12b (patch) | |
| tree | a48088acf308d816b6586c8595ae9eedfdbccebd | |
| parent | 8675d6309b0576cdca7d5b607a358fd37982bfe7 (diff) | |
| download | cuirass-9c96852c6046b6c4d1b2bd1bc3002e134a4bd12b.tar cuirass-9c96852c6046b6c4d1b2bd1bc3002e134a4bd12b.tar.gz | |
base: Extract 'read/non-blocking'.
* src/cuirass/base.scm (read/non-blocking): New procedure.
(evaluate): Use it instead of inline code.
| -rw-r--r-- | src/cuirass/base.scm | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index d59be8e..b3db39d 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -191,6 +191,17 @@ directory and the sha1 of the top level commit in this directory." (fcntl port F_SETFL (logior O_NONBLOCK flags)) port)) +(define (read/non-blocking port) + "Like 'read', but uses primitives that don't block and thus play well with +fibers." + ;; XXX: Since 'read' is not suspendable as of Guile 2.2.3, we use + ;; 'read-string' (which is suspendable) and then 'read'. + (match (read-string port) + ((? eof-object? eof) + eof) + ((? string? data) + (call-with-input-string data read)))) + (define (evaluate store db spec) "Evaluate and build package derivations. Return a list of jobs." (let* ((port (non-blocking-port @@ -203,9 +214,7 @@ directory and the sha1 of the top level commit in this directory." (%package-cachedir) (object->string spec) (%package-database)))) - ;; XXX: Since 'read' is not suspendable as of Guile 2.2.3, we use - ;; 'read-string' (which is suspendable) and then 'read'. - (jobs (match (read-string port) + (jobs (match (read/non-blocking port) ;; If an error occured during evaluation report it, ;; otherwise, suppose that data read from port are ;; correct and keep things going. @@ -213,8 +222,7 @@ directory and the sha1 of the top level commit in this directory." (raise (condition (&evaluation-error (name (assq-ref spec #:name)))))) - ((? string? data) - (call-with-input-string data read))))) + (data data)))) (close-pipe port) jobs)) |