guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[no subject]


From: Ludovic Courtès
Date: Fri, 26 Jan 2018 09:24:05 -0500 (EST)

branch: master
commit 8d44590099aad46b0f3c4f6537d44076b2cfb704
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 26 14:43:29 2018 +0100

    utils: Add 'non-blocking' macro.
    
    * src/cuirass/utils.scm (%non-blocking): New procedure.
    (non-blocking): New macro.
---
 src/cuirass/utils.scm | 23 ++++++++++++++++++++++-
 1 file changed, 22 insertions(+), 1 deletion(-)

diff --git a/src/cuirass/utils.scm b/src/cuirass/utils.scm
index 9f432a6..7c2739b 100644
--- a/src/cuirass/utils.scm
+++ b/src/cuirass/utils.scm
@@ -20,12 +20,16 @@
 
 (define-module (cuirass utils)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 threads)
   #:use-module (srfi srfi-1)
   #:use-module (json)
+  #:use-module (fibers)
+  #:use-module (fibers channels)
   #:export (alist?
             object->json-scm
             object->json-string
-            define-enumeration))
+            define-enumeration
+            non-blocking))
 
 (define (alist? obj)
   "Return #t if OBJ is an alist."
@@ -57,3 +61,20 @@ value."
     (syntax-rules (symbol ...)
       ((_ symbol) value)
       ...)))
+
+(define (%non-blocking thunk)
+  (let ((channel (make-channel)))
+    (call-with-new-thread
+     (lambda ()
+       (call-with-values thunk
+         (lambda values
+           (put-message channel values)))))
+    (apply values (get-message channel))))
+
+(define-syntax-rule (non-blocking exp ...)
+  "Evalaute EXP... in a separate thread so that it doesn't block the execution
+of fibers.
+
+This is useful when passing control to non-cooperative and non-resumable code
+such as a 'clone' call in Guile-Git."
+  (%non-blocking (lambda () exp ...)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]