;;; Examples of using Scheme R5RS macros.
;;; jhbrown@alum.mit.edu

;;; ------------------------------------------------------------
;;; simple macros and demos

(define-syntax cond-set!
  (syntax-rules ()
    ((cond-set! test var value)
     (if test (set! var value)))))

(define x 5)
(cond-set! #f x 7)


(define-syntax unless
  (syntax-rules ()
    ((unless test consequent)
     (if (not test) consequent))))

(unless (< 5 2) (display "math still works"))

(define-syntax dotimes
  (syntax-rules ()
    ((dotimes count body ...)
     (let loop ((counter count))
       (if (> counter 0)
	   (begin
	     body ...
	     (loop (- counter 1))))))))

(dotimes 5 (display "hello, world\n"))

(define counter 0)
(dotimes 5 (set! counter (+ counter 1)))
counter

;;; this will loop forever (that's the point of the demo)
; (let loop ((counter 5))
;   (if (> counter 0)
;       (begin
; 	(set! counter (+ counter 1))
; 	(loop (- counter 1)))))


;;; ------------------------------------------------------------
;;; macros with helpers, keystrings, and staged expansion

(define-syntax reverse-and-quote-list
  (syntax-rules ()
    ((reverse-and-quote-list "helper" () (backw ...))
     '(backw ...))
    ((reverse-and-quote-list "helper" (arg rest ...) (backw ...))
     (reverse-and-quote-list "helper" (rest ...) (arg backw ... )))
    ((reverse-and-quote-list (list ...))
     (reverse-and-quote-list "helper" (list ...)  ()))))

(define-syntax rl-helper
  (syntax-rules ()
    ((rl-helper () (backw ...))
     '(backw ...))
    ((rl-helper (arg rest ...) (backw ...))
     (rl-helper (rest ...) (arg backw ... )))))

(reverse-and-quote-list (1 2 3 4 5))


;;; ------------------------------------------------------------
;;; using "continuation-passing-style" to make composable macros

(define-syntax cps-reverse-list
  (syntax-rules ()
    ((cps-reverse-list "helper" future-keyword
		   (future-args ...) () (backw ...))
     (future-keyword future-args ... (backw ...)))
    ((cps-reverse-list "helper" future-keyword
		   future-args (arg forw ...) (backw ...))
     (cps-reverse-list "helper" future-keyword
		   future-args (forw ...) (arg backw ...)))
    ((cps-reverse-list future-keyword future-args (list ...))
     (cps-reverse-list "helper" future-keyword future-args
		   (list ...) ()))))


(define-syntax quote-result
  (syntax-rules ()
    ((quote-result () rest ...)
     (quote rest ...))))

(define-syntax apply-to-result
  (syntax-rules ()
    ((apply-to-result func list ...)
     (func list ...))))

(define-syntax cps-quote
  (syntax-rules ()
    ((cps-quote future-keyword (future-args ...) stuff ...)
     (future-keyword future-args ... (quote stuff ...)))))
		
(cps-reverse-list cps-quote (apply-to-result ((lambda (x) x))) (1 2 3 4 5))

(cps-quote apply-to-result ((lambda (x) x)) (1 2 3 4 5))


;;; ------------------------------------------------------------
;;; Al Petrofsky's "hygiene-breaking" find-identifier hack.

(define-syntax find-identifier
  (syntax-rules ()
    ((_ ident (x . y) sk fk)
     (find-identifier ident x sk (find-identifier ident y sk fk)))
    ;;; mit scheme doesn't like these
;    ((_ ident #(x ...) sk fk)
;     (find-identifier ident (x ...) sk fk))
    ((_ ident form sk fk)
     (let-syntax
	 ((check
	   (syntax-rules (ident)
	     ((_ ident ident* (s-f . s-args) fk_) (s-f ident* . s-args))
	     ((_ x y sk_ fk_) fk_))))
       (check form form sk fk)))))

(define-syntax dotimes-finish
  (syntax-rules ()
    ((dotimes-finish counter count body ...)
     (let loop ((counter count))
       (if (> counter 0)
           (begin
             body ...
             (loop (- counter 1))))))))

(define-syntax dotimes
  (syntax-rules ()
    ((dotimes count body ...)
     (find-identifier counter (body ...)
		      (dotimes-finish count body ...)
		      (dotimes-finish temp count body ...)))))

;;; this does what you expect...
(dotimes 5 (display counter))
;;; this shows the limitations of this technique.
;;; (Yes, there's a workaround; it's gruesome.  See Petrofsky's
;;;  original posts on the topic.)
(dotimes 5 (dotimes 5 (display counter)))