[Guile-commits] 01/01: Fix compilation of `continue' in `while'.

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 8da33d972a795e0bb1c0e3ed5735d9bf42756950
Author: Andy Wingo <address@hidden>
Date:   Thu Aug 4 21:35:30 2016 +0200

    Fix compilation of `continue' in `while'.
    
    * module/language/cps/rotate-loops.scm (rotate-loops-in-function): Don't
      attempt to rotate a loop whose header is a $prompt.  Fixes use of
      `continue' in `while'.  Thanks to Nala Ginrut for the report :)
---
 module/language/cps/rotate-loops.scm |   14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/module/language/cps/rotate-loops.scm 
b/module/language/cps/rotate-loops.scm
index 0fab94f..09c1332 100644
--- a/module/language/cps/rotate-loops.scm
+++ b/module/language/cps/rotate-loops.scm
@@ -215,12 +215,16 @@
                 (if (and (can-rotate? back-edges)
                          (trivial-intset
                           (intset-subtract (intmap-ref succs entry) scc))
-                         (trivial-intset (loop-successors scc succs)))
+                         (trivial-intset (loop-successors scc succs))
+                         (match (intmap-ref cps entry)
+                           ;; Can't rotate $prompt out of loop header.
+                           (($ $kargs _ _ ($ $continue _ _ ($ $prompt))) #f)
+                           (_ #t)))
                     ;; Loop header is an exit, and there is only one
-                    ;; exit continuation.  Loop header must then be a
-                    ;; conditional branch and only one successor is an
-                    ;; exit.  The values flowing out of the loop are the
-                    ;; loop variables.
+                    ;; exit continuation.  Loop header isn't a prompt,
+                    ;; so it must be a conditional branch and only one
+                    ;; successor is an exit.  The values flowing out of
+                    ;; the loop are the loop variables.
                     (rotate-loop cps entry scc succs preds back-edges)
                     cps))))
         (else cps)))