;;;; 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 07, 2011


;The macros in this module have been renamed for consistency with the
;ir-macros module. The old names are deprecated, but still implemented
;as aliases, so that code relying on them is not broken.
;In fact, the ir-macros module is much more convenient.

(module er-macros *
(import scheme (only chicken gensym assert condition-case))
(import-for-syntax (only matchable match))

;As an application of the match macro we'll define a macro,
;er-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 (almost) automatically. Moreover, we want our macro to
;be of the same syntax as syntax-rules, i.e. it should look like this
;
;  (er-macro-rules (%sym ...) (pat xpr) (pat1 xpr1) ...)
;
;where %sym explicitly renames the symbol sym (another one letter prefix
;would do as well), pat, pat1, ... represent admissible macro calls and
;xpr, xpr1 ... corresponding transformers.  Moreover, er-macro-rules
;should expand into a (lambda (form rename compare?) ...) as does
;syntax-rules. Since match consumes the form argument and %sym ... the
;rename argument, the resulting transformers xpr0, xpr1 ... are all
;functions of the remaining argument compare?.

;Note that the list (%sym ...) is in general rather long, it will be
;transformed into a long let of the form (let ((%sym (rename (sym-cdr
;'%sym))) ...) in the expansion, where sym-cdr is a local routine, which
;strips the prefix.
;
;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
;    (er-macro-rules (%if %my-or)
;      ((_)
;       (lambda (compare?) #f))
;      ((_ arg . args)
;       (lambda (compare?)
;         `(,%if ,arg ,arg (,%my-or ,@args))))))

;A high-level implementation of er-macro-rules would work, but it
;would expose the local routine, sym-cdr, and delay the stripping of
;prefixes to run-time, although it can be done at compile-time. So we
;prefer a low-level implementation.

;;; (er-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 er-macro-rules
  ;; what can be done at compile-time is done at compile-time
  (lambda (f r c?)
    (let (
      (syms (cadr f))
      (rules (cddr f))
      )
      (let (
        (pats (map car rules))
        (procs (map cadr rules))
        (sym-cdr
          (lambda (%sym)
            (string->symbol 
              (substring
                (symbol->string %sym) 1))))
        (%let (r 'let))
        (%lambda (r 'lambda))
        (%match (r 'match))
        (gform (gensym 'form))
        (grename (gensym 'rename))
        (gcompare? (gensym 'compare?))
        )
        `(,%lambda (,gform ,grename ,gcompare?)
           (,%let ,(map (lambda (sym) `(,sym (,grename ',(sym-cdr sym))))
                        syms)
             (,%match ,gform
               ,@(map (lambda (pat proc) `(,pat (,proc ,gcompare?))) 
                      pats procs))))))))

;;; (explicit-renaming (%sym ...) (code0 proc0) (code1 proc1) ...)
;;; --------------------------------------------------------------
;;; alias of er-macro-rules
;;; (for reasons of compatibility with earlier versions)
(define-syntax explicit-renaming
  (syntax-rules ()
    ((_ syms . pairs) (er-macro-rules syms . pairs))))

;With er-macro-rules under our belt, it's easy to implement three
;macros, er-macro-define, er-macro-let and er-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
;
;  (er-macro-define (my-or . args)
;    (lambda (compare? %if %my-or)
;      (if (null? args)
;        #f
;        (let ((tmp (car args)))
;          `(,%if ,tmp ,tmp (,%my-or ,@(cdr args)))))))

;;; (er-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 rename compare?) ...)) by means of
;;; er-macro-rules.

(define-syntax er-macro-define
  (syntax-rules (lambda)
    ((_ (name . args) (lambda (compare? . syms) xpr . xprs))
     (define-syntax name
       (er-macro-rules syms
         ((_ . args)
          (lambda (compare?)
            ((lambda syms xpr . xprs) . syms))))))))

;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) (lambda (compare?)  n))
;      ((g n) (lambda (compare? %f) `(,%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) (lambda (compare?)  n))
;      ((g n) (lambda (compare? %f) `(,%f ,n)))
;      )
;      (display (list (f 1) (g 1))) (newline)))
;
;returns (1 1).

;;; (er-macro-let ((code proc) ...) . body)
;;; ------------------------------------
;;; where code and proc are as in er-macro-define. This is
;;; a local version of er-macro-define, allowing a list of
;;; (code proc) lists to be processed in body in parallel.

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

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

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

;The following macro can be used to simplify renaming.
;Its syntax is similar to Graham's with-gensyms but more flexible
;because of the extra rename argument.
;
;;; (with-aliases (rename %sym0 %sym1 ...) . body)
;;; ----------------------------------------------
;;; executes body with aliases of sym0 sym1 ...
;;; (to be used in macros with import-for-syntax)
(define-syntax with-aliases
  (er-macro-transformer
    (lambda (f r c?)
      (let (
        (rename (caadr f))
        (%syms (cdadr f))
        (body (cddr f))
        (%let (r 'let))
        )
        (let ((syms (map (lambda (%sym)
                            (string->symbol
                              (substring (symbol->string %sym) 1)))
                    %syms)))
          `(,%let ,(map (lambda (%sym sym) `(,%sym (,rename ',sym)))
                      %syms syms)
             ,@body))))))

) ; module er-macros