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.
This commit is contained in:
		
							parent
							
								
									d591242808
								
							
						
					
					
						commit
						8245bb74fc
					
				
					 2 changed files with 26 additions and 4 deletions
				
			
		| 
						 | 
					@ -920,7 +920,18 @@ and in the current monad setting (system type, etc.)"
 | 
				
			||||||
              (simple-format #f "~a:~a" line column)))
 | 
					              (simple-format #f "~a:~a" line column)))
 | 
				
			||||||
        "<unknown location>")))
 | 
					        "<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.
 | 
					  ;; Current list of imported modules.
 | 
				
			||||||
  (identifier-syntax '()))
 | 
					  (identifier-syntax '()))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -931,7 +942,7 @@ environment."
 | 
				
			||||||
                         (identifier-syntax modules)))
 | 
					                         (identifier-syntax modules)))
 | 
				
			||||||
    body ...))
 | 
					    body ...))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-syntax-parameter current-imported-extensions
 | 
					(define-syntax-parameter-once current-imported-extensions
 | 
				
			||||||
  ;; Current list of extensions.
 | 
					  ;; Current list of extensions.
 | 
				
			||||||
  (identifier-syntax '()))
 | 
					  (identifier-syntax '()))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -274,12 +274,23 @@ more optimizations."
 | 
				
			||||||
                   (_
 | 
					                   (_
 | 
				
			||||||
                    #'generic-name))))))))))
 | 
					                    #'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.
 | 
					  ;; The name 'bind' is already taken, so we choose this (obscure) symbol.
 | 
				
			||||||
  (lambda (s)
 | 
					  (lambda (s)
 | 
				
			||||||
    (syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s)))
 | 
					    (syntax-violation '>>= ">>= (bind) used outside of 'with-monad'" s)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-syntax-parameter return
 | 
					(define-syntax-parameter-once return
 | 
				
			||||||
  (lambda (s)
 | 
					  (lambda (s)
 | 
				
			||||||
    (syntax-violation 'return "return used outside of 'with-monad'" s)))
 | 
					    (syntax-violation 'return "return used outside of 'with-monad'" s)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue