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

Last change on this file since 37423 was 37423, checked in by juergen, 17 months ago

basic- and procedural-macros ported from chicken-4

File size: 17.9 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?
26
27This library provides the means for this to happen.
28
29=== Module macro-helpers
30
31Some of the following procedures are used in the macros of the
32basic-macros module. Others are here for completeness, for example the
33pseudo-list package.
34
35==== macro-helpers
36
37<procedure>(macro-helpers sym ..)</procedure>
38
39documentation procedure
40
41==== pseudo-list
42
43<procedure>(pseudo-list sentinel . args)</procedure>
44
45constructs a new pseudo-list.
46
47==== pseudo-list?
48
49<procedure>(pseudo-list? xpr)</procedure>
50
51predicate. Note, that except lists everything is a pseudo-list.
52
53==== pseudo-list-of
54
55<procedure>(pseudo-list-of . preds)</procedure>
56
57returns a unary predicate, which tests, if its argument is
58passed by each predicate in preds.
59
60==== pseudo-null?
61
62<procedure>(pseudo-null? xpr)</procedure>
63
64not a pair.
65
66==== pseudo-length
67
68<procedure>(pseudo-length pl)</procedure>
69
70length of a pseudo-list. The sentinel is not counted.
71
72==== pseudo-ref
73
74<procedure>(pseudo-ref pl k)</procedure>
75
76returns the kth item of a pseudo-list. k must be less then pl's
77pseudo-length.
78
79==== pseudo-tail
80
81<procedure>(pseudo-tail pl k)</procedure>
82<procedure>(pseudo-tail pl)</procedure>
83
84returns the kth tail of a pseudo-list. k must be less then or equal to pl's
85pseudo-length. In the latter case, or when no k is provided,
86the sentinel is returned.
87
88==== pseudo-head
89
90<procedure>(pseudo-head pl k)</procedure>
91<procedure>(pseudo-head pl)</procedure>
92
93returns the kth tail of a pseudo-list. k must be less then or equal to pl's
94pseudo-length. In the latter case, or when no k is provided,
95a list with the sentinel stripped is returned.
96
97==== pseudo-sentinel
98
99<procedure>(pseudo-sentinel pl)</procedure>
100
101returns the sentinel of a pseudo-list. If pl is not a pair, pl itself is
102returned.
103
104==== pseudo-flatten
105
106<procedure>(pseudo-flatte tree)</procedure>
107
108transforms a nested pseudo-list to a flat list.
109
110==== adjoin
111
112<procedure>(adjoin obj lst)</procedure>
113
114adds obj to lst, provided obj is not an item of lst.
115
116==== remove-duplicates
117
118<procedure>(remove-duplicates lst)</procedure>
119
120removes all duplicates of lst.
121
122==== filter
123
124<procedure>(filter ok? lst)</procedure>
125
126returns the sublist of lst consisting of all items passing the ok?
127predicate.
128
129==== sym-prepends?
130
131<procedure>(sym-prepends? pre sym)</procedure>
132
133does the symbol sym start with the symbol pre?
134
135==== sym-tail
136
137<procedure>(sym-tail pre sym)</procedure>
138
139returns the subsymbol of sym by stripping the prefix pre.
140
141=== Module basic-macros
142
143Usually an ambituous explicit renaming macro contains a long let
144defining the renamed symbols -- usually prefixed with some fixed symbol
145constant like % -- which is then executed in the macro's body by
146unquoting it. Our two macros create the let automatically. The only
147thing you have to do is providing a prefix and using it to prefix all
148symbols you want renamed resp injected.
149
150Here is a simple example, the numeric if.
151
152<enscript highlight=scheme>
153  (define-er-macro (nif form % compare?)
154    (bind (_ xpr pos zer neg) form
155      `(,%let ((,%result ,xpr))
156         (,%cond
157           ((,%positive? ,%result) ,pos)
158           ((,%negative? ,%result) ,neg)
159           (,%else ,zer)))))
160</enscript>
161
162Note, that one of the standard arguments of an er-macro-transformer,
163rename, is replaced by the rename-prefix %, which characterize the
164symbols in the body to be renamed.
165
166The macro searches its body for symbols starting with this prefix,
167collects them in a list, removes duplicates and adds the necesary let
168with pairs of the form
169
170  (%name (rename 'name)
171
172to the front of the body. In other words it does what you usually do by
173hand.
174
175For implicit renaming macros the list of injected symbols is usually,
176but not allways, short, even empty for nif. Of course, the generated let
177replaces rename with inject in this case.
178For example, here is a version of alambda, an anaphoric version of
179lambda, which injects the name self:
180
181<enscript highlight=scheme>
182  (define-ir-macro (alambda form % compare?)
183    (bind (_ args xpr . xprs) form
184      `(letrec ((,%self (lambda ,args ,xpr ,@xprs)))
185         ,%self)))
186</enscript>
187
188==== basic-macros
189
190<procedure>(basic-macros sym ..)</procedure>
191
192documentation procedure
193
194==== define-syntax-rule
195
196<macro>(define-syntax-rule (name . args) xpr . xprs)</macro>
197<macro>(define-syntax-rule (name . args) (keywords . keys) xpr .  xprs)</macro>
198
199simplyfied version of syntax-rules if there is only one rule.
200
201==== define-ir-macro-transformer
202
203<macro>(define-er-macro-transformer (name form inject compare?)</macro>
204
205wrapper around ir-macro-transformer.
206
207==== define-er-macro-transformer
208
209<macro>(define-er-macro-transformer (name form rename compare?)</macro>
210
211wrapper around er-macro-transformer.
212
213==== define-er-macro
214
215<macro>(define-er-macro (name form rename-symbol compare?) xpr . xprs)</macro>
216
217defines an explicit-renaming-macro name with macro-code form renaming
218each symbol in the body xpr . xprs starting with rename-symbol
219automatically.
220
221==== define-ir-macro
222
223<macro>(define-ir-macro (name form inject-symbol compare?) xpr . xprs)</macro>
224
225defines an implicit-renaming-macro name with macro-code form injecting
226each symbol in the body xpr . xprs starting with inject-symbol
227automatically.
228
229==== once-only
230
231<macro>(once-only (x . xs) xpr . xprs)</macro>
232
233to be used in a macro-body to avoid side-effects.
234The arguments x . xs are only evaluated once.
235once-only must be used for-syntax in explicit or implicit renaming
236macros.
237
238==== with-mapped-symbols
239
240<macro>(with-mapped-symbols mapper prefix- (prefix-x ...) xpr . xprs)</macro>
241
242binds a series of prefixed names, prefix-x ...
243to the images of the original names, x ..., under mapper
244and evaluates xpr . xprs in this context.
245To be used for-synax in ir- or er-macro-transformers, where mapper is
246either inject or rename.
247
248==== with-gensyms
249
250<macro>(with-gensyms (x ...) xpr ....)</macro>
251
252to be used in a macro body and hence to be imported for-syntax.
253Generates a list of gensyms x ... which can be used in xpr .....
254
255
256=== Module procedural-macros
257
258Combining implicit renaming with destructuring, some macro-writing
259macros are defined, in particular, a (mostly) hygienic procedural
260define-macro and a procedural version of syntax-rules, named
261macro-rules. The latter is almost as easy to use as syntax-rules, but
262much more powerfull. Here is its syntax
263
264<macro>(macro-rules sym ... (key ...) (pat (where fender ...) .. tpl) ....)</macro>
265
266Note the special use of dots here and below: Three dots are ellipses, as
267usual, i.e. the pattern on the left is repeated zero or more times, two
268dots, zero or one time, 4 dots one ore several times.
269
270
271This form can be used instead of syntax-rules in define-syntax,
272let-sytax and letrec-syntax, provided, you use it for-syntax.
273sym ... denote the injected symbols to break hygiene (if there is none,
274the constructed macro is hygienic). key ... and pat .... symbols are
275as in syntax-rules, fender ... are pairs of pattern variables and
276predicates, the latter applied to the former must be true for the
277pattern to match, and tpl .... are usually quasiquoted expressions.
278
279And here is the syntax of define-macro
280
281<macro>(define-macro (name . args) (where (x . xs) ...) .. xpr ....)</macro>
282
283The implementation of these macros depends on the bind-case macro of the
284basic-macros package which does the pattern matching of macro-rules. Since
285the former can handle wildcards, non-symbol literals and fenders, so
286does the latter.
287
288==== procedural-macros
289
290<procedure>(procedural-macros sym ..)</procedure>
291
292documentation procedure. Shows the exported symbols and the syntax of
293such an exported symbol, respectively.
294
295==== macro-rules
296
297<macro>(macro-rules sym ... (keyword ...) (pat (where fender ...) .. tpl) ....)</macro>
298
299like syntax-rules, but the templates are usually quasiquote-expressions.
300Moreover, the symbols sym ... are injected, if there are any.
301Here and in the sequel, fender is an expresseion of the form
302 (var ok?  ...)
303checking a pattern variable, var, against a sequence of predicates.
304
305Note, that non-symbol literals are accepted in each pat and considered a
306match if they are equal to the corresponding expression in the
307macro-code. The same applies to fenders: If they are not passed, the
308pattern is not matched.
309
310macro-rules must be used for-syntax if used in the preprocessing
311phase of a macro evaluation.
312
313==== define-macro
314
315<macro>(define-macro (name . args) (where (x . xs) ...) .. xpr ....))</macro>
316
317where xs is either a list of predicates, providing fenders,
318or a singleton with one of the symbols keyword or injection,
319providing keyword parameters or unhygienic macros.
320Generates a hygienic implicit-renaming macro, name, if no injection
321parameter is given.
322
323==== macro-let
324
325<macro>(macro-let (((name . args) (where fender ...) .. xpr ...) ...) body ....)</macro>
326
327evaluates body ... in the context of parallel hygienic macros name ....
328
329==== macro-letrec
330
331<macro>(macro-letrec (((name . args) (where fender ...) .. xpr ...) ...) body ....)</macro>
332
333evaluates body ... in the context of recursive hygienic macros name ....
334
335=== Reexports from basic-macros
336
337==== once-only
338
339<macro>(once-only (x ...)  body ....)</macro>
340
341to be used in a macro-body to avoid side-effects.
342The arguments x ... are only evaluated once.
343once-only must be imported for-syntax.
344
345==== define-ir-macro-transformer
346
347<macro>(define-er-macro-transformer (name form inject compare?)</macro>
348
349wrapper around ir-macro-transformer.
350
351==== define-er-macro-transformer
352
353<macro>(define-er-macro-transformer (name form rename compare?)</macro>
354
355wrapper around er-macro-transformer.
356
357==== define-er-macro
358
359<macro>(define-er-macro (name form rename-symbol compare?) xpr . xprs)</macro>
360
361defines an explicit-renaming-macro name with macro-code form renaming
362each symbol in the body xpr . xprs starting with rename-symbol
363automatically.
364
365==== define-ir-macro
366
367<macro>(define-ir-macro (name form inject-symbol compare?) xpr . xprs)</macro>
368
369defines an implicit-renaming-macro name with macro-code form injecting
370each symbol in the body xpr . xprs starting with inject-symbol
371automatically.
372
373==== with-mapped-symbols
374
375<macro>(with-mapped-symbols mapper prefix- (prefix-x ....) xpr ....)</macro>
376
377binds a series of prefixed names, prefix-x ....
378to the images of the original names, x ...., under mapper
379and evaluates xpr .... in this context
380
381==== with-gensyms
382
383<macro>(with-gensyms (x ...) xpr ....)</macro>
384
385to be used in a macro body and hence to be imported for-syntax.
386Generates a list of gensyms x ... which can be used in xpr .....
387
388
389=== Requirements
390
391bindings
392
393=== Usage
394
395<enscript highlight=scheme>
396
397(import procedural-macros)
398
399(use-for-syntax
400 (only procedural-macros macro-rules once-only
401                         with-mapped-symbols with-gensyms)
402
403</enscript>
404
405=== Examples
406
407<enscript highlight=scheme>
408
409(import procedural-macros)
410(import-for-syntax
411  (only bindings bind bind-case)
412  (only procedural-macros macro-rules with-mapped-symbols once-only)
413  (only (chicken base) list-of?))
414
415(define-er-macro (Square form % compare?)
416  (let ((x (cadr form)))
417    (once-only (x)
418      `(* ,x ,x))))
419
420(define-er-macro-transformer (Swap! form rename compare?)
421  (let ((x (cadr form)) (y (caddr form)))
422    (with-mapped-symbols rename % (%tmp %let %set!)
423      `(,%let ((,%tmp ,x))
424         (,%set! ,x ,y)
425         (,%set! ,y ,%tmp)))))
426
427(define-er-macro (Nif form % compare?)
428  (bind (_ xpr pos zer neg)
429    form
430    `(,%let ((,%result ,xpr))
431            (,%cond
432              ((,%positive? ,%result) ,pos)
433              ((,%negative? ,%result) ,neg)
434              (,%else ,zer)))))
435
436(define-ir-macro (Vif form % compare?)
437  (bind-case form
438    ((_ test (key xpr . xprs))
439     (cond
440       ((compare? key %then)
441        `(if ,test (begin ,xpr ,@xprs)))
442       ((compare? key %else)
443        `(if ,(not test) (begin ,xpr ,@xprs)))
444       (else
445         `(error 'Vif "syntax-error"))))
446    ((_ test (key1 xpr . xprs) (key2 ypr . yprs))
447     (cond
448       ((and (compare? key1 %then)
449             (compare? key2 %else))
450       `(if ,test
451          (begin ,xpr ,@xprs)
452          (begin ,ypr ,@yprs)))
453       ((and (compare? key1 %else)
454             (compare? key2 %then))
455       `(if ,test
456          (begin ,ypr ,@yprs)
457          (begin ,xpr ,@xprs)))
458       (else
459         `(error 'Vif "syntax-error"))))
460    ))
461
462;; two anaphoric macros
463(define-syntax aif
464  (macro-rules it ()
465    ((_ test consequent)
466     `(let ((,it ,test))
467        (if ,it ,consequent)))
468    ((_ test consequent alternative)
469     `(let ((,it ,test))
470        (if ,it ,consequent ,alternative)))))
471
472(define-macro (alambda args xpr . xprs)
473  (self injection)
474  `(letrec ((,self (lambda ,args ,xpr ,@xprs)))
475     ,self))
476
477;; effective membership testing
478(define-macro (in? what equ? . choices)
479  (let ((insym 'in))
480    `(let ((,insym ,what))
481       (or ,@(map (lambda (choice) `(,equ? ,insym ,choice))
482                  choices)))))
483
484;; verbose if
485(define-syntax vif
486  (macro-rules (then else)
487    ((_ test (then xpr . xprs))
488     `(if ,test
489        (begin ,xpr ,@xprs)))
490    ((_ test (else xpr . xprs))
491     `(if ,(not test)
492        (begin ,xpr ,@xprs)))
493    ((_ test (then xpr . xprs) (else ypr . yprs))
494     `(if ,test
495        (begin ,xpr ,@xprs)
496        (begin ,ypr ,@yprs)))))
497
498;; procedural version of cond
499(define-syntax my-cond
500  (macro-rules (else =>)
501    ((_ (else xpr . xprs))
502     `(begin ,xpr ,@xprs))
503    ((_ (test => xpr))
504     (let ((temp test))
505       `(if ,temp (,xpr ,temp))))
506    ((_ (test => xpr) . clauses)
507     (let ((temp test))
508       `(if ,temp
509          (,xpr ,temp)
510          (my-cond ,@clauses))))
511    ((_ (test)) `(if #f #f))
512    ((_ (test) . clauses)
513     (let ((temp test))
514       `(if ,temp
515          ,temp
516          (my-cond ,@clauses))))
517    ((_ (test xpr . xprs))
518     `(if ,test (begin ,xpr ,@xprs)))
519    ((_ (test xpr . xprs) . clauses)
520     `(if ,test
521        (begin ,xpr ,@xprs)
522        (my-cond ,@clauses)))))
523
524;; procedural version of letrec
525(define-macro (my-letrec var-val-pairs . body)
526  (where (var-val-pairs (list-of? pair?)))
527  (let ((vars (map car var-val-pairs))
528        (vals (map cadr var-val-pairs))
529        (aux (map (lambda (x) (gensym)) var-val-pairs)))
530    `(let ,(map (lambda (var) `(,var #f)) vars)
531       (let ,(map (lambda (a v) `(,a ,v)) aux vals)
532         ,@(map (lambda (v e) `(set! ,v ,e)) vars vals)
533         ,@body))))
534
535(my-letrec ((o? (lambda (m) (if (zero? m) #f (e? (- m 1)))))
536            (e? (lambda (n) (if (zero? n) #t (o? (- n 1))))))
537           (list (o? 95) (e? 95)))
538
539;; local macros
540(letrec-syntax (
541     (sec (macro-rules ()
542               ((_ lst) `(car (res ,lst)))))
543     (res (macro-rules ()
544             ((_ lst) `(cdr ,lst))))
545     )
546     (sec '(1 2 3)))
547;-> 2
548
549(macro-letrec (
550     ((sec lst) `(car (res ,lst)))
551     ((res lst) `(cdr ,lst))
552     )
553     (sec '(1 2 3)))
554;-> 2
555
556(macro-let (
557     ((fir lst) (where (lst list?)) `(car ,lst))
558     ((res lst) (where (lst list?)) `(cdr ,lst))
559     )
560     (fir (res '(1 2 3))))
561;-> 2
562
563;; non-symbolic literals
564(define-syntax foo
565  (macro-rules ()
566    ((_ "foo" x) x)
567    ((_ #f x) x)
568    ((_ a b) (where (a string?)) `(list ,a ,b))
569    ((_ a b) (where (a odd?)) `(list ,a ,b))
570    ((_ a b) a)))
571(foo "foo" 1)
572; -> 1
573(foo "bar" 2)
574; -> '("bar" 2)
575(foo #f 'blabla)
576; -> 'blabla
577(foo 1 2)
578; -> '(1 2)
579(foo 2 3)
580; -> 2
581
582(define-syntax add
583  (macro-rules ()
584    ((_ x y) (where (x string?) (y string?))
585     `(string-append ,x ,y))
586    (( _ x y) (where (x integer?) (y integer?))
587     `(+ ,x ,y))))
588(add 1 2)
589;-> 3
590(add "x" "y")
591;-> "xy"
592</enscript>
593
594== Last update
595
596Mar 19, 2019
597
598== Author
599
600[[/users/juergen-lorenz|Juergen Lorenz]]
601
602== License
603
604 Copyright (c) 2015-2019, Juergen Lorenz
605 All rights reserved.
606
607 Redistribution and use in source and binary forms, with or without
608 modification, are permitted provided that the following conditions are
609 met:
610 
611 Redistributions of source code must retain the above copyright
612 notice, this list of conditions and the following disclaimer.
613 
614 Redistributions in binary form must reproduce the above copyright
615 notice, this list of conditions and the following disclaimer in the
616 documentation and/or other materials provided with the distribution.
617 Neither the name of the author nor the names of its contributors may be
618 used to endorse or promote products derived from this software without
619 specific prior written permission.
620   
621 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
622 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
623 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
624 PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
625 HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
626 SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
627 TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
628 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
629 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
630 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
631 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
632
633== Version History
634
635; 1.0 : port from chicken-4 procedural- and basic-macros
Note: See TracBrowser for help on using the repository browser.