From cb7aa0b3b13b3f9c8dfba3a044d9e97e9dcd8c68 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Tue, 19 May 2015 08:34:30 +0200 Subject: [PATCH] Add two-argument fixpoint arity * module/language/cps2/utils.scm (fixpoint): Add two-argument arity. --- module/language/cps2/utils.scm | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/module/language/cps2/utils.scm b/module/language/cps2/utils.scm index d5955c3fe..c7b770792 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) (persistent-intset