; Author: Juergen Lorenz
; ju (at) jugilo (dot) de
;
; Last update: Aug 29, 2011
;
; Copyright (c) 2011, Juergen Lorenz
; All rights reserved.
; 
; Redistribution and use in source and binary forms, with or without
; modification, are permitted provided that the following conditions are
; met:
; 
; Redistributions of source code must retain the above copyright
; notice, this list of conditions and the following disclaimer.
; 
; Redistributions in binary form must reproduce the above copyright
; notice, this list of conditions and the following disclaimer in the
; documentation and/or other materials provided with the distribution.
; 
; Neither the name of the author nor the names of its contributors may be
; used to endorse or promote products derived from this software without
; specific prior written permission. 
; 
; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
; 

;This module does for explicit-renaming macros the same as the module
;ir-macros for implicit-renaming macros.
;
(require 'contracts)

(module er-macros
  ;; er-macro-rules is passed through from contract-helpers
  (er-macros er-macro-rules er-macro-define er-macro-let er-macro-letrec)
(import scheme contracts)
(import-for-syntax (only contract-helpers er-macro-rules))

;;; initialize documentation
(doclist
  '((er-macro-rules
      "explicit-renaming version of syntax-rules"
      (er-macro-rules (%sym ...) (pat0 xpr0) (pat1 xpr1) ...)
      "where %sym ... are renamed versions of symbols sym ...,
xpr0 ... evaluate to templates, which are usually backquoted expressions
and the one corresponding to the first matching pattern is evaluated")))

;As an application of the er-macro-rules macro from the contracts module
;we'll implement some further macros which will make the writing of
;implicit-renaming macros easier. For example, er-macro-define will have
;almost the same syntax as define-macro from earlier Chicken
;implementations, where it not for the additional with-renamed line, so
;that an implementation of an or macro would look as follows:

;  (er-macro-define (my-or . args)
;    (with-renamed (%if %my-or)
;      (if (null? args)
;        #f
;        (let ((tmp (car args)))
;          `(,%if ,tmp ,tmp (,%my-or ,@(cdr args)))))))

;;; (er-macro-define code (with-renamed (sym% ...) . body))
;;; -------------------------------------------------------
;;; where code is the complete macro-code (name . args), i.e. the pattern
;;; of a macro call, %sym ... are aliases of sym ... and body a list of
;;; expressions xpr . xprs which produce the macro-expansion.

(define-syntax-with-contract er-macro-define
  "explicit renaming variant of define-macro"
  (syntax-rules (with-renamed)
    ((_ (name . args) (with-renamed syms xpr . xprs))
     (define-syntax name
       (er-macro-rules syms
         ((_ . args) (begin xpr . xprs)))))))

;er-macro-let and er-macro-letrec are local versions of er-macro-define, where
;the local macros are evaluated in parallel or recursively. For example

;  (let ((f (lambda (n) (+ n 10))))
;    (er-macro-let (
;      ((f n) n)
;      ((g n) `(,%f ,n))
;      )
;      (display (list (f 1) (g 1))) (newline)))
;
;will result in (1 11) while  
;
;  (let ((f (lambda (n) (+ n 10))))
;    (er-macro-letrec (
;      ((f n) n)
;      ((g n) `(,%f ,n))
;      )
;      (display (list (f 1) (g 1))) (newline)))
;
;returns (1 1).

;;; (er-macro-let ((code0 (with-renamed (%sym0 ...) . body0)) ...)
;;;   . body)
;;; --------------------------------------------------------------
;;; where code0, %sym0 and body0 are as in er-macro-define. This is
;;; a local version of er-macro-define, allowing a list of
;;; (code with-xpr) lists to be processed in body in parallel.
(define-syntax-with-contract er-macro-let
  "local version of er-macro-define, declarations evaluated in parallel"
  (syntax-rules (with-renamed)
    ((_ (
       ((name0 . args0) (with-renamed syms0 xpr0 . xprs0))
       ...
       )
       xpr . xprs)
     (let-syntax (
       (name0
         (er-macro-rules syms0
           ((_ . args0) (begin xpr0 . xprs0))))
       ...
       ) xpr . xprs))))


;;; (er-macro-letrec ((code0 (with-renamed (%sym0 ...) . body0) ...)
;;; . body)
;;; ----------------------------------------------------------------
;;; where code0, %sym0 and body0 are as in er-macro-define. This is
;;; a local version of er-macro-define, allowing a list of
;;; (code with-xpr) lists to be processed in body recursively.
(define-syntax-with-contract er-macro-letrec
  "local version of er-macro-define, declarations evaluated recursively"
  (syntax-rules (with-renamed)
    ((_ (
       ((name0 . args0) (with-renamed syms0 xpr0 . xprs0))
       ...
       )
       xpr . xprs)
     (letrec-syntax (
       (name0
         (er-macro-rules syms0
           ((_ . args0) (begin xpr0 . xprs0))))
       ...
       ) xpr . xprs))))

;;; documentation in dispatcher
(define er-macros (doclist->dispatcher (doclist)))

) ; module er-macros