;;; 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 *
(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 (inject compare? 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.
;The additional symbols, inject and compare? are used only 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 ; ok
;    (ir-macro-rules (inject compare?)
;      ((_) #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 (inject compare? 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

;;; (ir-macro-rules (inject compare? 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
(define-syntax ir-macro-rules
  (syntax-rules ()
    ((_ (inject compare? sym ...) (pat0 xpr0) (pat1 xpr1) ...)
     (ir-macro-transformer
       (lambda (form inject compare?)
         (let ((sym (inject 'sym)) ...)
           (match form
             (pat0 xpr0)
             (pat1 xpr1)
             ...)))))))

;;; (macro-rules (inject compare? sym ...) (pat0 xpr0) (pat1 xpr1) ...)
;;; -----------------------------------------------------
;;; alias of ir-macro-rules
(define-syntax macro-rules
  (syntax-rules ()
    ((_ (inject compare? sym ...) (pat0 xpr0) (pat1 xpr1) ...)
     (ir-macro-rules (inject compare? 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)
;    (lambda (inject 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 inject compare? sym ....
;;; Returns a low-level define-syntax expression of the form
;;; (define-syntax name (ir-macro-transformer (lambda (form inject
;;; compare?) ...))) by means of ir-macro-rules.
(define-syntax ir-macro-define
  (syntax-rules (lambda)
    ((_ (name . args) (lambda (inject compare? . syms) xpr . xprs))
     (define-syntax name
       (ir-macro-rules (inject compare? . syms)
         ((_ . args)
          ((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 (inject compare?)  n))
;      ((g n) (lambda (inject 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 (inject compare?)  n))
;      ((g n) (lambda (inject 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 (inject compare? . syms0) xpr0 . xprs0))
       ...
       )
       xpr . xprs)
     (let-syntax (
       (name0
         (ir-macro-rules (inject compare? . syms0)
           ((_ . args0)
            ((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 (inject compare? . syms0) xpr0 . xprs0))
       ...
       )
       xpr . xprs)
     (letrec-syntax (
       (name0
         (ir-macro-rules (inject compare? . syms0)
           ((_ . args0)
            ((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