[Top][All Lists]

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

[Guile-commits] 04/11: Add two-argument fixpoint arity

From: Andy Wingo
Subject: [Guile-commits] 04/11: Add two-argument fixpoint arity
Date: Wed, 20 May 2015 17:32:55 +0000

wingo pushed a commit to branch master
in repository guile.

commit cb7aa0b3b13b3f9c8dfba3a044d9e97e9dcd8c68
Author: Andy Wingo <address@hidden>
Date:   Tue May 19 08:34:30 2015 +0200

    Add two-argument fixpoint arity
    * module/language/cps2/utils.scm (fixpoint): Add two-argument arity.
 module/language/cps2/utils.scm |   16 +++++++++++++---
 1 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/module/language/cps2/utils.scm b/module/language/cps2/utils.scm
index d5955c3..c7b7707 100644
--- a/module/language/cps2/utils.scm
+++ b/module/language/cps2/utils.scm
@@ -122,9 +122,19 @@
         (lambda (in out0 out1)
           (worklist-fold2 f in out0 out1)))))
-(define (fixpoint f x)
-  (let ((x* (f x)))
-    (if (eq? x x*) x* (fixpoint f x*))))
+(define fixpoint
+  (case-lambda
+    ((f x)
+     (let lp ((x x))
+       (let ((x* (f x)))
+         (if (eq? x x*) x* (lp x*)))))
+    ((f x0 x1)
+     (let lp ((x0 x0) (x1 x1))
+       (call-with-values (lambda () (f x0 x1))
+         (lambda (x0* x1*)
+           (if (and (eq? x0 x0*) (eq? x1 x1*))
+               (values x0* x1*)
+               (lp x0* x1*))))))))
 (define (compute-function-body conts kfun)

reply via email to

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