source: project/release/4/ir-macros/tags/1.7.1/ir-macros.scm @ 25292

Last change on this file since 25292 was 25292, checked in by juergen, 9 years ago

Copyright notice added

File size: 6.6 KB
Line 
1; Author: Juergen Lorenz
2; ju (at) jugilo (dot) de
3;
4; Last update: Aug 28, 2011
5;
6; Copyright (c) 2011, Juergen Lorenz
7; All rights reserved.
8;
9; Redistribution and use in source and binary forms, with or without
10; modification, are permitted provided that the following conditions are
11; met:
12;
13; Redistributions of source code must retain the above copyright
14; notice, this list of conditions and the following disclaimer.
15;
16; Redistributions in binary form must reproduce the above copyright
17; notice, this list of conditions and the following disclaimer in the
18; documentation and/or other materials provided with the distribution.
19;
20; Neither the name of the author nor the names of its contributors may be
21; used to endorse or promote products derived from this software without
22; specific prior written permission.
23;
24; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
25; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
26; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
27; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
28; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
29; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
30; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
31; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
32; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
33; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
34; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
35;
36
37;This module is now obsolete, use low-level-macros instead
38;=========================================================
39
40(require 'contracts)
41
42(module ir-macros
43  ;; ir-macro-rules is passed through from contract-helpers
44  (ir-macros ir-macro-rules ir-macro-define ir-macro-let ir-macro-letrec)
45(import scheme contracts)
46(import-for-syntax (only contracts ir-macro-rules))
47
48;;; initialize documentation
49(doclist
50  '((ir-macro-rules
51      "implicit-renaming version of syntax-rules"
52      (ir-macro-rules (sym ...) (pat0 xpr0) (pat1 xpr1) ...)
53      "where sym ... are injected symbols, xpr0 ... evaluate to
54templates, which are usually backquoted expressions and the one
55corresponding to the first matching pattern is evaluated")))
56
57;As an application of the ir-macro-rules macro from the contracts module
58;we'll implement some further macros which will make the writing of
59;implicit-renaming macros easier. For example, ir-macro-define will have
60;the same syntax as define-macro from earlier Chicken implementations,
61;so that an implementation of an or macro would look as follows:
62
63;  (ir-macro-define (my-or . args)
64;    (if (null? args)
65;      #f
66;      (let ((tmp (car args)))
67;        `(if ,tmp ,tmp (my-or ,@(cdr args))))))
68
69;;; (ir-macro-define code xpr . xprs)
70;;; ---------------------------------
71;;; where code is the complete macro-code (name . args), i.e. the
72;;; pattern of a macro call, and xpr . xprs expressions which generate
73;;; the macro-expansion. In case the body xpr . xprs is of the form
74;;; (with (sym ...) xpr . xprs) the local namespace is polluted by
75;;; unhygienic injected symbols sym ...
76(define-syntax-with-contract ir-macro-define
77  "implicit reanaming variant of syntax-rules"
78  (syntax-rules (with-injected)
79    ((_ (name . args) (with-injected (sym ...) xpr . xprs))
80    ;; sym ... are unhygienic injected symbols
81     (define-syntax name
82       (ir-macro-rules (sym ...)
83         ((_ . args) (begin xpr . xprs)))))
84    ;; hygienic
85    ((_ (name . args) xpr . xprs)
86     (ir-macro-define (name . args) (with-injected () xpr . xprs)))))
87
88;ir-macro-let and ir-macro-letrec are local versions of ir-macro-define,
89;where the local macros are evaluated in parallel or recursively. For
90;example
91
92;  (let ((f (lambda (n) (+ n 10))))
93;    (ir-macro-let (
94;      ((f n) n)
95;      ((g n) `(f ,n))
96;      )
97;      (display (list (f 1) (g 1))) (newline)))
98;
99;will result in (1 11) while 
100;
101;  (let ((f (lambda (n) (+ n 10))))
102;    (ir-macro-letrec (
103;      ((f n)  n)
104;      ((g n) `(f ,n))
105;      )
106;      (display (list (f 1) (g 1))) (newline)))
107;
108;returns (1 1).
109;
110;;; (helper op pairs . body)
111;;; ------------------------
112;;; Since ir-macro-let and ir-macro-letrec have the same code except
113;;; that the former evaluates to a let-syntax and the latter to a
114;;; letrec-syntax, this helper starts with the op argument, which is to
115;;; be replaced by either let-syntax or letrec-syntax.
116(define-syntax helper
117  (ir-macro-transformer
118    (lambda (form inject compare?)
119      (let ((op (cadr form)) (pairs (caddr form)) (body (cdddr form)))
120        (let (
121          (pats (map car pairs))
122          (bodies (map cdr pairs))
123          (with? (lambda (lst)
124                 (and (null? (cdr lst))
125                      (list? (car lst))
126                      (compare? (caar lst) 'with-injected))))
127          )
128          (let (
129            (syms (map (lambda (b)
130                         (if (with? b)
131                           (cadar b)
132                           '()))
133                       bodies))
134            (xprs (map (lambda (b)
135                         (if (with? b)
136                           (cddar b)
137                           b))
138                       bodies))
139            )
140            `(,op (
141               ,@(map (lambda (p s x)
142                        `(,(car p)
143                           (ir-macro-rules ,s ((_ ,@(cdr p))
144                             (begin ,@x)))))
145                      pats syms xprs)
146               )
147               ,@body)))))))
148
149;;; (ir-macro-let ((code xpr . xprs) ...) . body)
150;;; ---------------------------------------------
151;;; where code and xpr . xprs are as in ir-macro-define. This is
152;;; a local version of ir-macro-define, allowing a list of
153;;; (code xpr . xprs) lists to be processed in body in parallel.
154(define-syntax-with-contract ir-macro-let
155  "implicit-renaming macro-let, pairing macro-code with macro-body
156in the declaration part"
157  (syntax-rules ()
158    ((_ ((code xpr . xprs) ...) . body)
159     (helper let-syntax ((code xpr . xprs) ...) . body))))
160
161;;; (ir-macro-letrec ((code xpr . xprs) ...) . body)
162;;; ------------------------------------------------
163;;; where code and xpr . xprs are as in ir-macro-define.
164;;; Local version of ir-macro-define, allowing a list of
165;;; (code xpr . xprs) lists to be processed in body recursively.
166
167(define-syntax-with-contract ir-macro-letrec
168  "implicit-renaming macro-letrec, pairing macro-code with macro-body
169in the declaration part"
170  (syntax-rules ()
171    ((_ ((code xpr . xprs) ...) . body)
172     (helper letrec-syntax ((code xpr . xprs) ...) . body))))
173
174;;; save documentation
175(define ir-macros (doclist->dispatcher (doclist)))
176
177) ; module ir-macros
178
179
Note: See TracBrowser for help on using the repository browser.