[Guile-commits] 07/11: Add arity to worklist-fold

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 1403df4140759397a219f793b4fcbcb35937b033
Author: Andy Wingo <address@hidden>
Date:   Tue May 19 08:38:24 2015 +0200

    Add arity to worklist-fold
    
    * module/language/cps2/utils.scm (worklist-fold): Add two-seeded arity.
      (worklist-fold2): Remove.
    
    * module/language/cps2/renumber.scm (compute-tail-path-lengths): Adapt.
---
 module/language/cps2/renumber.scm |    2 +-
 module/language/cps2/utils.scm    |   27 +++++++++++++--------------
 2 files changed, 14 insertions(+), 15 deletions(-)

diff --git a/module/language/cps2/renumber.scm 
b/module/language/cps2/renumber.scm
index d114d5a..f7e9eb6 100644
--- a/module/language/cps2/renumber.scm
+++ b/module/language/cps2/renumber.scm
@@ -55,7 +55,7 @@
       (values (compute-next labels lengths) lengths (1+ length))))
   (match (intmap-ref conts kfun)
     (($ $kfun src meta self tail clause)
-     (worklist-fold2 visit (intset-add empty-intset tail) empty-intmap 0))))
+     (worklist-fold visit (intset-add empty-intset tail) empty-intmap 0))))
 
 ;; Topologically sort the continuation tree starting at k0, using
 ;; reverse post-order numbering.
diff --git a/module/language/cps2/utils.scm b/module/language/cps2/utils.scm
index c7b7707..c1fcd39 100644
--- a/module/language/cps2/utils.scm
+++ b/module/language/cps2/utils.scm
@@ -38,7 +38,7 @@
             ;; Various utilities.
             fold1 fold2
             intset->intmap
-            worklist-fold worklist-fold2
+            worklist-fold
             fixpoint
 
             ;; Flow analysis.
@@ -108,19 +108,18 @@
                   (intmap-add! preds label (f label)))
                 set empty-intmap)))
 
-(define (worklist-fold f in out)
-  (if (eq? in empty-intset)
-      out
-      (call-with-values (lambda () (f in out))
-        (lambda (in out)
-          (worklist-fold f in out)))))
-
-(define (worklist-fold2 f in out0 out1)
-  (if (eq? in empty-intset)
-      (values out0 out1)
-      (call-with-values (lambda () (f in out0 out1))
-        (lambda (in out0 out1)
-          (worklist-fold2 f in out0 out1)))))
+(define worklist-fold
+  (case-lambda
+    ((f in out)
+     (let lp ((in in) (out out))
+       (if (eq? in empty-intset)
+           out
+           (call-with-values (lambda () (f in out)) lp))))
+    ((f in out0 out1)
+     (let lp ((in in) (out0 out0) (out1 out1))
+       (if (eq? in empty-intset)
+           (values out0 out1)
+           (call-with-values (lambda () (f in out0 out1)) lp))))))
 
 (define fixpoint
   (case-lambda