;;; File: ir-macros.scm
;;;; Author: Juergen Lorenz
;;;; ju (at) jugilo (dot) de
;;;; Date: Jun 20, 2011
;;;;       Jun 22, 2011
;;;;       Jul 11, 2011


;This module does to implicit renaming macros, which are new to
;chicken-4.7.0, what the er-macros module did to explicit renaming ones.
;Since this module will be probably used more often then er-macros, all
;symbols with ir- prefix are aliased to symbols without it.
;
(module ir-macros (ir-macro-rules macro-rules ir-macro-define
                    macro-define ir-macro-let macro-let ir-macro-letrec
                    macro-letrec)
(import scheme)
(import-for-syntax (only matchable match))

;As an application of the match macro we'll define a macro,
;ir-macro-rules, that will simplify the implementation of low-level
;macros considerably. Note, that the transformer of such a macro is an
;er-macro-transformer expression, wrapping a routine of three
;parameters, usually called form, rename, compare?, and that within that
;routine form has to be destructured by hand, and the symbols have to be
;renamed by hand as well. In our enhancement, we want both to be done
;automatically, destructuring by match and renaming by replacing
;er-macro-transformer by ir-macro-transformer, whose wrapped transformer
;has inject instead of rename as its second argument.  Moreover, we want
;our basic macro to be of the same syntax as syntax-rules, i.e. it
;should look like this
;
;  (ir-macro-rules (sym ...) (pat0 xpr0) (pat1 xpr1) ...)
;
;where (sym ...) is a - mostly empty - list of symbols which are not (!)
;renamed, pat, pat1, ...  represent admissible macro calls and xpr, xpr1
;... corresponding expressions to be evaluated if a pattern matches.
;Additional symbols, inject and compare? are introduced behind the scene
;which can be used in the rare situations, where unrenamed symbols are
;to be exported - this is the duty of inject - or literal symbols are
;used like else and => in the cond macro - this is the duty of compare?.

;Note that the list (sym ...) is empty in most cases (like the
;identifiers in syntax-rules), in particular for all hygienic macros.
;These symbols sym ... are used to break hygiene on purpose.
;
;As a non-trivial example consider the following low-level
;implementation of or. Note the similarity to the high-level one.
;
;  (define-syntax my-or
;    (ir-macro-rules ()
;      ((_) #f)
;      ((_ arg . args)
;       `(if ,arg ,arg (my-or ,@args)))))

;To implement this macro, consider as an example how the body of the
;do-forever macro should be transformed. This macro is unhygienic on
;purpose, it introduces the symbol exit, to be captured in the use
;environment.
;
;  (ir-macro-rules (exit)
;    ((_ . body)
;     `(call/cc (lambda (,exit)
;                 (let loop ()
;                   ,@body
;                   (loop))))))
;
;should transform into
;
;  (ir-macro-transformer
;    (lambda (form inject compare?)
;      (let ((exit (inject 'exit)))
;        (match form
;          ((_ . body)
;           `(call/cc (lambda (,exit)
;                       (let loop ()
;                         ,@body
;                         (loop)))))))))
;
;From this, the implementation of the macro follows easyly, but
;remember, that inject and compare? must be injected behind stage. Hence
;a low-level implementation is necessary.

;;; (ir-macro-rules (sym ...) (pat0 xpr0) (pat1 xpr1) ...)
;;; ------------------------------------------------------
;;; where xpr0, xpr1, ... are expressions
;;; Checks the macro's use against a series of patterns, pat0, pat1 ...
;;; and executes the expression corresponding to the first matching
;;; pattern.
;;; This macro will mostly be imported with import-for-syntax, it is
;;; unhygienic by design, i.e. it pollutes the local namespace with
;;; symbols inject and compare?
(define-syntax ir-macro-rules
  (ir-macro-transformer
    (lambda (form i c?)
      (let ((syms (cadr form)) (pairs (cddr form)))
        (let (
          (pats (map car pairs))
          (xprs (map cadr pairs))
          (inject (i 'inject))
          (compare? (i 'compare?))
          )
          `(ir-macro-transformer
             (lambda (form ,inject ,compare?)
               (let ,(map (lambda (sym) `(,sym (,inject ',sym)))
                           syms)
                 (match form
                   ,@(map (lambda (pat xpr) `(,pat ,xpr))
                          pats xprs))))))))))


;;; (macro-rules (sym ...) (pat0 xpr0) (pat1 xpr1) ...)
;;; ---------------------------------------------------
;;; alias of ir-macro-rules
(define-syntax macro-rules
  (syntax-rules ()
    ((_ (sym ...) (pat0 xpr0) (pat1 xpr1) ...)
     (ir-macro-rules (sym ...) (pat0 xpr0) (pat1 xpr1) ...))))

;With ir-macro-rules under our belt, it's easy to implement three
;macros, ir-macro-define, ir-macro-let and ir-macro-letrec, which
;facilitate the implementation of low-level macros even more: We simply
;match one pattern, the macro code, against a literal lambda-expression
;with arguments inject compare? sym .... This time, my-or would look
;like this
;
;  (ir-macro-define (my-or . args)
;    (if (null? args)
;      #f
;      (let ((tmp (car args)))
;        `(if ,tmp ,tmp (my-or ,@(cdr args))))))
;
;Note that this is exactly the form of the old define-macro of old
;chicken and other Scheme implementations.

;;; (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 ir-macro-define
  (syntax-rules (with)
    ((_ (name . args) (with (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 () xpr . xprs)))))

;;; (macro-define code xpr . xprs)
;;; ------------------------------
;;; alias of ir-macro-define
(define-syntax macro-define
  (syntax-rules ()
    ((_ code xpr . xprs) (ir-macro-define code 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))))
          )
          (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 ir-macro-let
  (syntax-rules ()
    ((_ ((code xpr . xprs) ...) . body)
     (helper let-syntax ((code xpr . xprs) ...) . body))))

;;; (macro-let ((code xpr . xprs) ...) . body)
;;; ------------------------------------------
;;; alias of ir-macro-let
(define-syntax macro-let
  (syntax-rules ()
    ((_ (pair ...) . body) (ir-macro-let (pair ...) . 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 ir-macro-letrec
  (syntax-rules ()
    ((_ ((code xpr . xprs) ...) . body)
     (helper letrec-syntax ((code xpr . xprs) ...) . body))))

;;; (macro-letrec ((code xpr . xprs) ...) . body)
;;; ---------------------------------------------
;;; alias of ir-macro-letrec
(define-syntax macro-letrec
  (syntax-rules ()
    ((_ (pair ...) . body) (ir-macro-letrec (pair ...) . body))))

) ; module ir-macros