TSS leftmost, let/cc, named-let

let のこんな使い方は驚きました。begin とか progn と同等と考えて良さそうですね。
(let () a b . . .)

• vallog: (begin a b ...)と(let () a b ...)は同じじゃない

コードの方↓は、なんともゴチャゴチャしてしている。

ところで明日は 9LISP。

	; letcc leftmost
	; The Seasoned Schemer
	(define leftmost
	(lambda (l)
	(let/cc skip
	(lm l skip))))
	(define lm
	(lambda (l out)
	(cond
	((null? l)(quote ()))
	((atom? (car l))(out (car l)))
	(else (let ()
	(lm (car l) out)
	(lm (cdr l) out))))))
	(leftmost '(((a) b (c))))
	; -> a
	; again
	(define leftmost
	(letrec
	((lm (lambda (l out)
	(cond
	((null? l)(quote ()))
	((atom? (car l))
	(out (car l)))
	(else
	(let ()
	(lm (car l) out)
	(lm (cdr l) out)))))))
	(lambda (l)
	(let/cc skip
	(lm l skip)))))
	(leftmost '(((a) b (c))))
	; again
	(define leftmost
	(lambda (l)
	(letrec
	((lm (lambda (l out)
	(cond
	((null? l)(quote ()))
	((atom? (car l))
	(out (car l)))
	(else
	(let ()
	(lm (car l) out)
	(lm (cdr l) out)))))))
	(let/cc skip
	(lm l skip)))))
	(leftmost '(((a) b (c))))
	; again
	(define leftmost
	(lambda (l)
	(let/cc skip
	(letrec
	((lm (lambda (l out)
	(cond
	((null? l)(quote ()))
	((atom? (car l))
	(out (car l)))
	(else (let ()
	(lm (car l) out)
	(lm (cdr l) out)))))))
	(lm l skip)))))
	(leftmost '(((a) b (c))))
	; again
	(define leftmost
	(lambda (l)
	(let/cc skip
	(letrec
	((lm (lambda (l)
	(cond
	((null? l)(quote ()))
	((atom? (car l))
	(skip (car l)))
	(else (let ()
	(lm (car l))
	(lm (cdr l))))))))
	(lm l)))))
	(leftmost '(((a) b (c))))
	(define (leftmost l)
	(let/cc skip
	(letrec
	((lm (lambda (l)
	(if (null? l)
	'()
	(let ((kar (car l)))
	(if (list? kar)
	(let ()
	(lm kar)
	(lm (cdr l)))
	(skip kar)))))))
	(lm l))))
	(leftmost '(((a) b (c))))
	; named let
	(define (leftmost l)
	(let/cc skip
	(let loop ((l l))
	(if (null? l)
	'()
	(let ((kar (car l)))
	(if (list? kar)
	(let () ; begin
	(loop kar)
	(loop (cdr l)))
	(skip kar)))))))
	(leftmost '(((a) b (c))))
	(leftmost '((() (a) b (c)))

view raw leftmost-skip.scm hosted with ❤ by GitHub