source: project/release/4/ir-macros/trunk/ir-macros.scm @ 24835

Last change on this file since 24835 was 24835, checked in by juergen, 10 years ago

ir-macro-define-with-contract moved to contracts

File size: 5.3 KB
Line 
1;;; File: ir-macros.scm
2;;;; Author: Juergen Lorenz
3;;;; ju (at) jugilo (dot) de
4;;;; Date: Jun 20, 2011
5;;;;       Jun 22, 2011
6;;;;       Jul 11, 2011
7;;;;       Jul 22, 2011
8;;;;       Aug 02, 2011
9;;;;       Aug 15, 2011
10;;;;       Aug 28, 2011
11
12
13;This module does to implicit renaming macros, which are new to
14;chicken-4.7.0, what the er-macros module did to explicit renaming ones.
15;
16(require 'contracts)
17
18(module ir-macros
19  ;; ir-macro-rules is passed through from contract-helpers
20  (ir-macros ir-macro-rules ir-macro-define ir-macro-let ir-macro-letrec)
21(import scheme contracts)
22(import-for-syntax (only contracts ir-macro-rules))
23
24;;; initialize documentation
25(doclist
26  '((ir-macro-rules
27      "implicit-renaming version of syntax-rules"
28      (ir-macro-rules (sym ...) (pat0 xpr0) (pat1 xpr1) ...)
29      "where sym ... are injected symbols, xpr0 ... evaluate to
30templates, which are usually backquoted expressions and the one
31corresponding to the first matching pattern is evaluated")))
32
33;As an application of the ir-macro-rules macro from the contracts module
34;we'll implement some further macros which will make the writing of
35;implicit-renaming macros easier. For example, ir-macro-define will have
36;the same syntax as define-macro from earlier Chicken implementations,
37;so that an implementation of an or macro would look as follows:
38
39;  (ir-macro-define (my-or . args)
40;    (if (null? args)
41;      #f
42;      (let ((tmp (car args)))
43;        `(if ,tmp ,tmp (my-or ,@(cdr args))))))
44
45;;; (ir-macro-define code xpr . xprs)
46;;; ---------------------------------
47;;; where code is the complete macro-code (name . args), i.e. the
48;;; pattern of a macro call, and xpr . xprs expressions which generate
49;;; the macro-expansion. In case the body xpr . xprs is of the form
50;;; (with (sym ...) xpr . xprs) the local namespace is polluted by
51;;; unhygienic injected symbols sym ...
52(define-syntax-with-contract ir-macro-define
53  "implicit reanaming variant of syntax-rules"
54  (syntax-rules (with-injected)
55    ((_ (name . args) (with-injected (sym ...) xpr . xprs))
56    ;; sym ... are unhygienic injected symbols
57     (define-syntax name
58       (ir-macro-rules (sym ...)
59         ((_ . args) (begin xpr . xprs)))))
60    ;; hygienic
61    ((_ (name . args) xpr . xprs)
62     (ir-macro-define (name . args) (with-injected () xpr . xprs)))))
63
64;ir-macro-let and ir-macro-letrec are local versions of ir-macro-define,
65;where the local macros are evaluated in parallel or recursively. For
66;example
67
68;  (let ((f (lambda (n) (+ n 10))))
69;    (ir-macro-let (
70;      ((f n) n)
71;      ((g n) `(f ,n))
72;      )
73;      (display (list (f 1) (g 1))) (newline)))
74;
75;will result in (1 11) while 
76;
77;  (let ((f (lambda (n) (+ n 10))))
78;    (ir-macro-letrec (
79;      ((f n)  n)
80;      ((g n) `(f ,n))
81;      )
82;      (display (list (f 1) (g 1))) (newline)))
83;
84;returns (1 1).
85;
86;;; (helper op pairs . body)
87;;; ------------------------
88;;; Since ir-macro-let and ir-macro-letrec have the same code except
89;;; that the former evaluates to a let-syntax and the latter to a
90;;; letrec-syntax, this helper starts with the op argument, which is to
91;;; be replaced by either let-syntax or letrec-syntax.
92(define-syntax helper
93  (ir-macro-transformer
94    (lambda (form inject compare?)
95      (let ((op (cadr form)) (pairs (caddr form)) (body (cdddr form)))
96        (let (
97          (pats (map car pairs))
98          (bodies (map cdr pairs))
99          (with? (lambda (lst)
100                 (and (null? (cdr lst))
101                      (list? (car lst))
102                      (compare? (caar lst) 'with-injected))))
103          )
104          (let (
105            (syms (map (lambda (b)
106                         (if (with? b)
107                           (cadar b)
108                           '()))
109                       bodies))
110            (xprs (map (lambda (b)
111                         (if (with? b)
112                           (cddar b)
113                           b))
114                       bodies))
115            )
116            `(,op (
117               ,@(map (lambda (p s x)
118                        `(,(car p)
119                           (ir-macro-rules ,s ((_ ,@(cdr p))
120                             (begin ,@x)))))
121                      pats syms xprs)
122               )
123               ,@body)))))))
124
125;;; (ir-macro-let ((code xpr . xprs) ...) . body)
126;;; ---------------------------------------------
127;;; where code and xpr . xprs are as in ir-macro-define. This is
128;;; a local version of ir-macro-define, allowing a list of
129;;; (code xpr . xprs) lists to be processed in body in parallel.
130(define-syntax-with-contract ir-macro-let
131  "implicit-renaming macro-let, pairing macro-code with macro-body
132in the declaration part"
133  (syntax-rules ()
134    ((_ ((code xpr . xprs) ...) . body)
135     (helper let-syntax ((code xpr . xprs) ...) . body))))
136
137;;; (ir-macro-letrec ((code xpr . xprs) ...) . body)
138;;; ------------------------------------------------
139;;; where code and xpr . xprs are as in ir-macro-define.
140;;; Local version of ir-macro-define, allowing a list of
141;;; (code xpr . xprs) lists to be processed in body recursively.
142
143(define-syntax-with-contract ir-macro-letrec
144  "implicit-renaming macro-letrec, pairing macro-code with macro-body
145in the declaration part"
146  (syntax-rules ()
147    ((_ ((code xpr . xprs) ...) . body)
148     (helper letrec-syntax ((code xpr . xprs) ...) . body))))
149
150;;; save documentation
151(define ir-macros (doclist->dispatcher (doclist)))
152
153) ; module ir-macros
154
155
Note: See TracBrowser for help on using the repository browser.