; The usual macros, adapted from Jonathan's Version 2 implementation.

(for-each (lambda (form)
            (macro-expand form))
          '(

;(define-syntax define
;  (syntax-rules ()
;    ((define (name . rest) body +)
;     (%define name (lambda rest body +)))
;    ((define name rhs)
;     (%define name rhs))))

(define-syntax let
  (syntax-rules ()
    ((let ((name val) ...) body body1 ...)
     ((lambda (name ...) body body1 ...) val ...))
    ((let tag ((name val) ...) body body1 ...)
     ((letrec ((tag (lambda (name ...) body body1 ...)))
        tag)
      val ...))))

(define-syntax let*
  (syntax-rules ()
    ((let* () body body1 ...)
     (let () body body1 ...))
    ((let* ((name1 val1) (name val) ...) body body1 ...)
     (let ((name1 val1)) (let* ((name val) ...) body body1 ...)))))

(define-syntax letrec
  (syntax-rules ()
    ((letrec ((name val) ...) body body2 ...)
     (let ((name '*) ...)
       (set! name val)
       ...
       body body2 ...))))

(define-syntax and
  (syntax-rules ()
    ((and) #t)
    ((and e) e)
    ((and e1 e2 e3 ...) (if e1 (and e2 e3 ...) #f))))

(define-syntax or
  (syntax-rules ()
    ((or) #f)
    ((or e) e)
    ((or e1 e2 e3 ...) (let ((temp e1))
                         (if temp temp (or e2 e3 ...))))))

(define-syntax cond
  (syntax-rules (else =>)
    ((cond (else result result2 ...)) (begin result result2 ...))

    ((cond (test => result))
      (let ((temp test))
           (if temp (result temp))))

    ((cond (test)) test)

    ((cond (test result result2 ...)) (if test (begin result result2 ...)))

    ((cond (test result) clause clause2 ...)
      (let ((temp test))
           (if temp (result temp) (cond clause clause2 ...))))

    ((cond (test) clause clause2 ...)
      (or test (cond clause clause2 ...)))

    ((cond (test result result2 ...)
           clause clause2 ...)
      (if test
             (begin result result2 ...)
             (cond clause clause2 ...)))))

(define-syntax do
  (syntax-rules ()
    ((do ((name init step) ...)
         clause
       body ...)
     (letrec ((loop (lambda (name ...)
                         (cond clause
                               (else
                                (begin body ...)
                                (loop step ...))))))
          (loop init ...)))))

(define-syntax delay
  (syntax-rules ()
    ((delay e) (make-promise (lambda () e)))))

(define-syntax case
  (syntax-rules (else)
    ((case e1 (else body body2 ...))
     (begin e1 body body2 ...))
    ((case e1 (z body body2 ...))
     (if (memv e1 'z) (begin body body2 ...)))
    ((case e1 (z body body2 ...) clause clause2 ...)
     (let ((temp e1))
       (if (memv temp 'z)
           (begin body body2 ...)
           (case temp clause clause2 ...))))))

;; This one doesn't really work.

;(define-syntax quasiquote
;  (syntax-rules (unquote unquote-splicing)
;    (`(,@exp . template) (append exp `template))
;    (`(template1 . template2) (cons `template1 `template2))
;    (`,exp exp)
;    (`thing 'thing)))

(define-syntax let*-syntax
  (syntax-rules ()
    ((let*-syntax () body)
     (let-syntax () body))
    ((let*-syntax ((name1 val1) (name val) ...) body)
     (let-syntax ((name1 val1)) (let*-syntax ((name val) ...) body)))))


            ))

;;			    --- E O F ---			;;