前言
我們都知道call/cc是最強大的控制流語句，幾乎所有控制流語句（極少特殊的不能）都能用call/cc合成赖草。那么我就來進行一下總結(jié)霜瘪，用call/cc合成所有的控制流結(jié)構(gòu)喧半。如果您覺得有實現(xiàn)不正確的，歡迎在文章底部進行評論材义，我將對這篇文章進行更新均抽。
除此之外，你還將學習到一些關(guān)于scheme宏編寫的知識其掂。
除最后一段代碼以外均在racket v6.6下測試通過油挥。
while語句
包含while，continue和break款熬。
(require racket/stxparam)
(define-syntax-parameter break (syntax-rules ()))
(define-syntax-parameter continue (syntax-rules ()))
(define-syntax while
(syntax-rules ()
[(_ test body ...)
(call/cc (lambda (k1)
(let ([t (void)])
(begin (call/cc (lambda (k2) (set! t k2)))
(syntax-parameterize
([break (syntax-rules ()
[(_) (k1 (void))])]
[continue (syntax-rules ()
[(_) (t (void))])])
(when (not test) (break))
body ... (continue))))))]))
(let ([a 1])
(while (< a 10)
(set! a (+ a 1))
(display a)))
(let ([a 1])
(while (< a 10)
(set! a (+ a 1))
(when (= a 5) (break))
(display a)))
(let ([a 1])
(while (< a 10)
(set! a (+ a 1))
(when (= a 5) (continue))
(display a)))
(let ([a 1])
(while (< a 10)
(set! a (+ a 1))
(let ([b 1])
(while (< b a)
(display b)
(display " ")
(set! b (+ b 1))
(when (= b 5) (break))
)
(display a)
(display " "))))
第一個測試輸出：2345678910
第二個測試輸出：234
第三個測試輸出：234678910
第四個測試輸出：1 2 1 2 3 1 2 3 4 1 2 3 4 5 1 2 3 4 6 1 2 3 4 7 1 2 3 4 8 1 2 3 4 9 1 2 3 4 10
goto語句
(require racket/stxparam)
(define-syntax-parameter goto (syntax-rules ()))
(define-syntax prog
(syntax-rules (label)
[(_ "expanding" ((l1 code1 ...)(l codes ...) ...))
((call/cc (lambda (k)
(syntax-parameterize ([goto (syntax-rules ()
[(_ w) (k w)])]
)
(letrec ([l1 (lambda () (let () code1 ...))]
[l (lambda () (let () (void) codes ...))] ...)
l1)))))]
[(_ "expanding" (a ... (l codes ...)) (label lname) rest ...)
(prog "expanding" (a ... (l codes ... (lname)) (lname)) rest ...)]
[(_ "expanding" (i ... (l codes ...)) code1 rest ...)
(prog "expanding" (i ... (l codes ... code1)) rest ...)]
[(_ xxx ...)
(prog "expanding" ((start-label)) xxx ...)]))
(prog
(goto k)
(display "1")
(label k)
(display 2)
)
exception
已經(jīng)在上一篇文章Dynamic Scoping in Scheme提過深寥，不再贅述。
Generators
很久之前寫的東西贤牛，代碼風格有些不一樣惋鹅。
;;;implement generators in scheme
;;;bugs fixed : Reset the Continuations
(define *meta-cont* (lambda (v) (error "No Top Level generator")))
(define-syntax (generator stx)
(syntax-case stx ()
[(generator expr ...) #`(letrec (
[#,(datum->syntax #'generator `*cont*)
(lambda (v)
(reset expr ...)
)])
(lambda ()
(#,(datum->syntax #'generator `*cont*) (void))
))]))
(define-syntax yield
(lambda (stx)
(syntax-case stx ()
[(yield v) #`(call/cc (lambda (k)
(set! #,(datum->syntax #'yield `*cont*) (lambda (va) (reset (k va))))
(*meta-cont* v)
))]
)))
(define-syntax reset
(syntax-rules ()
[(_ expr ...) (let ([preserved *meta-cont*])
(call/cc (lambda (k)
(set! *meta-cont* (lambda (v) (set! *meta-cont* preserved) (k v)))
(let ([result (begin expr ...)])
(*meta-cont* result)
))))]))
;;example : yielding values
(define y (generator (yield 1)
(yield 2)
(yield 3)))
(y)
(y)
(y)
;;example : producer and consumer
(define (looper thunk) (thunk) (looper thunk))
(define product #f)
(define p (generator (for-each (lambda (f)
(set! product f)
(display "I have put ")
(display f)
(newline)
(yield (c))) `(apple pea grape banana))))
(define c (generator (looper (lambda ()
(display "I have eaten ")
(display product)
(newline)
(set! product #f)
(yield (p))))))
(p)
;;example : generator makes infinite stream
(define i (let ([v 0])
(generator (looper (lambda ()
(set! v (+ v 1))
(yield (stream-cons v (i))))))))
(define s (i))
(stream-ref s 0)
(stream-ref s 1)
(stream-ref s 2)
(stream-ref s 0)
(stream-ref s 100)
;;example : map generators
(define map-generator
(lambda (f g)
(generator (looper (lambda ()
(yield (f (g))))))))
(define a (map-generator (lambda (x) (+ 2 x))
(generator (yield 1)
(yield 2)
(yield 3))))
(a)
(a)
(a)
tips：這樣實現(xiàn)的generator可能會導(dǎo)致memory leaking。
coroutines殉簸，fibers
與generator原理類似闰集，但略有不同，基本上每一本scheme語言的教材都有相關(guān)的代碼般卑，可以看the scheme programming language,4th edititon,就不給代碼了武鲁。
Partial Continuation
shift/reset
用callcc實現(xiàn)的shift/reset會有效率問題，和上面的generator一樣蝠检，可能會導(dǎo)致內(nèi)存泄漏沐鼠，建議用racket自帶的(racket/control)。
(define *meta-cont* (lambda (v) (error "No Top Level reset")))
(define-syntax reset
(syntax-rules ()
[(_ expr ...) (let ([preserved *meta-cont*])
(call/cc (lambda (k)
(set! *meta-cont* (lambda (v) (set! *meta-cont* preserved) (k v)))
(let ([result (begin expr ...)])
(*meta-cont* result))
)))]))
(define-syntax shift
(syntax-rules ()
[(_ k expr ...) (call/cc
(lambda (k1)
(let* ([k (lambda (v) (reset (k1 v)))]
[v (begin expr ...)]
)
(*meta-cont* v))))]))
(reset (+ 1 (shift k (k (k 1)))))
(((reset (+ (shift a a) (shift b b))) 1) 3)
shift0/reset0
類似于shift/reset,把meta-cont換成了一個表叹谁。
(define *meta-cont* (list (lambda (v) (error "No Top Level rest0"))))
(define-syntax reset0
(syntax-rules ()
[(_ expr ...) (call/cc (lambda (k)
(set! *meta-cont* (cons k
*meta-cont*
))
(let ([result (begin expr ...)]
[c (car *meta-cont*)]
[e (set! *meta-cont* (cdr *meta-cont*))]
)
(c result))
))]))
(define-syntax shift0
(syntax-rules ()
[(_ k expr ...) (call/cc
(lambda (k1)
(let* ([k (lambda (v) (reset0 (k1 v)))]
[c (car *meta-cont*)]
[e (set! *meta-cont* (cdr *meta-cont*))]
[v (begin expr ...)]
)
(c v))))]))
(reset0 (cons 1 (reset0 (shift0 k 2))))
(reset0 (cons 1 (reset0 (shift0 k (shift0 t 2)))))
(reset0 (+ 1 (shift0 k (k (k 1)))))
(reset0 (cons 1 (reset0 (reset0 (shift0 k (shift0 t 1))))))
*meta-cont*
dynamic-wind,unwind-protect
因為tspl上有實現(xiàn)的代碼饲梭，我把它貼出來一下：（以下代碼來自the scheme programming language,4th edititon）
(define dynamic-wind #f)
(let ((winders '()))
(define common-tail
(lambda (x y)
(let ((lx (length x)) (ly (length y)))
(do ((x (if (> lx ly) (list-tail x (- lx ly)) x) (cdr x))
(y (if (> ly lx) (list-tail y (- ly lx)) y) (cdr y)))
((eq? x y) x)))))
(define do-wind
(lambda (new)
(let ((tail (common-tail new winders)))
(let f ((l winders))
(if (not (eq? l tail))
(begin
(set! winders (cdr l))
((cdar l))
(f (cdr l)))))
(let f ((l new))
(if (not (eq? l tail))
(begin
(f (cdr l))
((caar l))
(set! winders l)))))))
(set! call/cc
(let ((c call/cc))
(lambda (f)
(c (lambda (k)
(f (let ((save winders))
(lambda (x)
(if (not (eq? save winders)) (do-wind save))
(k x)))))))))
(set! call-with-current-continuation call/cc)
(set! dynamic-wind
(lambda (in body out)
(in)
(set! winders (cons (cons in out) winders))
(let ((ans (body)))
(set! winders (cdr winders))
(out)
ans))))
engines
很遺憾，這個結(jié)構(gòu)無法用call/cc合成本慕。
recommend readings
1.the scheme programming language,chapter 5
2.applications of continuations,Dan P Friedman
3.schemewiki call-with-current-continuation & composable-continuations-tutorial
4.lisp in small pieces,chapter 3
5.wiki:delimited continuations
6.okmij.org :Continuations and delimited control
7.matt might :Continuations by example: Exceptions, time-traveling search, generators, threads, and coroutines
