; Author: Juergen Lorenz
; ju (at) jugilo (dot) de
;
; Last update: Aug 28, 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 is now obsolete, use low-level-macros instead
;=========================================================

(require 'contracts)

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

;;; initialize documentation
(doclist
  '((ir-macro-rules
      "implicit-renaming version of syntax-rules"
      (ir-macro-rules (sym ...) (pat0 xpr0) (pat1 xpr1) ...)
      "where sym ... are injected symbols, 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 ir-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, ir-macro-define will have
;the same syntax as define-macro from earlier Chicken implementations,
;so that an implementation of an or macro would look as follows:

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

;;; (ir-macro-define code xpr . xprs) 
;;; ---------------------------------
;;; where code is the complete macro-code (name . args), i.e. the
;;; pattern of a macro call, and xpr . xprs expressions which generate
;;; the macro-expansion. In case the body xpr . xprs is of the form
;;; (with (sym ...) xpr . xprs) the local namespace is polluted by 
;;; unhygienic injected symbols sym ...
(define-syntax-with-contract ir-macro-define
  "implicit reanaming variant of syntax-rules"
  (syntax-rules (with-injected)
    ((_ (name . args) (with-injected (sym ...) xpr . xprs))
    ;; sym ... are unhygienic injected symbols
     (define-syntax name
       (ir-macro-rules (sym ...)
         ((_ . args) (begin xpr . xprs)))))
    ;; hygienic
    ((_ (name . args) xpr . xprs)
     (ir-macro-define (name . args) (with-injected () xpr . xprs)))))

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

;  (let ((f (lambda (n) (+ n 10))))
;    (ir-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))))
;    (ir-macro-letrec (
;      ((f n)  n)
;      ((g n) `(f ,n))
;      )
;      (display (list (f 1) (g 1))) (newline)))
;
;returns (1 1).
;
;;; (helper op pairs . body)
;;; ------------------------
;;; Since ir-macro-let and ir-macro-letrec have the same code except
;;; that the former evaluates to a let-syntax and the latter to a
;;; letrec-syntax, this helper starts with the op argument, which is to
;;; be replaced by either let-syntax or letrec-syntax.
(define-syntax helper
  (ir-macro-transformer
    (lambda (form inject compare?)
      (let ((op (cadr form)) (pairs (caddr form)) (body (cdddr form)))
        (let (
          (pats (map car pairs))
          (bodies (map cdr pairs))
          (with? (lambda (lst)
                 (and (null? (cdr lst))
                      (list? (car lst))
                      (compare? (caar lst) 'with-injected))))
          )
          (let (
            (syms (map (lambda (b)
                         (if (with? b)
                           (cadar b)
                           '()))
                       bodies))
            (xprs (map (lambda (b)
                         (if (with? b)
                           (cddar b)
                           b))
                       bodies))
            )
            `(,op (
               ,@(map (lambda (p s x)
                        `(,(car p)
                           (ir-macro-rules ,s ((_ ,@(cdr p))
                             (begin ,@x)))))
                      pats syms xprs)
               )
               ,@body)))))))

;;; (ir-macro-let ((code xpr . xprs) ...) . body)
;;; ---------------------------------------------
;;; where code and xpr . xprs are as in ir-macro-define. This is
;;; a local version of ir-macro-define, allowing a list of
;;; (code xpr . xprs) lists to be processed in body in parallel.
(define-syntax-with-contract ir-macro-let
  "implicit-renaming macro-let, pairing macro-code with macro-body
in the declaration part"
  (syntax-rules ()
    ((_ ((code xpr . xprs) ...) . body)
     (helper let-syntax ((code xpr . xprs) ...) . body))))

;;; (ir-macro-letrec ((code xpr . xprs) ...) . body)
;;; ------------------------------------------------
;;; where code and xpr . xprs are as in ir-macro-define.
;;; Local version of ir-macro-define, allowing a list of
;;; (code xpr . xprs) lists to be processed in body recursively.

(define-syntax-with-contract ir-macro-letrec
  "implicit-renaming macro-letrec, pairing macro-code with macro-body
in the declaration part"
  (syntax-rules ()
    ((_ ((code xpr . xprs) ...) . body)
     (helper letrec-syntax ((code xpr . xprs) ...) . body))))

;;; save documentation
(define ir-macros (doclist->dispatcher (doclist)))

) ; module ir-macros