~ chicken-core (chicken-5) 27dbbc02d32f91712b83f6b11ffa325da6454df8


commit 27dbbc02d32f91712b83f6b11ffa325da6454df8
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Sun Aug 25 16:23:11 2019 +0200
Commit:     megane <meganeka@gmail.com>
CommitDate: Sun Oct 6 19:16:04 2019 +0300

    Also allow captured variables with known values from being replaced
    
    This should still be safe.  Only when the variable is assigned to is
    this not allowed.
    
    This change should completely fix situations like in #1620
    
    Signed-off-by: megane <meganeka@gmail.com>

diff --git a/core.scm b/core.scm
index 388c8d97..b3177501 100644
--- a/core.scm
+++ b/core.scm
@@ -2392,21 +2392,24 @@
 			undefined) )
 	   (quick-put! plist 'removable #t) )
 
-	 ;; Make 'replacable, if it has a variable as known value and if either that variable has
-	 ;;  a known value itself, or the target and the source are never assigned and the source
-	 ;;  is non-global or we are in block-mode:
-	 ;;  - The target-variable is not allowed to be global.
+	 ;; Make 'replacable, if
+	 ;; - it has a variable as known value and
+	 ;; - it is not a global
+	 ;; - it is never assigned to and
+	 ;; - if either the substitute has a known value itself or
+	 ;;   * the substitute is never assigned to and
+	 ;;   * we are in block-mode or the substitute is non-global
+	 ;;
 	 ;;  - The variable that can be substituted for the current one is marked as 'replacing.
 	 ;;    This is done to prohibit beta-contraction of the replacing variable (It wouldn't be there, if
 	 ;;    it was contracted).
 	 (when (and value (not global))
 	   (when (eq? '##core#variable (node-class value))
 	     (let ((name (first (node-parameters value))) )
-	       (when (and (not captured)
+	       (when (and (not assigned)
 			  (or (and (not (db-get db name 'unknown))
 				   (db-get db name 'value))
-			      (and (not assigned)
-				   (not (db-get db name 'assigned))
+			      (and (not (db-get db name 'assigned))
 				   (or (not (variable-visible?
 					     name block-compilation))
 				       (not (db-get db name 'global))) ) ))
Trap