define-syntax: upto, downto

正確には知りませんが、 ruby にこんなのありますよね。

	;; upto, downto
	;; (downto (i 99 0)
	;; (print i))
	;; (downto (i 99 0 1)
	;; (print i))
	;; (upto (i 0 99)
	;; (print i))
	;; (upto (i 0 99 1)
	;; (print i))
	(define-syntax downto
	(syntax-rules ()
	((_ (var init end step) body ...)
	(do ((var init (- var step)))
	((< var end))
	body ...))
	((_ (var init end) body ...)
	(downto (var init end 1) body ...))))
	;; test
	(downto (i 99 0)
	(print i))
	(downto (i 99 0 2)
	(print i))
	(define-syntax upto
	(syntax-rules ()
	((_ (var init end step) body ...)
	(do ((var init (+ var step)))
	((> var end))
	body ...))
	((_ (var init end) body ...)
	(upto (var init end 1) body ...))))
	;; test
	(upto (i 0 99)
	(print i))
	(upto (i 0 99 3)
	(print i))
	(define-syntax for
	(syntax-rules ()
	((_ ((var init) stop-exp upd-exp) body ...)
	(do ((var init upd-exp))
	((not stop-exp))
	body ...))))
	(define-syntax downto
	(syntax-rules ()
	((_ (var init end step) body ...)
	(for ((var init)(<= end var)(- var step)) body ...))
	((_ (var init end) body ...)
	(downto (var init end 1) body ...))))
	;; test
	(let ((acc '()))
	(downto (i 99 0 3)
	(set! acc (append acc (list i))))
	acc)
	(define-syntax upto
	(syntax-rules ()
	((_ (var init end step) body ...)
	(for ((var init)(<= var end)(+ var step)) body ...))
	((_ (var init end) body ...)
	(upto (var init end 1) body ...))))
	;; test
	(let ((acc '()))
	(upto (i 0 99 3)
	(set! acc (append acc (list i))))
	acc)

view raw downto,upto.scm hosted with ❤ by GitHub