;;; File: ir-macros.scm
;;;; Author: Juergen Lorenz
;;;; ju (at) jugilo (dot) de
;;;; Date: Jun 20, 2011
;;;;       Jun 22, 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 *
(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 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
;ir-macro-transformer. 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 transformers.

;Moreover, ir-macro-rules should expand into a (lambda (form insert
;compare?) ...) so that all symbols except sym ... are renamed
;transparently in the background. Since the form and insert arguments
;will be consumed by match and ir-macro-transformer respectively, the
;resulting transformers xpr0, xpr1, ... will be functions of the
;remaining argument compare?.

;Note that the list (sym ...) is empty in most cases (like the
;identifiers in syntax-rules), in particular for all hygienic macros.
;The 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 ; ok
;    (ir-macro-rules ()
;      ((_)
;       (lambda (compare?) #f))
;      ((_ arg . args)
;       (lambda (compare?)
;         `(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)
;     (lambda (compare?)
;       `(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

;;; (ir-macro-rules (sym ...) (pat0 proc0) (pat1 proc1) ...)
;;; --------------------------------------------------------
;;; where proc0, proc1, ... are procedures of one argument, a compare?
;;; procedure.
;;; Checks the macro's use against a series of patterns, pat0, pat1 ...
;;; and returns a syntax-transformer, i.e. a three argument lambda
;;; expression with body of the matching proc0, proc1, ...
;;; This macro will mostly be imported with import-for-syntax
(define-syntax ir-macro-rules
  (syntax-rules ()
    ((_ (sym ...) (pat0 proc0) (pat1 proc1) ...)
     (ir-macro-transformer
       (lambda (form inject compare?)
         (let ((sym (inject 'sym)) ...)
           (match form
             (pat0 (proc0 compare?))
             (pat1 (proc1 compare?))
             ...)))))))

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

;With implicit renaming 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 compare? sym .... This time, my-or would look like this
;
;  (ir-macro-define (my-or . args)
;    (lambda (compare?)
;      (if (null? args)
;        #f
;        (let ((tmp (car args)))
;          `(if ,tmp ,tmp (my-or ,@(cdr args)))))))
;
;Note that except the lambda line this is exactly the form of the old
;define-macro of old chicken and other Scheme implementations.

;;; (ir-macro-define code proc)
;;; ---------------------------
;;; where code is the complete macro-code (name . args), i.e. the pattern
;;; of a macro call, and proc is a macro-transformer, now a literal
;;; lambda-expression with parameters compare? sym ....
;;; Returns a low-level define-syntax expression of the form
;;; (define-syntax name (lambda (form inject compare?) ...)) by means of
;;; ir-macro-rules.
(define-syntax ir-macro-define
  (syntax-rules (lambda)
    ((_ (name . args) (lambda (compare? . syms) xpr . xprs))
     (define-syntax name
       (ir-macro-rules syms
         ((_ . args)
          (lambda (compare?)
            ((lambda syms xpr . xprs) . syms))))))))

;;; (macro-define code proc)
;;; ------------------------
;;; alias of ir-macro-define
(define-syntax macro-define
  (syntax-rules ()
    ((_ code proc) (ir-macro-define code proc))))

;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) (lambda (compare?)  n))
;      ((g n) (lambda (compare?) `(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) (lambda (compare?)  n))
;      ((g n) (lambda (compare?) `(f ,n)))
;      )
;      (display (list (f 1) (g 1))) (newline)))
;
;returns (1 1).
;
;;; (ir-macro-let ((code proc) ...) . body)
;;; ------------------------------------
;;; where code and proc are as in ir-macro-define. This is
;;; a local version of ir-macro-define, allowing a list of
;;; (code proc) lists to be processed in body in parallel.

(define-syntax ir-macro-let
  (syntax-rules (lambda)
    ((_ (
       ((name0 . args0)
        (lambda (compare? . syms0) xpr0 . xprs0))
       ...
       )
       xpr . xprs)
     (let-syntax (
       (name0
         (ir-macro-rules syms0
           ((_ . args0)
            (lambda (compare?)
              ((lambda syms0 xpr0 . xprs0) . syms0)))))
       ...
       ) xpr . xprs))))

;;; (macro-let ((code proc) ...) . body)
;;; ------------------------------------
;;; alias of ir-macro-let
(define-syntax macro-let
  (syntax-rules ()
    ((_ (pair ...) . body) (ir-macro-let (pair ...) . body))))

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

(define-syntax ir-macro-letrec
  (syntax-rules (lambda)
    ((_ (
       ((name0 . args0)
        (lambda (compare? . syms0) xpr0 . xprs0))
       ...
       )
       xpr . xprs)
     (letrec-syntax (
       (name0
         (ir-macro-rules syms0
           ((_ . args0)
            (lambda (compare?)
              ((lambda syms0 xpr0 . xprs0) . syms0)))))
       ...
       ) xpr . xprs))))

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

) ; module ir-macros