mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-22 20:40:29 +02:00
Code Activity

Add two-argument fixpoint arity

Browse source 
* module/language/cps2/utils.scm (fixpoint): Add two-argument arity.
This commit is contained in:
Andy Wingo 2015-05-19 08:34:30 +02:00
parent 4632f3d998
commit cb7aa0b3b1
1 changed files with 13 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

16
module/language/cps2/utils.scm
View file

@ -122,9 +122,19 @@
(lambda (in out0 out1) (lambda (in out0 out1)
(worklist-fold2 f in out0 out1))))) (worklist-fold2 f in out0 out1)))))
(define (fixpoint f x) (define fixpoint
(let ((x* (f x))) (case-lambda
(if (eq? x x*) x* (fixpoint f x*)))) ((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) (define (compute-function-body conts kfun)
(persistent-intset (persistent-intset