Building Little Languages with Macros
by Matthias Felleisen, Robert Bruce Findler, Matthew Flatt, and Shriram Krishnamurthi

Example 1:

(a)
#define swap(x,y) {int tmp=y; y=x; x=tmp;}

(b)
swap(c.red, d->blue)

(c)
{ int tmp=d->blue; d->blue=c.red; c.red=tmp; }

(d)
swap(tmp, other)

(e)
{ int tmp=other; other=tmp; tmp=tmp; }

Example 2:

(a)
#define swap(...) ...

(b)
(define-syntax swap (syntax-rules ... ...))

(c)
(define-syntax swap
   (syntax-rules ()
      ((swap a b) (let ((tmp b))
                    (set! b a)
                    (set! a tmp)))))

Example 3:

(a)
(swap x y)

(b)
(let ((tmp1 x))
   (set! y x)
   (set! x tmp1))

(c)
(swap tmp other)

(d)
(let ((tmp1 tmp))
   (set! other tmp)
   (set! tmp tmp1))

(e)
(define (f x)
   (define-syntax swap-with-arg
      (syntax-rules ()
         ((swap-with-arg y) (swap x y))))
   (let ((z 12)
         (x 10))
     ; Swaps z with original x:
     (swap-with-arg z)))

(f) 
(define (f x)
   (let ((z 12)
      (x1 10))
    (swap x z)))

Example 4:

(a)
(define-syntax rotate
   (syntax-rules ()
      ((rotate a) (void)) ; i.e., do nothing
      ((rotate a b c ...) (begin
                            (swap a b)
                            (rotate b c ...)))))

(b)
(begin
   (swap n e)
   (rotate e s w))

(c) 
(begin
   (swap n e)
   (begin
      (swap e s)
      (rotate s w)))

(d)
(begin
   (swap n e)
   (begin
      (swap e s)
      (begin
         (swap s w)
         (void))))

Example 5:

(a)
(define-syntax rotate
   (syntax-rules ()
      ((rotate a c ...)
      (shift-to (c ... a) (a c ...)))))
(define-syntax shift-to
   (syntax-rules ()
      ((shift-to (from0 from ...) (to0 to ...))
      (let ((tmp from0))
         (set! to from) ...
         (set! to0 tmp)) )))

(b)
(shift-to (n e s w) (w n e s))

(c)
(let ((tmp n))
   (set! n e)
   (set! e s)
   (set! s w)
   (set! w n))

Example 6:

(define-syntax clock
   (syntax-id-rules (set!)
      ((set! clock e) (set-time! e))
      ((clock a ...) (error "clock is not a function"))
      (clock (get-time))))

Example 7:

(a)
(define-get/set-var clock get-time set-time!)
(define-get/set-var pwd getcwd setcwd)
(define-get/set-var user getuid setuid)
 ...

(b)
(define-syntax define-get/set-var
   (syntax-rules ()
      ((define-get/set-var id get set!)
      (define-syntax id
         (syntax-id-rules (set!)
         ((set! id e) (set! e))
         ((id a (... ...)) ((get) a (... ...)))
         (id (get))))                          )))

Example 8:

(a)
(define-cbr (f a b)
   (swap a b))

; Produces 2:
(let ((x 1) (y 2))
   (f x y)
   x)

(b)
(define (do-f get1 get2 set1 set2)
   (define-get/set-var a get1 set1)
   (define-get/set-var b get2 set2)
   (swap a b))

(c)
(let ((x 1) (y 2))
   (f x y)
  x)

(d)
(let ((x 1) (y 2))
   (do-f (lambda () x)
      (lambda () y)
      (lambda (v) (set! x v))
      (lambda (v) (set! y v)))
   x)

(e)
(begin
   (define (do-f get1 get2 set1 set2)
      (define-get/set-var a get1 set1)
      (define-get/set-var b get2 set2)
      (swap a b))
   (define-syntax f
      (syntax-rules ()
        ((f actual ...)
         (do-f (lambda () actual)
            ...
            (lambda (v)
               (set! actual v))
            ...)                  ))))

Example 9:

(a)
(define-syntax define-cbr
   (syntax-rules ()
      ((_ (id arg ...) body)
        (begin
        ???
          (define-syntax id
             (syntax-rules ()
               ((id actual (... ...))
                 (do-f (lambda () actual)
                       (... ...)
                       (lambda (v)
                          (set! actual v))
                       (... ...))         )))))))

(b)
(define (do-f get set)
   (define-get/set-var arg get set)
   body)

Example 10:

(a)
(define-cbr-as-cbv do-f (arg ...)
   () body)

(b)
(define-cbr (f a b)
   (swap a b))

(c)
(begin
   (define-cbr-as-cbv do-f (a b)
      () (swap a b))
   ....)


(d)
(begin
   (define-cbr-as-cbv do-f ()
      ((a get1 set1) (b get2 set2)) (swap a b))
   ....)

Example 11:

(define-syntax define-cbr-as-cbv
   (syntax-rules ()
      ; The first case is for generating one get and set
      ((define-cbr-as-cbv do-f (arg0 arg ...)
         (gens ...) body)
      (define-cbr-as-cbv do-f (arg ...)
         (gens ... (arg0 get set)) body))
      ; The second case finishes the expansion
      ((define-cbr-as-cbv do-f ()
         ((arg get set) ...) body)
      (define (do-f get ... set ...)
         (define-get/set-var arg get set) ...
         body)                                )))






1


