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

File 0002-Fix-for-1068-2-lambdas-with-local-references-shouldn.patch, 3.7 KB (added by sjamaan, 9 years ago)

Second fix: don't allow lambdas with local variable references to replace variables.

  • compiler.scm

    From 65808b31f5743a5c7941e6577f1af3119fb62da7 Mon Sep 17 00:00:00 2001
    From: Peter Bex <peter.bex@xs4all.nl>
    Date: Sun, 22 Dec 2013 22:32:39 +0100
    Subject: [PATCH 2/2] Fix for #1068 (2): lambdas with local references
     shouldn't replace variables.
    
    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.
    ---
     compiler.scm             |   18 ++++++++++++++++--
     tests/compiler-tests.scm |    9 +++++++++
     tests/syntax-tests.scm   |    4 ++++
     3 files changed, 29 insertions(+), 2 deletions(-)
    
    diff --git a/compiler.scm b/compiler.scm
    index f356eaf..b7e6899 100644
    a b  
    21592159           (quick-put! plist 'removable #t) )
    21602160
    21612161         ;; Make 'replacable, if it has a variable as known value and if either that variable has
    2162          ;;  a known value itself, or if it is not captured and referenced only once, the target and
     2162         ;;  a known value[*] itself, or if it is not captured and referenced only once, the target and
    21632163         ;;  the source are never assigned and the source is non-global or we are in block-mode:
    21642164         ;;  - The target-variable is not allowed to be global.
    21652165         ;;  - The variable that can be substituted for the current one is marked as 'replacing.
    21662166         ;;    This is done to prohibit beta-contraction of the replacing variable (It wouldn't be there, if
    21672167         ;;    it was contracted).
     2168         ;;
     2169         ;; [*] In case the known value is a lambda, it may not refer to any local variables,
     2170         ;;      to avoid scoping issues due to reordering.
    21682171         (when (and value (not global))
    21692172           (when (eq? '##core#variable (node-class value))
    21702173             (let* ([name (first (node-parameters value))]
    21712174                    [nrefs (get db name 'references)] )
    2172                (when (or (and (not (get db name 'unknown)) (get db name 'value))
     2175               (when (or (and (not (get db name 'unknown))
     2176                              (let ((v (get db name 'value)))
     2177                                (cond
     2178                                 ((not v) #f)
     2179                                 ((eq? '##core#lambda (node-class v))
     2180                                  (let ((valparams (node-parameters v)))
     2181                                    (or (not (second valparams))
     2182                                        (every
     2183                                         (lambda (v) (get db v 'global))
     2184                                         (nth-value 0 (scan-free-variables value))))))
     2185                                 (else #t))
     2186                                (and v (not (eq? '##core#lambda (node-class v))))))
    21732187                         (and (not (get db name 'captured))
    21742188                              nrefs
    21752189                              (= 1 (length nrefs))
  • tests/compiler-tests.scm

    diff --git a/tests/compiler-tests.scm b/tests/compiler-tests.scm
    index 444aa50..fef0335 100644
    a b  
    226226    (set! outer-bar inner-bar)
    227227    (outer-bar #f)))
    228228
     229;; Slightly modified version which broke after fixing the above due
     230;; to replacement optimization getting triggered.  This replacement
     231;; caused outer-bar to get replaced by inner-bar, even within itself,
     232;; thereby causing an undefined variable reference.
     233(let ((outer-bar (##core#undefined)))
     234  (let ((inner-bar (lambda (x) (if x '1 (outer-bar outer-bar)))))
     235    (set! outer-bar inner-bar)
     236    (outer-bar '#f)))
     237
    229238;; Test that encode-literal/decode-literal use the proper functions
    230239;; to decode number literals.
    231240(assert (equal? '(+inf.0 -inf.0) (list (fp/ 1.0 0.0) (fp/ -1.0 0.0))))
  • tests/syntax-tests.scm

    diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
    index 89481cd..1feb665 100644
    a b take 
    11191119                     tmp)))
    11201120       (bar #f)))
    11211121
     1122;; Deeper issue uncovered by fixing the above issue
     1123(letrec ((bar (lambda (x) (if x 1 (bar bar)))))
     1124  (bar #f))
     1125
    11221126;; Just to verify (this has always worked)
    11231127(t 1 (letrec* ((foo (lambda () 1))
    11241128               (bar (let ((tmp (lambda (x) (if x (foo) (bar #t)))))