find-fold

「プログラミングGauche」の継続のところをチラ見して。CPS難しいー。このコードの後、もっとCPSです。「厳密にCPS変換するとこうなるよ」ってのが載ってましたがギブ。

	; find-fold
	(define (find-fold pred proc seed lis)
	(fold (lambda (e acc)
	(if (pred e)
	(proc e acc)
	acc))
	seed lis))
	(find-fold odd? + 0 '(1 2 3 4 5 6 7 8 9 10))
	; -> 25
	(find-fold even? cons '() '(1 2 3 4 5 6 7 8 9 10))
	; -> (10 8 6 4 2)
	; again : normal recur
	(define (find-fold pred proc seed lis)
	(cond ((null? lis) seed)
	((pred (car lis))
	(find-fold pred proc (proc (car lis) seed)(cdr lis)))
	(else (find-fold pred proc seed (cdr lis)))))
	(find-fold odd? + 0 '(1 2 3 4 5 6 7 8 9 10))
	; -> 25
	(find-fold even? cons '() '(1 2 3 4 5 6 7 8 9 10))
	; -> (10 8 6 4 2)
	; again
	(define (find-fold pred proc seed lis)
	(if (null? lis)
	seed
	(find-fold pred proc (if (pred (car lis))
	(proc (car lis) seed)
	seed)
	(cdr lis))))
	(find-fold odd? + 0 '(1 2 3 4 5 6 7 8 9 10))
	; -> 25
	(find-fold even? cons '() '(1 2 3 4 5 6 7 8 9 10))
	; -> (10 8 6 4 2)
	; again
	(define (find-fold pred proc seed lis)
	(if (null? lis)
	seed
	(let ((kar (car lis)))
	(find-fold pred proc (if (pred kar)
	(proc kar seed)
	seed)
	(cdr lis)))))
	; again cps
	(define (find-fold pred proc/cont seed lis)
	(if (null? lis)
	seed
	(if (pred (car lis))
	(proc/cont
	(car lis)
	seed
	(lambda (result)
	(find-fold pred proc/cont result (cdr lis))))
	(find-fold pred proc/cont seed (cdr lis)))))
	(find-fold odd?
	(lambda (e acc cont)
	(cont (+ e acc)))
	0
	'(1 2 3 4 5 6 7 8 9 10))

view raw find-fold.scm hosted with ❤ by GitHub