Scheme 程式設計/連續
call-with-current-continuation是一個過程,它接受另一個過程作為引數,該過程本身接受一個引數。該引數是一個連續,用 Scheme 發明者 Gerald Sussman 和 Guy Steel 的話來說,是“即將從它返回”。call-with-current-continuation. 連續是一個過程,它代表“計算的剩餘部分”。當你將連續作為一個過程呼叫時,控制跳轉到call-with-current-continuation最初被呼叫,並且你提供給連續的任何引數都成為對該呼叫的返回值call-with-current-continuation.
儲存以下程式
cont-test.scm
(define continuations '())
(define (push arg)
(set! continuations
(cons arg continuations)))
(define (capture-from-map arg)
(call-with-current-continuation
(lambda (cc)
(push cc)
arg)))
然後,從 REPL 中嘗試以下操作
(load "cont-test.scm")
; loading cont-test.scm
; done loading cont-test.scm
#<unspecified>
> (define numbers (map capture-from-map '(1 2 3 4 5 6)))
#<unspecified>
> numbers
(1 2 3 4 5 6)
> continuations
(#<continuation 186 @ 891c400> #<continuation 186 @ 891c800> #<continuation 186 @ 891cc00> #<continuation 186 @ 891c000> #<continuation 186 @ 891b400> #<continuation 186 @ 891b800>)
> ((car (reverse continuations)) 76)
#<unspecified>
> numbers
(76 2 3 4 5 6)
這裡發生了什麼?在評估(define numbers (map capture-from-map '(1 2 3 4 5 6)))後,連續變數包含每次map呼叫capture-from-map時的連續,按逆序排列。所以當我們評估((car (reverse continuations) 76)時,執行控制跳轉回capture-from-map最初返回1到map函式的位置,並且在該時間點存在的整個程式堆疊都恢復了。從那時起“計算的剩餘部分”是map對映capture-from-map到列表的剩餘部分,即(2 3 4 5 6),然後將生成的列表定義為變數numbers. 但是這次,我們改變了在call-with-current-continuationlambda
內部進行的那部分計算的結果。numbers(注意:儲存在map中的結果依賴於實現,因為標準沒有指定
呼叫作為引數傳遞的過程的順序。連續變數在所有這一切的範圍之外,並且沒有恢復為'()當控制跳轉回來時。結果,五個新的連續被新增到連續:
> continuations
(#<continuation 186 @ 8923c00> #<continuation 186 @ 8923000> #<continuation 186 @ 8922400> #<continuation 186 @ 8922800> #<continuation 186 @ 8922c00> #<continuation 186 @ 8922000> #<continuation 186 @ 8921400> #<continuation 186 @ 8921800> #<continuation 186 @ 8921c00> #<continuation 186 @ 8921000> #<continuation 186 @ 891f400>)
> (length continuations)
11
>
在某些 Scheme 實現中,call-with-current-continuation也定義為call/cc. 然而,SCM 沒有定義這種較短的形式。如果你需要,你可以自己定義它
(define call/cc call-with-current-continuation)
一些 Scheme 實現有自己的錯誤處理語法,但 SCM 沒有。我們可以使用連續和宏的組合定義一個異常系統。C++ 異常是動態的:當你丟擲一個異常時,控制跳轉到下一個catch塊,一直到呼叫堆疊的頂端。為了在我們的實現中實現這一點,我們將保留一個連續列表,這些連續代表catch塊。每次一個try塊被進入時,它會將一個連續新增到這個堆疊中,每次一個try塊退出時,一個連續就會從堆疊中移除。最簡單的部分是實現連續堆疊
(define *cont-stack* '())
(define (push-catch cont)
(set! *cont-stack* (cons cont *cont-stack*)))
(define (pop-catch)
(let ((retval (car *cont-stack*)))
(set! *cont-stack* (cdr *cont-stack*))
retval))
每次我們呼叫push-catch時,一個新的連續都會被新增到堆疊中。當我們呼叫pop-catch時,我們會得到最後一個被新增的連續(然後是再上一個連續,依此類推),並且該連續也會從堆疊中移除。
困難的部分是確保我們檢測到塊每次退出或重新進入(這可能會因為連續發生),這樣我們才能將連續堆疊保持在正確狀態。幸運的是,Scheme 提供了dynamic-wind,它接受三個過程作為引數,並且與中間 lambda 具有相同的返回值。第一個和最後一個過程是保護過程,它們可以在進入中間過程之前和退出中間過程之後執行初始化和清理
(dynamic-wind
(lambda ()
(let ((exception
(call-with-current-continuation
(lambda (cc)
(push-catch cc)
#f))))
(if exception
(begin catch-body ... (escape)))))
(lambda ()
(begin body ...))
(lambda () (pop-catch)))
唯一剩下的就是定義escape連續,它允許執行在try塊執行之後離開catch塊(否則body將再次執行),並將所有內容包裝在一個宏中。整個程式如下所示
exception.scm
(require 'macro) ; Required to use this with SCM. Other Scheme implementations
; may not require this, or it may even be an error.
(define *cont-stack* '())
(define (push-catch cont)
(set! *cont-stack* (cons cont *cont-stack*)))
(define (pop-catch)
(let ((retval (car *cont-stack*)))
(set! *cont-stack* (cdr *cont-stack*))
retval))
(define (throw exn)
(if (null? *cont-stack*)
(error "Can't use throw outside of a try form")
((car *cont-stack*) exn)))
(define-syntax try
(syntax-rules (catch)
((try (body ...)
catch exception (catch-body ...))
(call-with-current-continuation
(lambda (escape)
(dynamic-wind
(lambda ()
(let ((exception
(call-with-current-continuation
(lambda (cc)
(push-catch cc)
#f))))
(if exception
(begin catch-body ... (escape)))))
(lambda ()
(begin body ...))
(lambda () (pop-catch))))))))
將以上程式載入到 Scheme 中後,你就可以在一個地方放置錯誤處理程式碼,並且可以透過呼叫throw過程來跳轉到該位置,該過程的引數可以是任何值,但#f除外。使用引數將有關發生錯誤的資訊傳送給錯誤處理程式碼。
(define (my-/ numerator denominator)
(if (not (and (number? numerator)
(number? denominator)))
(throw "my-/ is for numbers")
(/ numerator denominator)))
(try ((display (my-/ "two" "one"))
(newline))
catch message ((display message)
(newline)))