< ピアノレッスン4回目 | 忘れた頃に >
2011/05/29
Schemeでgoto (tagbody&go)
なんか聞こえてきた
http://twitter.com/bugyo/statuses/74784105946038272
@bugyo なんで Scheme には goto がないんだ! 何もできない!
のでやってみた。Lispの伝統にしたがい、gotoではなくgoを使う。 そしてラベルのスコープを決めるのにtagbodyを使う。
https://gist.github.com/998142
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(use gauche.sequence) ; for fold2 | |
(define-macro (tagbody . body) | |
(let ([entry (gensym)] ;implicit label for the entry | |
[escape (gensym)]) | |
(receive (segments rest) | |
(fold2 (^(f ss fs) | |
(if (symbol? f) | |
(values (cons (reverse `((,f ,escape) ,@fs)) ss) (list f)) | |
(values ss (cons f fs)))) | |
'() `(,entry) body) | |
(let1 segments (reverse (cons (reverse rest) segments)) | |
;; segments :: (id form ...) | |
`(letrec (,@(map (^s `[,(car s) (^(,escape) | |
(letrec ([go (^l (,escape l))]) | |
,@(cdr s)))]) | |
segments)) | |
(trampoline ,entry)))))) | |
;; trampoline driver | |
(define (trampoline entry) | |
(let/cc finish | |
(let loop ((label entry)) | |
(loop (let/cc e (finish (label e))))))) | |
#| | |
(define (sum n) | |
(let ((s 0) (i 0)) | |
(tagbody | |
(print "start!") | |
loop: | |
(if (= i n) (go end:)) | |
(set! s (+ s i)) | |
(set! i (+ i 1)) | |
(print "s="s" i="i) | |
(go loop:) | |
end: | |
(values s)))) ; use 'values' to avoid 's' from being recognized as a label | |
|# |
思ったより複雑になっちゃった。もうちょっと簡単にできないかな。
最初は、各ラベルをthunkにして、goはそのラベルを呼び出した後に
tagbodyからexitすればいいや、と思ってたんだけど、それだと(go loop:)
でループするような場合にgoが末尾呼び出しにならないので、ループしてるだけで
スタックを消費してしまう。
goを末尾呼び出しにするために、結局トランポリンを使った。
というかlequeさんが2年も前にやっておられたわい。(でもこれだとgoto labelのlabelの呼び出しが末尾呼び出しじゃないので、ループでスタック消費問題があるような…)
Tags: Programming, Lisp, Scheme, Gauche
Post a comment