>From 32331af6d5665fd5e6bc88eea3781a2a947b5239 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sun, 29 Dec 2013 16:57:14 +0100 Subject: [PATCH 2/2] Fix for #1068 (2): don't allow captured lambdas to get replaced. This caused issues with letrec-like constructs: by replacing variables with complex lambda expressions lexical scoping would be broken and references to variables could be moved around to a location where the variable was out of scope. More generally, the optimization which replaces variables completely ignores all scoping rules, which can cause issues if the values being moved about refer to other variables in the same scope. For unknown reasons, this hasn't caused issues in other situations yet. --- compiler.scm | 17 +++++++++-------- tests/compiler-tests.scm | 21 ++++++++++++++++----- tests/syntax-tests.scm | 4 ++++ 3 files changed, 29 insertions(+), 13 deletions(-) diff --git a/compiler.scm b/compiler.scm index f356eaf..6a84060 100644 --- a/compiler.scm +++ b/compiler.scm @@ -2169,14 +2169,15 @@ (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)) - (and (not (get db name 'captured)) - nrefs - (= 1 (length nrefs)) - (not assigned) - (not (get db name 'assigned)) - (or (not (variable-visible? name)) - (not (get db name 'global))) ) ) + (when (and (not captured) + (or (and (not (get db name 'unknown)) (get db name 'value)) + (and (not (get db name 'captured)) + nrefs + (= 1 (length nrefs)) + (not assigned) + (not (get db name 'assigned)) + (or (not (variable-visible? name)) + (not (get db name 'global))) ) )) (quick-put! plist 'replacable name) (put! db name 'replacing #t) ) ) ) ) diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm index 444aa50..078cb0d 100644 --- a/tests/compiler-tests.scm +++ b/tests/compiler-tests.scm @@ -220,11 +220,22 @@ ;; Optimizer would "lift" inner-bar out of its let and replace ;; outer-bar with it, even though it wasn't visible yet. Caused by ;; broken cps-conversion (underlying problem for #1068). -(let ((outer-bar (##core#undefined))) - (let ((inner-bar (let ((tmp (lambda (x) (if x '1 (outer-bar '#t))))) - tmp))) - (set! outer-bar inner-bar) - (outer-bar #f))) +(assert (equal? 1 (let ((outer-bar (##core#undefined))) + (let ((inner-bar (let ((tmp (lambda (x) + (if x '1 (outer-bar '#t))))) + tmp))) + (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. +(assert (equal? 1 (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. diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm index 89481cd..59f7d63 100644 --- a/tests/syntax-tests.scm +++ b/tests/syntax-tests.scm @@ -1119,6 +1119,10 @@ take tmp))) (bar #f))) +;; Deeper issue uncovered by fixing the above issue +(t 1 (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))))) -- 1.7.10.4