syntax-rules: dlambda

今日は、Twitter のタイムラインで LET OVER LAMBDA Edition 1.0 の話題が出ていました。
私も読みましたが、詳細はすでに記憶の彼方です。。再読したいところです。

• vallog: 読んだ「LET OVER LAMBDA Edition 1.0」

記憶に残っている dlambda を scheme の syntax-rules で書いてみました。たぶん同じように動くと思います。

• Let Over Lambda - chapter 5 - section 7 - dlambda

マクロを書く前に・・・

;; image
(define count-test
  (let ((count 0))
    (dlambda
     (:reset ()(set! count 0))
     (:inc (n)(inc! count n))
     (:dec (n)(dec! count n))
     (:bound (lo hi)
             (set! count (min hi (max lo count)))))))

;; expand image
(define count-test
  (let ((count 0))
    (lambda (key . args)
      (case key
        ((:reset)(apply (lambda ()
                          (set! count 0)) args))
        ((:inc)(apply (lambda (n)
                        (inc! count n)) args))
        ((:dec)(apply (lambda (n)
                        (dec! count n)) args))
        ((:bound)(apply (lambda (lo hi)
                          (set! count
                                (min hi (max lo count)))) args))
        (else key)))))

(count-test :reset)
;; 0
(count-test :inc 100)
;; 100
(count-test :inc 1)
;; 101
(count-test :inc 2)
;; 102
(count-test :bound -10 10)
;; 10
(count-test :reset)
;; 0
(count-test :inc 1)
;; 1

以下マクロのコード

	;; http://letoverlambda.com/index.cl/guest/chap5.html#sec_7
	(define-syntax dlambda
	(syntax-rules (else)
	((_ (msg1 (darg1 ...) dbody1 ...)(msg2 (darg2 ...) dbody2 ...) ...)
	(lambda (key . args)
	(case key
	((msg1)(apply (lambda (darg1 ...)
	dbody1 ...) args))
	((msg2)(apply (lambda (darg2 ...)
	dbody2 ...) args))
	...
	(else key))
	))))
	(define count-test
	(let ((count 0))
	(dlambda
	(:reset ()(set! count 0))
	(:inc (n)(inc! count n))
	(:dec (n)(dec! count n))
	(:bound (lo hi)
	(set! count (min hi (max lo count)))))))
	(count-test :inc 1)
	;; 1
	(count-test :inc 1)
	;; 2
	(count-test :hoge)
	;; :hoge
	(count-test :dec 1)
	;; 1
	(count-test :dec 1)
	;; 0
	(count-test :dec 100)
	;; -100
	(count-test :bound -10 10)
	;; -10
	(count-test :reset)
	;; 0

view raw dlambda.scm hosted with ❤ by GitHub