;; Transliterated from "Revised^4 Report on the Algorithmic Language Scheme",
;; W. Clinger and J Rees, editors.

(define-syntax LET
   (syntax-rules ()
      ((let ( (<var1> <init1>) ...) <exp1> <exp2> ...)
       ;=>
       ((lambda (<var1> ...) <exp1> <exp2> ...) <init1> ...)
      )
      ((let <name> ( (<var1> <init1>) ...) <exp1> <exp2> ...)
       ;=>
       ((letrec ( (<name>
                   (lambda (<var1> ...) <exp1> <exp2> ...))
                )
             <name>)
        <init1> ...)
      )
)  )

(define-syntax LET*
   (syntax-rules ()
      ((let* ( (var1> <init1>) (<var2> <init2>) ... )
               <exp1> <exp2> ...)
       ;=>
       (let ( (<var1> <init1>) )
          (let* ( (<var2> <init2>) ... )
	       <exp1> <exp2> ...))
      )
      ((let* () <exp1> <exp2> ...)
       ;=>
       (lambda () <exp1> <exp2> ...)
      )
)  )

(define-syntax LETREC
   (syntax-rules ()
      ((letrec ( (<var1> <init1>) (<var2> <init2>) ... )
               <exp1> <exp2> ...)
       ;=>
       (let ( (<var1> #f) ... )
          (let ( (temp1 <init1>) ... )
	     (set! <var1> temp1)
	     ...
	     <exp1> <exp2> ...
       )  )
      )
)  )

(define-syntax OR
   (syntax-rules ()
      ((or)
       ;=>
       #f
      )
      ((or <test>)
       ;=>
       <test>
      )
      ((or <test1> <test2> ...)
       ;=>
       (let ( (temp <test1>) )
	 (if temp temp (or <test2> ...))
      ) )
)  )

(define-syntax AND
   (syntax-rules ()
      ((and <test1> <test2> ...) 
       ;=>
       (let ( (x <test1>)
              (thunk (lambda () (and <test2> ...)))
            )
	  (if x (thunk) x)
      ))	  
      ((and <test>)
       ;=>
       <test>
      )
      ((and)
       ;=>
       #t
      )
)   )

(define-syntax COND
   (syntax-rules ( else => )
      ((cond) 
       ;=>
       #f
      )
      ((cond (else <exp1> <exp2> ...))
       ;=>
       (begin <exp1> <exp2> ...)
      )
      ((cond (<test> => <recipient>) <clause> ...)
       ;=>
       (let ( (test-result <test>) 
	      (thunk2 (lambda () <recipient>))
	      (thunk3 (lambda () (cond <clause> ...)))
            )
         (if test-result
	     ((thunk2) test-result)
	     (thunk3))
      ))
      ((cond (<test>) <clause> ...)
       ;=>
       (or <test> (cond <clause> ...))
      )
      ((cond (<test> <exp1> <exp2> ...) <clause> ...)
       ;=>
       (if <test>
           (begin <exp1> <exp2> ...) 
           (cond <clause> ...))
      )
) )

(define-syntax CASE
   (syntax-rules (else)
      ((case <key>
        ((<datum1> ...) <exp1> <exp2> ...) 
	...
	(else <f1> <f2> ...)
       )
       ;=>
       (let ( (key <key>)
	      (thunk1 (lambda () <exp1> <exp2> ...))
	      ...
	      (else-thunk (lambda () <f1> <f2> ...))
	    )
	  (cond ((memv key '(<datum1> ...)) (thunk1))
	        ...
		(else (else-thunk))
       )  )
      )
      ((case <key>
        ((<datum1> ...) <exp1> <exp2> ...) 
	 ...
       )
       ;=>
       (let ( (key <key>)
	      (thunk1 (lambda () <exp1> <exp2> ...))
	      ...
	    )
	  (cond ((memv key '(<datum1> ...)) (thunk1))
	        ...)
         )
      )
)  )


;;			--- E O F ---