02/04: monads, gexp: Prevent redefinition of syntax parameters.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 8245bb74fc7bdcdc2f9d458057cefc9cd982e489
Author: Ludovic Courtès <address@hidden>
Date:   Wed Feb 6 21:58:43 2019 +0100

    monads, gexp: Prevent redefinition of syntax parameters.
    
    Fixes <https://bugs.gnu.org/27476>.
    
    This fixes multi-threaded compilation of this code where syntax
    parameters could end up being redefined and where a race condition could
    lead a thread to see the "wrong" value of the syntax parameter.
    
    * guix/monads.scm (define-syntax-parameter-once): New macro.
    (>>=, return): Use it.
    * guix/gexp.scm (define-syntax-parameter-once): New macro.
    (current-imported-modules, current-imported-extensions): Use it.
---
 guix/gexp.scm   | 15 +++++++++++++--
 guix/monads.scm | 15 +++++++++++++--
 2 files changed, 26 insertions(+), 4 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index f7c0642..5b5b064 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -920,7 +920,18 @@ and in the current monad setting (system type, etc.)"
               (simple-format #f "~a:~a" line column)))
         "<unknown location>")))
 
-(define-syntax-parameter current-imported-modules
+(define-syntax-rule (define-syntax-parameter-once name proc)
+  ;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
+  ;; does not get redefined.  This works around a race condition in a
+  ;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
+  (eval-when (load eval expand compile)
+    (define name
+      (if (module-locally-bound? (current-module) 'name)
+          (module-ref (current-module) 'name)
+          (make-syntax-transformer 'name 'syntax-parameter
+                                   (list proc))))))
+
+(define-syntax-parameter-once current-imported-modules
   ;; Current list of imported modules.
   (identifier-syntax '()))
 
@@ -931,7 +942,7 @@ environment."
                          (identifier-syntax modules)))
     body ...))
 
-(define-syntax-parameter current-imported-extensions
+(define-syntax-parameter-once current-imported-extensions
   ;; Current list of extensions.
   (identifier-syntax '()))
 
diff --git a/guix/monads.scm b/guix/monads.scm
index 6ae616a..6924471 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -274,12 +274,23 @@ more optimizations."
                    (_
                     #'generic-name))))))))))
 
-(define-syntax-parameter >>=
+(define-syntax-rule (define-syntax-parameter-once name proc)
+  ;; Like 'define-syntax-parameter' but ensure the top-level binding for NAME
+  ;; does not get redefined.  This works around a race condition in a
+  ;; multi-threaded context with Guile <= 2.2.4: <https://bugs.gnu.org/27476>.
+  (eval-when (load eval expand compile)
+    (define name
+      (if (module-locally-bound? (current-module) 'name)
+          (module-ref (current-module) 'name)
+          (make-syntax-transformer 'name 'syntax-parameter
+                                   (list proc))))))
+
+(define-syntax-parameter-once >>=
   ;; The name 'bind' is already taken, so we choose this (obscure) symbol.
   (lambda (s)
     (syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s)))
 
-(define-syntax-parameter return
+(define-syntax-parameter-once return
   (lambda (s)
     (syntax-violation 'return "return used outside of 'with-monad'" s)))