Re: [Chicken-hackers] [PATCH] Fix #1620 by ignoring captured state of replaced variables

[megane]

Peter Bex <address@hidden> writes:

> On Thu, Jul 11, 2019 at 03:15:00PM +0300, megane wrote:
>> Of course if this is dropped the other conditions must still meet.
>>
[...]
>>
>> Here's a correct way to drop the (not captured) check:
>>
>>   (and (not assigned)
>>        (or (and (not (db-get db name 'unknown))
>>                 (db-get db name 'value))
>>            (and (not (db-get db name 'assigned))
>>                 (or (not (variable-visible?
>>                           name block-compilation))
>>                     (not (db-get db name 'global))) ) ))
>
> Wow, nice catch!  That makes a lot of sense.  I'll cook up a proper
> patch unless someone beats me to it.
>

Here's a new patch that drops the (not captured) check.

I also updated the comment and formatted it so it's easier to change in
the future if needed.

>From dbf207a90e47265cbcbca0a82c010710003a6dc2 Mon Sep 17 00:00:00 2001
From: Peter Bex <address@hidden>
Date: Sun, 30 Jun 2019 15:42:19 +0200
Subject: [PATCH] Mark aliased variable as replacable even if either variable
 is captured

The only thing that really matters is whether it is global or assigned
to, the capture state is irrelevant as far as I can tell.

Fixes #1620
---
 core.scm | 31 ++++++++++++++-----------------
 1 file changed, 14 insertions(+), 17 deletions(-)

diff --git a/core.scm b/core.scm
index f74b140f..1468819d 100644
--- a/core.scm
+++ b/core.scm
@@ -2317,11 +2317,9 @@
                             (quick-put! plist 'inlinable #t)
                             (quick-put! plist 'local-value n))))))))
 
-        ;; Make 'collapsable, if it has a known constant value which is either 
collapsable or is only
-        ;;  referenced once and if no assignments are made:
-        (when (and value
-                   ;; (not (assq 'assigned plist)) - If it has a known value, 
it's assigned just once!
-                   (eq? 'quote (node-class value)) )
+        ;; Make 'collapsable, if it has a known constant value which
+        ;; is either collapsable or is only referenced once:
+        (when (and value (eq? 'quote (node-class value)) )
           (let ((val (first (node-parameters value))))
             (when (or (collapsable-literal? val)
                       (= 1 nreferences) )
@@ -2371,25 +2369,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 if it is not captured and referenced only 
once, 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)))
-                   (nrefs (db-get db name 'references)) )
-              (when (and (not captured)
+            (let ((name (first (node-parameters value))) )
+              (when (and (not assigned)
                          (or (and (not (db-get db name 'unknown))
                                   (db-get db name 'value))
-                             (and (not (db-get db name 'captured))
-                                  nrefs
-                                  (= 1 (length nrefs))
-                                  (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))) ) ))
-- 
2.17.1