source: project/wiki/eggref/5/procedural-macros @ 38711

Last change on this file since 38711 was 38711, checked in by juergen, 8 months ago

procedural-macros 3.0.1 simplified

File size: 11.7 KB
Line 
1[[tags: egg]]
2[[toc:]]
3
4== Procedural macros made easy
5
6The Scheme standard, R5RS, only provides declarative macros based on
7syntax-rules. They are easy to use, but rather limited. For example, you
8can only create hygienic macros, you have no control over the expansion
9process, in particular, you can't use local procedures to be evaluated at
10compile time. To overcome this limitations, R6RS offers syntax-case
11macros, but that's a mouthfull ...
12
13Fortunately, Chicken offers two versions of procedural macros, explicit
14and implicit renaming macros. They offer full flexibility without any
15limitations but are tedious to use.
16
17First, you must care to avoid variable capture with renaming if you
18want hygienic macros, or you must decide which variables should be
19captured on purpose. Implicit renaming here helps a lot: You simply
20inject names which you want to be captured, the others are renamed
21automatically by the runtime system.
22
23Second, you must do the destructuring of the macro code by hand.
24Wouldn't it be nice, if this could be done automatically behind the
25scene as well?  Well, two macros of the bindings egg, bind and bind-case,
26will help here.
27
28This library provides the means for this to happen. In particular,
29you'll find variants of good old define-macro. And macro-rules are
30implemented, which looks much like syntax-rules but doesn't have its
31limitations.
32
33
34=== Module procedural-macros
35
36==== define-er-macro
37
38<macro>(define-er-macro (name . args) (where . fenders) prefix xpr . xprs)</macro>
39<macro>(define-er-macro (name . args) prefix xpr . xprs)</macro>
40<macro>(define-er-macro name (pat (where . fenders) prefix xpr . xprs) . others)</macro>
41<macro>(define-er-macro name (pat prefix xpr . xprs) . others)</macro>
42
43where fenders are of the form (key? sym) most of the time, to check for keywords.
44A version of good old define-macro, where symbols prefixed with prefix are
45automatically renamed.
46
47==== define-ir-macro
48
49<macro>(define-ir-macro (name . args) (where . fenders) prefix xpr . xprs)</macro>
50<macro>(define-ir-macro (name . args) prefix xpr . xprs)</macro>
51<macro>(define-ir-macro name (pat (where . fenders) prefix xpr . xprs) . others)</macro>
52<macro>(define-ir-macro name (pat prefix xpr . xprs) . others)</macro>
53
54where fenders are of the form (key? sym) most of the time, to check for keywords.
55A version of good old define-macro, where symbols prefixed with prefix
56are automatically injected.
57
58==== define-macro
59
60<macro>(define-macro (name . args) body )</macro>
61
62where body is either
63* (with-explicit-renaming (c? %x ...) xpr ....)
64* (with-implicit-renaming (c? %x ...) xpr ....)
65or simply
66* xpr ....
67
68defines an explicit- or implicit-renaming macro with body xpr ....
69c? is a compare-routine to handle keys and %x ... are renamed or
70injected symbols to be used in the body.
71
72The last form is implicit-renaming without injections and keys.
73
74==== macro-rules
75
76<macro>(macro-rules sym ... (key ...) (pat tpl) ....)</macro>
77
78like syntax-rules, but the templates are usually quasiquote-expressions.
79Moreover, the symbols sym ... are injected, if there are any.
80
81Note, that non-symbol literals are accepted in each pat and considered a
82match if they are equal to the corresponding expression in the
83macro-code. The keys are transformed to keyword literals behind the
84scene.
85
86macro-rules must be imported for syntax if used in the preprocessing
87phase of a macro evaluation.
88
89==== macro-let
90
91<macro>(macro-let (((name . args) xpr ...) ...) xpr ....)</macro>
92
93evaluates xpr .... in the context of parallel hygienic macros name ...
94
95==== macro-letrec
96
97<macro>(macro-letrec (((name . args) xpr ...) ...) xpr ....)</macro>
98
99evaluates xpr .... in the context of recursive hygienic macros name ...
100
101==== once-only
102
103<macro>(once-only (x ...)  body ....)</macro>
104
105to be used in a macro-body to avoid side-effects.
106The arguments x ... are only evaluated once.
107
108once-only must be imported for-syntax.
109
110==== with-renamed-symbols
111
112<macro>(with-renamed-symbols (renamer %x ....) xpr ....)</macro>
113
114binds a series of prefixed names, %x ....
115to the images of the original names, x ...., under renamer
116and evaluates xpr .... in this context.
117
118The prefix is arbitrary, but must be only one letter.
119The macro must be imported for syntax.
120
121==== with-gensyms
122
123<macro>(with-gensyms (x ...) xpr ....)</macro>
124
125to be used in a macro body and hence to be imported for-syntax.
126Generates a list of gensyms x ... which can be used in xpr .....
127
128The macro must be imported for syntax.
129
130==== procedural-macros
131
132<procedure>(procedural-macros sym ..)</procedure>
133
134documentation procedure. Shows the exported symbols and the syntax of
135such an exported symbol, respectively.
136
137=== Requirements
138
139bindings
140
141=== Usage
142
143<enscript highlight=scheme>
144
145(import procedural-macros)
146
147(import-for-syntax
148 (only procedural-macros macro-rules once-only
149       with-renamed-symbols with-gensyms)
150
151</enscript>
152
153=== Examples
154
155<enscript highlight=scheme>
156
157(import procedural-macros)
158(import-for-syntax
159  (only checks <<)
160  (only bindings bind bind-case)
161  (only procedural-macros macro-rules with-renamed-symbols once-only))
162
163;; NUMERIC AND VERBOSE IF AS ER-MACRO
164
165(define-er-macro (er-nif xpr pos zer neg)
166  %
167  `(,%let ((,%result ,xpr))
168     (,%cond
169       ((,%positive? ,%result) ,pos)
170       ((,%negative? ,%result) ,neg)
171       (,%else ,zer))))
172
173(define-er-macro er-vif
174  ((_ test (then . xprs) (else . yprs))
175   (where (key? then) (key? else))
176   %
177   `(,%if ,test (,%begin ,@xprs) (,%begin ,@yprs))))
178
179;; COND AND CASE AS ER- OR IR-MACRO
180
181(define-er-macro er-cond
182  ((_ (else xpr . xprs))
183   (where (key? else))
184   %
185   `(,%begin ,xpr ,@xprs))
186  ((_ (test => xpr))
187   (where (key? =>))
188   %
189   `(,%let ((,%tmp ,test))
190      (,%if ,%tmp (,xpr ,%tmp))))
191  ((_ (test => xpr) . clauses)
192   (where (key? =>))
193   %
194   `(,%let ((,%tmp ,test))
195      (,%if ,%tmp
196        (,xpr ,%tmp)
197        (,%er-cond ,@clauses))))
198  ((_ (test))
199   %
200   ;`(if #f #f))
201   test)
202  ((_ (test) . clauses)
203   %
204   `(,%let ((,%tmp ,test))
205      (,%if ,%tmp
206        ,%tmp
207        (,%er-cond ,@clauses))))
208  ((_ (test xpr . xprs))
209   %
210   `(,%if ,test (,%begin ,xpr ,@xprs)))
211  ((_ (test xpr . xprs) . clauses)
212   %
213   `(,%if ,test
214      (,%begin ,xpr ,@xprs)
215      (,%er-cond ,@clauses)))
216  )
217
218(define-ir-macro ir-case* ; helper
219  ((_ key (else result . results))
220   (where (key? else))
221   %
222   `(begin ,result ,@results))
223  ((_ key (keys result . results))
224   %
225   `(if (memv ,key ',keys)
226      (begin ,result ,@results)))
227  ((_ key (keys result . results) clause . clauses)
228   %
229   `(if (memv ,key ',keys)
230      (begin ,result ,@results)
231      (ir-case* ,key ,clause ,@clauses)))
232  )
233
234(define-ir-macro (ir-case key clause . clauses)
235  %
236  ;`(let ((tmp ,key)) ; ok
237  ;   (ir-case* tmp ,clause ,@clauses)))
238  (let ((tmp key)) ; ok
239    `(ir-case* ,tmp ,clause ,@clauses)))
240
241;; ALAMBDA AS ER- AND IR-MACRO
242
243(define-ir-macro (ir-alambda args xpr . xprs)
244  %
245  `(letrec ((,%self (lambda ,args ,xpr ,@xprs)))
246     ,%self))
247
248(define-er-macro (er-alambda args xpr . xprs)
249  %
250  `(,%letrec ((self (,%lambda ,args ,xpr ,@xprs)))
251     self))
252
253;; TWO ANAPHORIC MACROS
254(define-syntax aif
255  (macro-rules it ()
256    ((_ test consequent)
257     `(let ((,it ,test))
258        (if ,it ,consequent)))
259    ((_ test consequent alternative)
260     `(let ((,it ,test))
261        (if ,it ,consequent ,alternative)))))
262
263(define-syntax alambda
264  (macro-rules self ()
265    ((_ args xpr . xprs)
266     `(letrec ((,self (lambda ,args ,xpr ,@xprs)))
267        ,self))))
268
269;; VERBOSE IF
270(define-er-macro % (vvif test (then . xprs) (else . yprs))
271  (lambda (compare?)
272    (if (and (compare? then %then) (compare? else %else))
273      `(,%if ,test (,%begin ,@xprs) (,%begin ,@yprs))
274      `(,%error 'vvif "wrong keys" then else))))
275
276;; EFFICIENT MEMBERSHIP TESTING
277(define-macro (in what equ? . choices)
278  (let ((insym 'in))
279    `(let ((,insym ,what))
280       (or ,@(map (lambda (choice) `(,equ? ,insym ,choice))
281                  choices)))))
282
283;; FOR WITH ONCE-ONLY
284(define-macro (for (var start end) xpr . xprs)
285  (once-only (start end)
286    `(do ((,var ,start (add1 ,var)))
287       ((= ,var ,end))
288       ,xpr ,@xprs)))
289
290;; VERBOSE IF
291(define-syntax vif
292  (macro-rules (then else)
293    ((_ test (then xpr . xprs))
294     `(if ,test
295        (begin ,xpr ,@xprs)))
296    ((_ test (else xpr . xprs))
297     `(if ,(not test)
298        (begin ,xpr ,@xprs)))
299    ((_ test (then xpr . xprs) (else ypr . yprs))
300     `(if ,test
301        (begin ,xpr ,@xprs)
302        (begin ,ypr ,@yprs)))))
303
304;; PROCEDURAL VERSION OF COND
305(define-syntax my-cond
306  (macro-rules (else =>)
307    ((_ (else xpr . xprs))
308     `(begin ,xpr ,@xprs))
309    ((_ (test => xpr))
310     `(let ((tmp ,test))
311        (if tmp (,xpr tmp))))
312    ((_ (test => xpr) . clauses)
313     `(let ((tmp ,test))
314        (if tmp
315          (,xpr tmp)
316          (my-cond ,@clauses))))
317    ((_ (test))
318     ;`(if #f #f))
319     test)
320    ((_ (test) . clauses)
321     `(let ((tmp ,test))
322        (if tmp
323          tmp
324          (my-cond ,@clauses))))
325    ((_ (test xpr . xprs))
326     `(if ,test (begin ,xpr ,@xprs)))
327    ((_ (test xpr . xprs) . clauses)
328     `(if ,test
329        (begin ,xpr ,@xprs)
330        (my-cond ,@clauses)))
331    ))
332
333;; PROCEDURAL VERSION OF LETREC
334(define-macro (my-letrec pairs xpr . xprs)
335  (<< pairs (list-of? pair?))
336  (let ((vars (map car pairs))
337        (vals (map cadr pairs))
338        (aux (map (lambda (x) (gensym)) pairs)))
339    `(let ,(map (lambda (var) `(,var #f)) vars)
340       (let ,(map (lambda (a v) `(,a ,v)) aux vals)
341         ,@(map (lambda (v e) `(set! ,v ,e)) vars vals)
342         ,xpr ,@xprs))))
343
344;; NON-SYMBOLIC LITERALS
345(define-syntax foo
346  (macro-rules ()
347    ((_ "foo" x) x)
348    ((_ #f x) `(list 'false))
349    ((_ #f x) 'false)
350    ((_ a b) (<< a string?) `(list ,a ,b))
351    ((_ a b) (<< a odd?) `(list ,a ,b))
352    ((_ a b) a)))
353
354;; LOCAL MACROS
355(macro-let (
356  ((first lst)
357   `(car (<< ,lst list?)))
358  ((rest lst)
359   `(cdr (<< ,lst list?)))
360  )
361  (first (rest '(1 2 3))))
362
363(macro-letrec (
364  ((second lst) `(car (rest ,lst)))
365  ((rest lst) `(cdr ,lst))
366  )
367  (second '(1 2 3)))
368
369</enscript>
370
371== Last update
372
373May 28, 2020
374
375== Author
376
377[[/users/juergen-lorenz|Juergen Lorenz]]
378
379== License
380
381 Copyright (c) 2015-2020, Juergen Lorenz
382 All rights reserved.
383
384 Redistribution and use in source and binary forms, with or without
385 modification, are permitted provided that the following conditions are
386 met:
387 
388 Redistributions of source code must retain the above copyright
389 notice, this list of conditions and the following disclaimer.
390 
391 Redistributions in binary form must reproduce the above copyright
392 notice, this list of conditions and the following disclaimer in the
393 documentation and/or other materials provided with the distribution.
394 Neither the name of the author nor the names of its contributors may be
395 used to endorse or promote products derived from this software without
396 specific prior written permission.
397   
398 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
399 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
400 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
401 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
402 HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
403 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
404 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
405 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
406 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
407 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
408 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
409
410== Version History
411
412; 3.0.1 : some code simplified
413; 3.0 : define-er-macro and define-ir-macro added
414; 2.1 : bug in macro-let and macro-letrec fixed
415; 2.0 : simplyfied and streamlined rewrite. Only one module remains.
416; 1.1 : fixed some bugs reported by Diego. I thank him.
417; 1.0.1 : port from chicken-4 procedural- and basic-macros
Note: See TracBrowser for help on using the repository browser.