Ticket #1068: 0002-Fix-for-1068-2-lambdas-with-local-references-shouldn.patch

compiler.scm

@@ -2159 +2159 @@
            (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
+         ;;  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.
          ;;  - 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).
+         ;;
+         ;; [*] In case the known value is a lambda, it may not refer to any local variables,
+         ;;      to avoid scoping issues due to reordering.
          (when (and value (not global))
            (when (eq? '##core#variable (node-class value))
              (let* ([name (first (node-parameters value))]
                     [nrefs (get db name 'references)] )
-               (when (or (and (not (get db name 'unknown)) (get db name 'value))
+               (when (or (and (not (get db name 'unknown))
+                              (let ((v (get db name 'value)))
+                                (cond
+                                 ((not v) #f)
+                                 ((eq? '##core#lambda (node-class v))
+                                  (let ((valparams (node-parameters v)))
+                                    (or (not (second valparams))
+                                        (every 
+                                         (lambda (v) (get db v 'global))
+                                         (nth-value 0 (scan-free-variables value))))))
+                                 (else #t))
+                                (and v (not (eq? '##core#lambda (node-class v))))))
                          (and (not (get db name 'captured))
                               nrefs
                               (= 1 (length nrefs))

tests/compiler-tests.scm

@@ -226 +226 @@
     (set! outer-bar inner-bar)
     (outer-bar #f)))
 
+;; Slightly modified version which broke after fixing the above due
+;; to replacement optimization getting triggered.  This replacement
+;; caused outer-bar to get replaced by inner-bar, even within itself,
+;; thereby causing an undefined variable reference.
+(let ((outer-bar (##core#undefined)))
+  (let ((inner-bar (lambda (x) (if x '1 (outer-bar outer-bar)))))
+    (set! outer-bar inner-bar)
+    (outer-bar '#f)))
+
 ;; Test that encode-literal/decode-literal use the proper functions
 ;; to decode number literals.
 (assert (equal? '(+inf.0 -inf.0) (list (fp/ 1.0 0.0) (fp/ -1.0 0.0))))

tests/syntax-tests.scm

@@ -1119 +1119 @@
                      tmp)))
        (bar #f)))
 
+;; Deeper issue uncovered by fixing the above issue
+(letrec ((bar (lambda (x) (if x 1 (bar bar)))))
+  (bar #f))
+
 ;; Just to verify (this has always worked)
 (t 1 (letrec* ((foo (lambda () 1))
                (bar (let ((tmp (lambda (x) (if x (foo) (bar #t)))))