Skip to content

Instantly share code, notes, and snippets.

@athos

athos/my-do.scm

Created May 24, 2010
Embed
What would you like to do?
destructive version of `do' macro
;; destructive version of `do' macro
;; (my-do ([x 1 y] [y 1 (+ x y)])
;; ((> x 30) #f)
;; (print x))
;;
;; is expanded as below:
;;
;; (let ([x 1] [y 1])
;; (let loop ()
;; (if (> x 30)
;; (begin #f)
;; (begin
;; (print x)
;; (let ([temp0 y] [temp1 (+ x y)])
;; (set! x temp0)
;; (set! y temp1)
;; (loop))))))
(define-syntax my-do
(syntax-rules ()
[(_ ([var init step] ...) (pred finished ...) body ...)
(let ([var init] ...)
(let loop ()
(if pred
(begin finished ...)
(begin
body ...
(my-do-aux loop ((var step) ...) ())))))]))
;; (my-do-aux loop ([x y] [y (+ x y)]) ())
;; => (let ([temp0 y] [temp1 (+ x y)])
;; (set! x temp0)
;; (set! y temp1)
;; (loop))
;; , where temp0 and temp1 are auto-generated symbols
(define-syntax my-do-aux
(syntax-rules ()
[(_ loop () ((var temp step) ...))
(let [(temp step) ...]
(set! var temp) ...
(loop))]
[(_ loop ((var step) rest ...) (acc ...))
(my-do-aux loop (rest ...) (acc ... (var temp step)))]))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.