syntax-rules: define-memoize

以前、On Lisp に出てくるメモ化関数を試しに書いてみました。

• vallog: On Lisp memoize

追記で書きなおした方のものでも、再帰先の分まではメモってくれない、ということで良いと思います。そこで、マクロならなんとかなるかも知れない、と思って実験的に書いてみました。

こういうのはありなのか、これでちゃんと動くのか、よくわかりません。。
(let ((val (begin body ...))) ・・・) とか、これどうなんでしょう。

	;; memoize
	(define-syntax define-memoize
	(syntax-rules ()
	((_ (name arg) body ...)
	(define name
	(let ((cache (make-hash-table 'equal?)))
	(lambda (arg)
	(let ((val (hash-table-get cache arg #f)))
	(if val
	val
	(let ((val (begin body ...)))
	(hash-table-put! cache arg val)
	val)))))))))
	(define-memoize (fib n)
	(if (< n 2)
	1
	(+ (fib (- n 1))
	(fib (- n 2)))))
	;(time (fib 35))
	; real 0.000
	; user 0.000
	; sys 0.000
	14930352
	;(time (fib 2000))
	; real 0.031
	; user 0.016
	; sys 0.015
	6835702259575806647045396549170580107055408029365524565407553367798082454408054014954534318953113802726603726769523447478238192192714526677939943338306101405105414819705664090901813637296453767095528104868264704914433529355579148731044685634135487735897954629842516947101494253575869699893400976539545740214819819151952085089538422954565146720383752121972115725761141759114990448978941370030912401573418221496592822626

view raw memoize-3.scm hosted with ❤ by GitHub

で、上記の単一引数のものが、なんとなく動いてるようなので、可変長引数に対応させてみようとしたところ行き詰まりました。

	(define-syntax define-memoize
	(syntax-rules ()
	((_ (name . args) body ...)
	(define name
	(let ((cache (make-hash-table 'equal?)))
	(lambda args
	(let ((val (hash-table-get cache args #f)))
	(if val
	val
	(let ((val (begin body ...)))
	(hash-table-put! cache args val)
	val)))))))))
	(define-memoize (fib n)
	(if (< n 2)
	1
	(+ (fib (- n 1))
	(fib (- n 2)))))
	(fib 5)
	;; *** ERROR: invalid application: (5)

view raw memoize-4-buggy.scm hosted with ❤ by GitHub

デバッグしてみるわけです。

• vallog: Scheme マクロのデバッグ4種

	(define-syntax define-memoize
	(syntax-rules ()
	((_ (name . args) body ...)
	(define name
	(let ((cache (make-hash-table 'equal?)))
	(lambda args
	'(let ((val (hash-table-get cache args #f)))
	(if val
	val
	(let ((val (begin body ...)))
	(hash-table-put! cache args val)
	val)))))))))
	(let ((val (hash-table-get cache #0=(n) #f)))
	(if val
	val
	(let ((val (begin (if (< n 2)
	1
	(+ (fib (- n 1))
	(fib (- n 2)))))))
	(hash-table-put! cache #0# val) val)))

view raw memoize-5-debug.scm hosted with ❤ by GitHub

そうか、#0# が (5) になって、5を関数として実行しようとしている、ということで良さそうです。
これがわかったから解決できたかというと、できていません。うーん。

追記

いつものごとく、@cametan_001 さんにアドバイス頂いて、... で書いてみたら取りあえず動くようになりましたー！

	(define-syntax define-memoize
	(syntax-rules ()
	((_ (name arg ...) body ...)
	(define name
	(let ((cache (make-hash-table 'equal?)))
	(lambda (arg ...)
	(let ((val (hash-table-get cache `(,arg ...) #f)))
	(if val
	val
	(let ((val (begin body ...)))
	(hash-table-put! cache `(,arg ...) val)
	val)))))))))
	(define-memoize (fib n)
	(if (< n 2)
	1
	(+ (fib (- n 1))
	(fib (- n 2)))))
	;(time (fib 100))
	; real 0.000
	; user 0.000
	; sys 0.000
	573147844013817084101
	(define-syntax define-memoize
	(syntax-rules ()
	((_ (name arg ...) body ...)
	(define name
	(let ((cache (make-hash-table 'equal?)))
	(lambda (arg ...)
	(let ((al `(,arg ...)))
	(let ((val (hash-table-get cache al #f)))
	(if val
	val
	(let ((val (begin body ...)))
	(hash-table-put! cache al val)
	val))))))))))

view raw memoized-6.scm hosted with ❤ by GitHub

ところで、2引数以上でメモ化すると劇的に早くなる例が思いつきません・・・。眠いので、また明日 or 今度、ということで。