;;;; File: er-macros.scm
;;;; Author: Juergen Lorenz
;;;; ju (at) jugilo (dot) de
;;;; Date: Oct 24, 2010
;;;;       Oct 28, 2010
;;;;       Nov 02, 2010
;;;;       Nov 04, 2010
;;;;       Nov 09, 2010
;;;;       Nov 26, 2010
;;;;       Nov 28, 2010
;;;;       Jan 19, 2011
;;;;       Jan 27, 2011
;;;;       Feb 02, 2011
;;;;       Feb 16, 2011
;;;;       Feb 18, 2011
;;;;       Jun 20, 2011
;;;;       Jun 22, 2011
;;;;       Jun 26, 2011
;;;;       Jul 13, 2011
;;;;       Jul 23, 2011
;;;;       Aug 02, 2011
;;;;       Aug 15, 2011
;;;;       Aug 29, 2011


;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