[Guile-commits] GNU Guile branch, master, updated. v2.1.0-220-gfea115c

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=fea115c33f35b95c89ebb9142faaa06a43d83036

The branch, master has been updated
       via  fea115c33f35b95c89ebb9142faaa06a43d83036 (commit)
       via  c648869346d6c9fdeb9bfc3abc07feb30c32c555 (commit)
       via  25833e807db7e62e55903e684ac62a694966e711 (commit)
      from  e9588e7032ced422014fb29bfaa6dbb7c2582b12 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit fea115c33f35b95c89ebb9142faaa06a43d83036
Author: Andy Wingo <address@hidden>
Date:   Fri Oct 4 18:03:29 2013 +0200

    Fix nested contification bugs
    
    * module/language/cps/contification.scm (contify): Exhaustively replace
      contified tail continuations, to fix a bug in nested tail-recursive
      contifications.  Likewise, call lookup-return-cont when searching for
      common return continuations.

commit c648869346d6c9fdeb9bfc3abc07feb30c32c555
Author: Andy Wingo <address@hidden>
Date:   Fri Oct 4 17:30:59 2013 +0200

    Fix variable-bound-in?
    
    * module/language/cps/dfg.scm (variable-bound-in?): Fix to look up
      correct variable.

commit 25833e807db7e62e55903e684ac62a694966e711
Author: Andy Wingo <address@hidden>
Date:   Fri Oct 4 16:36:17 2013 +0200

    Fix verify-cps
    
    * module/language/cps/verify.scm (verify-cps): Fix visiting functions.

-----------------------------------------------------------------------

Summary of changes:
 module/language/cps/contification.scm |    9 ++++++---
 module/language/cps/dfg.scm           |    2 +-
 module/language/cps/verify.scm        |    2 +-
 3 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/module/language/cps/contification.scm 
b/module/language/cps/contification.scm
index 469cd28..dda6ee3 100644
--- a/module/language/cps/contification.scm
+++ b/module/language/cps/contification.scm
@@ -49,7 +49,9 @@
     (define (subst-return! old-tail new-tail)
       (set! cont-substs (acons old-tail new-tail cont-substs)))
     (define (lookup-return-cont k)
-      (or (assq-ref cont-substs k) k))
+      (match (assq-ref cont-substs k)
+        (#f k)
+        (k (lookup-return-cont k))))
 
     (define (add-pending-contifications! scope conts)
       (for-each (match-lambda
@@ -78,7 +80,8 @@
                    (((($ $arity req () #f () #f) . k) . clauses)
                     (if (= (length req) (length args))
                         (build-cps-term
-                          ($continue k ($values args)))
+                          ($continue (lookup-return-cont k)
+                            ($values args)))
                         (lp clauses)))
                    ((_ . clauses) (lp clauses)))))))
 
@@ -121,7 +124,7 @@
         (match (find-call (lookup-cont use cont-table))
           (($ $continue k ($ $call proc* args))
            (and (eq? proc proc*) (not (memq proc args)) (applicable? proc args)
-                k))
+                (lookup-return-cont k)))
           (_ #f)))
 
       (and
diff --git a/module/language/cps/dfg.scm b/module/language/cps/dfg.scm
index 8ef3613..056bd74 100644
--- a/module/language/cps/dfg.scm
+++ b/module/language/cps/dfg.scm
@@ -345,7 +345,7 @@
 (define (variable-bound-in? var k dfg)
   (match dfg
     (($ $dfg conts use-maps uplinks)
-     (match (lookup-use-map k use-maps)
+     (match (lookup-use-map var use-maps)
        (($ $use-map sym def uses)
         (continuation-scope-contains? def k uplinks))))))
 
diff --git a/module/language/cps/verify.scm b/module/language/cps/verify.scm
index 0276d1d..bb2e857 100644
--- a/module/language/cps/verify.scm
+++ b/module/language/cps/verify.scm
@@ -124,7 +124,7 @@
       (($ $prim (? symbol? name))
        #t)
       (($ $fun)
-       (visit-fun fun k-env v-env))
+       (visit-fun exp k-env v-env))
       (($ $call (? symbol? proc) ((? symbol? arg) ...))
        (check-var proc v-env)
        (for-each (cut check-var <> v-env) arg))


hooks/post-receive
-- 
GNU Guile