TSS beglis, box-all, evlis を末尾再帰へ

• vallog: Re:Re: 読んだ「The Seasoned Schemer」

末尾再帰へ書き直してみました。reverse が気になる。末尾再帰かどうか以前に大丈夫なのか？
相変わらず letrec 経由しないと named-let が書けない。

	;; beglis
	(define (beglis es table)
	(cond
	((null? (cdr es))
	(meaning (car es) table))
	(else ((lambda (val)
	(beglis (cdr es) table))
	(meaning (car es) table)))))
	(define (beglis es table)
	(let ((m (meaning (car es) table)))
	(if (null? (cdr es))
	m
	((lambda (val)
	(beglis (cdr es) table)) m))))
	(define (beglis es table)
	(let ((m (meaning (car es) table)))
	(if (null? (cdr es))
	m
	(let ((val m))
	(beglis (cdr es) table)))))
	(define (beglis es table)
	(let ((m (meaning (car es) table))
	(d (cdr es)))
	(if (null? d)
	m
	(beglis d table))))
	;; box-all
	(define (box-all vals)
	(if (null? vals)
	'()
	(cons (box (car vals))
	(box-all (cdr vals)))))
	(define (box-all vals)
	(letrec
	((rec
	(lambda (vals acc)
	(if (null? vals)
	acc
	(rec (cdr vals)
	(cons (box (car vals)) acc))))))
	(rec (reverse vals) '())))
	(define (box-all vals)
	(let loop ((vals (reverse vals))
	(acc '()))
	(if (null? vals)
	acc
	(loop (cdr vals)
	(cons (box (car vals)) acc)))))
	;; evlis
	(define (evlis args table)
	(if (null? args)
	'()
	((lambda (val)
	(cons val
	(evlis (cdr args) table)))
	(meaning (car args) table))))
	(define (evlis args table)
	(if (null? args)
	'()
	(cons (meaning (car args) table)
	(evlis (cdr args) table))))
	(define (evlis args table)
	(letrec
	((rec
	(lambda (args table acc)
	(if (null? args)
	acc
	(rec (cdr args)
	table
	(cons (meaning (car args) table)
	acc))))))
	(rec (reverse args) table '())))
	(define (evlis args table)
	(let loop ((args (reverse args))
	(table table)
	(acc '()))
	(if (null? args)
	acc
	(loop (cdr args) table
	(cons (meaning (car args) table)
	acc)))))

view raw *scratch*.scm hosted with ❤ by GitHub

• vallog: TSS chapter 20 は Lisp on Lisp on Scheme だった・・・

Scheme で作った小さな Lisp 処理系に自身の定義を食わせて、Scheme の上で走る Lisp の上で走る Lisp を動かす、という趣旨だったようです。

Lisp on Lisp on Scheme は、もう良いや。放置。

追記

よく見たら beglis は初めから末尾再帰っぽい。