guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 04/09: CPS2 renumber works with first-order CPS


From: Andy Wingo
Subject: [Guile-commits] 04/09: CPS2 renumber works with first-order CPS
Date: Wed, 15 Jul 2015 07:51:35 +0000

wingo pushed a commit to branch master
in repository guile.

commit a15a14203e15c5c0dc037ff935c23d345070c819
Author: Andy Wingo <address@hidden>
Date:   Tue Jul 14 13:53:56 2015 +0200

    CPS2 renumber works with first-order CPS
    
    * module/language/cps2/renumber.scm (compute-renaming): Add support for
      $closure and $callk.
---
 module/language/cps2/renumber.scm |   12 ++++++++++++
 1 files changed, 12 insertions(+), 0 deletions(-)

diff --git a/module/language/cps2/renumber.scm 
b/module/language/cps2/renumber.scm
index 2c07e03..16ed29c 100644
--- a/module/language/cps2/renumber.scm
+++ b/module/language/cps2/renumber.scm
@@ -128,6 +128,10 @@
               (($ $kfun src meta self tail clause)
                (rename-var self vars))
               (_ vars))))
+  (define (maybe-visit-fun kfun labels vars)
+    (if (intmap-ref labels kfun (lambda (_) #f))
+        (values labels vars)
+        (visit-fun kfun labels vars)))
   (define (visit-nested-funs k labels vars)
     (match (intmap-ref conts k)
       (($ $kargs names syms ($ $continue k src ($ $fun kfun)))
@@ -135,6 +139,14 @@
       (($ $kargs names syms ($ $continue k src ($ $rec names* syms*
                                                   (($ $fun kfun) ...))))
        (fold2 visit-fun kfun labels vars))
+      (($ $kargs names syms ($ $continue k src ($ $closure kfun nfree)))
+       ;; Closures with zero free vars get copy-propagated so it's
+       ;; possible to already have visited them.
+       (maybe-visit-fun kfun labels vars))
+      (($ $kargs names syms ($ $continue k src ($ $callk kfun)))
+       ;; Well-known functions never have a $closure created for them
+       ;; and are only referenced by their $callk call sites.
+       (maybe-visit-fun kfun labels vars))
       (_ (values labels vars))))
   (define (visit-fun kfun labels vars)
     (let* ((preds (compute-predecessors conts kfun))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]