syntax-rules: until

これを眺めていて思いつきました。

• vallog: call/cc sum1-n, reverse

名前付けが適切かわかりませんが、思いつかなかったので、label まで繰り返すということで until 。

	(define-syntax until
	(syntax-rules ()
	((_ label ((var init) ...) body ...)
	(let/cc label
	(let ((var init) ...)
	(let ((next (call/cc identity)))
	body ...
	(next next)))))))
	(until return ((n 10)
	(acc 0))
	(if (zero? n)
	(return acc)
	(begin
	(print n)
	(set! acc (* n acc))
	(set! n (- n 1)))))
	;; 10
	;; 9
	;; 8
	;; 7
	;; 6
	;; 5
	;; 4
	;; 3
	;; 2
	;; 1
	;; 0
	(let ((n 10))
	(until break ()
	(if (zero? n)
	(break n)
	(print (* n (set! n (- n 1)))))))
	;; 90
	;; 72
	;; 56
	;; 42
	;; 30
	;; 20
	;; 12
	;; 6
	;; 2
	;; 0
	;; 0
	(define-syntax until
	(syntax-rules ()
	((_ label ((var init) ...) body ...)
	(let/cc label
	(let ((var init) ...)
	(let ((next (call/cc identity)))
	body ...
	(next next)))))
	((_ label body ...)
	(until label () body ...))))
	(let ((n 10))
	(until break
	(if (zero? n)
	(break n)
	(print (* n (set! n (- n 1)))))))
	;; 90
	;; 72
	;; 56
	;; 42
	;; 30
	;; 20
	;; 12
	;; 6
	;; 2
	;; 0
	;; 0
	(until return ((n 10)
	(acc 0))
	(if (zero? n)
	(return acc)
	(begin
	(print n)
	(set! acc (* n acc))
	(set! n (- n 1)))))
	;; 10
	;; 9
	;; 8
	;; 7
	;; 6
	;; 5
	;; 4
	;; 3
	;; 2
	;; 1
	;; 0

view raw until.scm hosted with ❤ by GitHub