the seasoned schemer中letcc的代码
;(define intersect
; (lambda (set1 set2)
; (letrec
; ((I (lambda (set)
; (cond
; ((null? set) (quote ()))
; ((member? (car set) set2)
; (cons (car set) (I (cdr set))));注意,此处不是(I (cdr set) set2)))
; (else (I (cdr set)))))))
; (I set1))))
;使用letcc突然并迅速的返回一个结果
;递归 onto the result of
;(define intersectall
; (lambda (lset)
; (call-with-current-continuation
; (lambda (hop)
; (letrec
; ((A (lambda (lset)
; (cond
; ((null? (car lset)) (hop (quote ())))
; ((null? (cdr lset)) (car lset))
; (else (I (car lset) (A (cdr lset)))))))
; (I (lambda (s1 s2)
; (letrec
; ((J (lambda (s1)
; (cond
; ((null? s1) (quote ()))
; ((member? (car s1) s2) (cons (car s1) (J (cdr s1))))
; (else (J (cdr s1)))))))
; (cond
; ((null? s2) (quote ()))
; (else (J s1)))))))
; (cond
; ((null? lset) (quote ()))
; (else (A lset))))))))
;(intersectall '((3 steaks and) () (3 ha)))
;(newline)
;(intersectall '((3 steaks and) (2 5) (3 ha)))
;内部函数intersect使用letcc
(define intersectall
(lambda (lset)
(call-with-current-continuation
(lambda (hop)
(letrec
((A (lambda (lset)
(cond
((null? (car lset)) (hop (quote ())))
((null? (cdr lset)) (car lset))
(else (I (car lset) (A (cdr lset)))))))
(I (lambda (s1 s2)
(letrec
((J (lambda (s1)
(cond
((null? s1) (quote ()))
((member? (car s1) s2) (cons (car s1) (J (cdr s1))))
(else (J (cdr s1)))))))
(cond
((null? s2) (hop (quote ())))
(else (J s1)))))))
(cond
((null? lset) (quote ()))
(else (A lset))))))))
(intersectall '((3 steaks and) () (3 ha)))
(newline)
(intersectall '((3 steaks and) (2 5) (3 ha)))
;去掉递归中不变的参数a
(define rember
(lambda (a lat)
(letrec
((R (lambda (lat)
(cond
((null? lat) (quote ()))
((eq? (car lat) a) (cdr lat))
(else (cons (car lat) (R (cdr lat))))))))
(R lat))))
(newline)
(rember 'a '(b c d a e a f))
(define rember-beyond-first
(lambda (a lat)
(letrec
((R (lambda (lat)
(cond
((null? lat) (quote ()))
((eq? (car lat) a) (quote ()))
(else (cons (car lat) (R (cdr lat))))))))
(R lat))))
(newline)
(rember-beyond-first 'a '(b c d a e a f))
(define rember-upto-last
(lambda (a lat)
(call-with-current-continuation
(lambda (skip)
(letrec
((R (lambda (lat)
(cond
((null? lat) (quote ()))
((eq? (car lat) a) (skip (R (cdr lat))))
(else (cons (car lat) (R (cdr lat))))))))
(R lat))))))
(newline)
(rember-upto-last 'a '(b c d a e a f))