source: project/release/5/procedural-macros/trunk/procedural-macros.scm @ 37895

Last change on this file since 37895 was 37895, checked in by juergen, 13 months ago

procedural-macros 1.1 with patches by Diego

File size: 26.7 KB
Line 
1; Author: Juergen Lorenz ; ju (at jugilo (dot) de
2;
3; Copyright (c) 2013-2019, Juergen Lorenz
4; All rights reserved.
5;
6; Redistribution and use in source and binary forms, with or without
7; modification, are permitted provided that the following conditions are
8; met:
9;
10; Redistributions of source code must retain the above copyright
11; notice, this list of conditions and the following dispasser.
12;
13; Redistributions in binary form must reproduce the above copyright
14; notice, this list of conditions and the following dispasser in the
15; documentation and/or other materials provided with the distribution.
16;
17; Neither the name of the author nor the names of its contributors may be
18; used to endorse or promote products derived from this software without
19; specific prior written permission.
20;
21; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
22; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
23; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
24; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32
33#|[
34Chicken provides two procedural macro-systems, implicit and explicit
35renaming macros. In both you have to destructure the use-form yourself
36and provide for the renaming or injecting of names which could or should
37be captured. Destructuring can be automated with the bind macro -- a
38simplified version of the equally named macro in the bindings library --
39and renaming resp. injecting can be almost automated with the help of
40either the macro with-mapped-symbols or two macro-generators, which
41replace the rename resp. inject parameter of the transformer with a
42prefix symbol. Note, that bind or with-mapped-symbols must be used
43for-syntax, if used in a macro body for destructuring or
44renaming/injecting.
45
46Usually an ambituous explicit renaming macro contains a long let
47defining the renamed symbols -- usually prefixed with some fixed symbol
48constant like % -- which is then executed in the macro's body by
49unquoting it. Both methods create the let automatically.
50
51Here are two simple examples, one the swap! macro, using
52define-er-macro-transformer and with-mapped-symbols, the other numeric if,
53using define-er-macro and and explicit prefix, %.
54In the latter case, the macro searches its body for symbols starting
55with this prefix, collects them in a list, removes duplicates and adds
56the necesary let with pairs of the form
57
58  (%name (rename 'name)
59
60to the front of the body. In other words it does what you usually do by
61hand.
62
63  (define-er-macro-transformer (swap! form rename compare?)
64    (let ((x (cadr form)) (y (caddr form)))
65      (with-mapped-symbols rename % (%tmp %let %set!)
66        `(,%let ((,%tmp ,x))
67           (,%set! ,x ,y)
68           (,%set! ,y ,%tmp)))))
69
70  (define-er-macro (nif form % compare?)
71    (bind (_ xpr pos zer neg) form
72      `(,%let ((,%result ,xpr))
73         (,%cond
74           ((,%positive? ,%result) ,pos)
75           ((,%negative? ,%result) ,neg)
76           (,%else ,zer)))))
77
78Note, that one of the standard arguments of an er-macro-transformer,
79rename, is replaced by the prefix, which characterize the symbols in the
80body to be renamed. The other arguments, form and compare?, remain
81untouched.
82
83
84For implicit renaming macros the list of injected symbols is usually,
85but not allways, short, even empty for nif. Of course, the generated let
86replaces rename with inject in this case.
87For example, here is a version of alambda, an anaphoric version of
88lambda, which injects the name self:
89
90  (define-ir-macro (alambda form % compare?)
91    (bind (_ args xpr . xprs) form
92      `(letrec ((,%self (lambda ,args ,xpr ,@xprs)))
93         ,%self)))
94
95]|#
96(declare (unit procedural-macros))
97
98(module basic-macros
99  (define-syntax-rule
100   define-er-macro-transformer
101   define-ir-macro-transformer
102   define-er-macro
103   define-ir-macro
104   once-only
105   with-mapped-symbols
106   with-gensyms
107   basic-macros
108   )
109  (import scheme
110          ;(only bindings bind-case)
111          (only (chicken condition) condition-case)
112          (only (chicken base) case-lambda print error))
113  (import-for-syntax (only bindings bind-case))
114
115#|[Let's start with a one syntax-rule]|#
116
117;;; (define-syntax-rule (name . args) xpr . xprs)
118;;; (define-syntax-rule (name . args) (keywords . keys) xpr . xprs)
119;;; ---------------------------------------------------------------
120;;; simplyfies define-syntax in case there is only one rule
121(define-syntax define-syntax-rule
122  (syntax-rules (keywords)
123    ((_ (name . args)
124        (keywords key ...) xpr . xprs)
125     (define-syntax name
126       (syntax-rules (key ...)
127         ((_ . args) xpr . xprs))))
128    ((_ (name . args) xpr . xprs)
129     (define-syntax name
130       (syntax-rules ()
131         ((_ . args) xpr . xprs))))))
132
133#|[
134Let's start with some helpers which might be occasionally useful
135]|#
136
137;;; (define-er-macro-transformer form rename compare?)
138;;; --------------------------------------------------
139;;; wrapper around er-macro-transformer
140(define-syntax define-er-macro-transformer
141  (syntax-rules ()
142    ((_ (name form rename compare?) xpr . xprs)
143     (define-syntax name
144       (er-macro-transformer
145         (lambda (form rename compare?) xpr . xprs))))))
146
147;;; (define-ir-macro-transformer form inject compare?)
148;;; --------------------------------------------------
149;;; wrapper around ir-macro-transformer
150(define-syntax define-ir-macro-transformer
151  (syntax-rules ()
152    ((_ (name form inject compare?) xpr . xprs)
153     (define-syntax name
154       (ir-macro-transformer
155         (lambda (form inject compare?) xpr . xprs))))))
156
157;;; (once-only (x ....) xpr ....)
158;;; -----------------------------
159;;; macro-arguments x .... are only evaluated once and from left to
160;;; right in the body xpr ....
161;;; The code is more or less due to
162;;; P. Seibel, Practical Common Lisp, p. 102
163;(define-syntax once-only
164;  (er-macro-transformer
165;    (lambda (form rename compare?)
166(define-er-macro-transformer (once-only form rename compare?)
167  (let ((names (cadr form))
168        (body (cons (caddr form) (cdddr form)))
169        (%let (rename 'let))
170        (%list (rename 'list))
171        )
172    (let ((syms (map rename names)))
173      `(,%let ,(map (lambda (g) `(,g ,(rename `',g))) syms)
174         `(,',%let ,(,%list ,@(map (lambda (g n) ``(,,g ,,n))
175                               syms names))
176            ,(,%let ,(map (lambda (n g) `(,n ,g))
177                        names syms)
178               ,@body))))));))
179;(define-ir-macro-transformer (once-only form inject compare?)
180;  (let ((names (cadr form))
181;        (body (cons (caddr form) (cdddr form))))
182;    (let ((gensyms (map (lambda (x) (gensym)) names)))
183;      `(let ,(map (lambda (g) `(,g (gensym))) gensyms)
184;         `(let ,(list ,@(map (lambda (g n) ``(,,g ,,n))
185;                             gensyms names))
186;            ,(let ,(map (lambda (n g) `(,n ,g))
187;                        names gensyms)
188;               ,@body))))))
189;
190
191;;; (define-macro-with (name form prefix compare? transformer) xpr . xprs)
192;;; ----------------------------------------------------------------------
193;;; internal helper
194(define-syntax define-macro-with
195  (er-macro-transformer
196    (lambda (form rename compare?)
197      (let (
198        (header (cadr form))
199        (body (cons (caddr form) (cdddr form)))
200        (pseudo-flatten
201          (lambda (tree)
202            ; imported flatten doesn't work with pseudo-lists
203            (let loop ((tree tree) (result '()))
204              (cond
205                ((pair? tree)
206                 (loop (car tree) (loop (cdr tree) result)))
207                ((null? tree) result)
208                (else
209                  (cons tree result))))))
210        (adjoin 
211          (lambda (obj lst)
212            (if (member obj lst) lst (cons obj lst))))
213        (sym-tail
214          (lambda (pre sym)
215            (let ((spre (symbol->string pre))
216                  (ssym (symbol->string sym)))
217              (let ((prelen (string-length spre))
218                    (symlen (string-length ssym)))
219                (string->symbol (substring ssym prelen))))))
220        (sym-prepends?
221          (lambda (pre sym)
222            (let ((spre (symbol->string pre))
223                  (ssym (symbol->string sym)))
224              (let ((prelen (string-length spre))
225                    (symlen (string-length ssym)))
226                (and (< prelen symlen)
227                     (equal? (string->list spre)
228                             (string->list
229                               (substring ssym 0 prelen))))))))
230        )
231        (let (
232          (name (car header))
233          (frm (cadr header))
234          (pre (caddr header))
235          (cmp? (cadddr header))
236          (transformer (car (cddddr header)))
237          (ren 'process)
238          (%let (rename 'let))
239          (%lambda (rename 'lambda))
240          (%define-syntax (rename 'define-syntax))
241          (flat-body (pseudo-flatten body))
242          (remove-duplicates
243            (lambda (lst)
244              (let loop ((lst lst) (result '()))
245                (if (null? lst)
246                  (reverse result)
247                  (loop (cdr lst) (adjoin (car lst) result))))))
248          )
249          `(,%define-syntax ,name
250             (,transformer
251               (,%lambda (,frm ,ren ,cmp?)
252                 (,%let ,(map (lambda (sym)
253                                `(,sym (,ren ',(sym-tail pre sym))))
254                              (remove-duplicates
255                                (compress
256                                  (map (lambda (sym)
257                                         (and (symbol? sym)
258                                              (sym-prepends? pre sym)))
259                                       flat-body)
260                                  flat-body)))
261                                ;(filter
262                                ;  (lambda (sym)
263                                ;          (and (symbol? sym)
264                                ;               (sym-prepends? pre sym)))
265                                ;        (pseudo-flatten body))))
266                   ,@body)))))))))
267
268;;; (define-er-macro (name form rename-prefix compare?) xpr . xprs)
269;;; ---------------------------------------------------------------
270;;; defines an explicit-renaming macro name with use-form form,
271;;; automatically renaming symbols starting with inject-rpefix
272(define-syntax define-er-macro
273  (syntax-rules ()
274    ((_ (name form rename-prefix compare?) xpr . xprs)
275     (define-macro-with
276       (name form rename-prefix compare? er-macro-transformer)
277       xpr . xprs))))
278
279;;; (define-ir-macro (name form inject-prefix compare?) xpr . xprs)
280;;; ---------------------------------------------------------------
281;;; defines an implicit-renaming macro name with use-form form,
282;;; automatically injecting symbols starting with inject-rpefix
283(define-syntax define-ir-macro
284  (syntax-rules ()
285    ((_ (name form inject-prefix compare?) xpr . xprs)
286     (define-macro-with
287       (name form inject-prefix compare? ir-macro-transformer)
288       xpr . xprs))))
289
290;;; (with-mapped-symbols mapper prefix- (prefix-x ....) xpr ....)
291;;; -------------------------------------------------------------
292;;; binds a series of prefixed names, prefix-x ....
293;;; to the images of the original names, x ...., under mapper
294;;; and evaluates xpr .... in this context
295(define-syntax with-mapped-symbols
296  (er-macro-transformer
297    (lambda (form rename compare?)
298      (let ((mapper (cadr form))
299            (prefix (caddr form))
300            (syms (cadddr form))
301            (xpr (car (cddddr form)))
302            (xprs (cdr (cddddr form)))
303            (%let (rename 'let))
304            (sym-tail
305              (lambda (pre sym)
306                (let ((spre (symbol->string pre))
307                      (ssym (symbol->string sym)))
308                  (let ((prelen (string-length spre))
309                        (symlen (string-length ssym)))
310                    (string->symbol (substring ssym prelen)))))))
311        `(,%let ,(map (lambda (s)
312                        `(,s (,mapper ',(sym-tail prefix s))))
313                      syms)
314           ,xpr ,@xprs)))))
315
316;;; (with-gensyms (name ....) xpr ....)
317;;; -----------------------------------
318;;; binds name ... to (gensym 'name) ... in body xpr ...
319(define-syntax with-gensyms
320  (ir-macro-transformer
321    (lambda (form inject compare?)
322      `(let ,(map (lambda (n) `(,n (gensym ',n))) (cadr form))
323         ,@(cddr form)))))
324
325
326;;; (basic-macros sym ..)
327;;; ---------------------
328;;; documentation procedure.
329(define basic-macros
330  (let ((alst '(
331    (define-syntax-rule
332      macro:
333       (define-syntax-rule (name . args) xpr . xprs)
334       (define-syntax-rule (name . args) (keywords . keys) xpr . xprs)
335       "simplyfied version of syntax-rules,"
336       "if there is only one rule")
337;;;    (bind
338;;;      macro:
339;;;      (bind pat seq (where fender ...) .. xpr ....)
340;;;      "a variant of Common Lisp's destructuring-bind"
341;;;      "where pat and seq are a nested pseudo-lists and"
342;;;      "optional fenders of the form (x x? ...) are checked"
343;;;      "before evaluating the body xpr ...")
344;;;    (bind-case
345;;;      macro:
346;;;      (bind-case seq (pat (where fender ...) .. xpr ...) ....)
347;;;      "matches a nested pseudo-list seq against nested pseudo-lists"
348;;;      "pat ... with optional fenders ... in sequence in a case regime")
349    (once-only
350      macro:
351      (once-only (x ....) xpr ....)
352      "arguments x ... are evaluated only once and"
353      "from left to right in the body xpr ....")
354    (define-er-macro-transformer
355      macro:
356      (define-er-macro-tansformer name form rename compare?)
357      "wrapper around er-macro-transformer")
358    (define-ir-macro-transformer
359      macro:
360      (define-ir-macro-tansformer name form inject compare?)
361      "wrapper around ir-macro-transformer")
362    (define-er-macro
363      macro:
364      (define-er-macro name form rename-prefix compare?)
365      "creates an explicit-renaming macro, where all symbols"
366      "starting with rename-prefix are renamed automatically")
367    (define-ir-macro
368      macro:
369      (define-ir-macro name form inject-prefix compare?)
370      "creates an implicit-renaming macro, where all symbols"
371      "starting with inject-prefix are injected automatically")
372    (with-mapped-symbols
373      macro:
374      (with-mapped-symbols mapper prefix- (prefix-x ....) xpr ....)
375      "binds a series of prefixed names, prefix-x ...."
376      "to the images of the original names, x ...., under mapper"
377      "and evaluates xpr .... in this context")
378    (with-gensyms
379      macro:
380      (with-gensyms (x ....) xpr ....)
381      "generates a series of gensyms x .... to be used in body xpr ...")
382    )))
383    (case-lambda
384      (()
385       (map car alst))
386      ((sym)
387       (let ((lst (assq sym alst)))
388         (if lst
389           (for-each print (cdr lst))
390           (error 'basic-macros
391                  "not exported" sym)))))))
392
393) ; module basic-macros
394
395#|[
396This module will provide some macro-writing macros, in particular
397macro-rules and define-macro, based on explicit- and implicit-renaming.
398The syntax of macro-rules mimics that of syntax-rules, except that it
399allows for injected symbols before the keyword list and the templates
400are usually quasiquoted lists. Since we use bind-case from the bindings
401egg, this library accepts wildcards, non-symbol literals and fenders.
402]|#
403
404(module procedural-macros
405  (procedural-macros
406    define-macro
407    (macro-rules bind-case)
408    macro-let
409    macro-letrec
410    ;basic-macros
411    once-only
412    define-ir-macro-transformer
413    define-er-macro-transformer
414    define-ir-macro
415    define-er-macro
416    with-mapped-symbols
417    with-gensyms)
418 
419  (import scheme
420          basic-macros
421          (only (chicken base) print error case-lambda)
422          (only bindings bind-case))
423  (import-for-syntax (only (chicken base) compress))
424
425#|[
426The workhorse of the library is the following macro, a procedural
427version of syntax-rules, but without its limitations.
428]|#
429
430;;; (macro-rules sym ... (key ...) (pat tpl) ...)
431;;; (macro-rules sym ... (key ...) (pat (where fender ...) tpl) ...)
432;;; ----------------------------------------------------------------
433;;; where sym ... are injected non-hygienig symbols, key ... are
434;;; additional keywords, pat ....  are nested lambda-lists without
435;;; spezial meaning of ellipses and tpl .... usually evaluate to
436;;; quasiquoted templates. The optional fenders belong to the pattern
437;;; matching process.
438(define-er-macro-transformer (macro-rules f r c?)
439  (let (
440    (f* (let loop ((tail (cdr f)) (head '()))
441          (if (symbol? (car tail))
442            (loop (cdr tail) (cons (car tail) head))
443            (cons head tail))))
444    (%x (r 'x))
445    (%let (r 'let))
446    (%form (r 'form))
447    (%where (r 'where))
448    (%lambda (r 'lambda))
449    (%inject (r 'inject))
450    (%compare? (r 'compare?))
451    (%bind-case (r 'bind-case))
452    (%ir-macro-transformer (r 'ir-macro-transformer))
453    )
454    (let ((syms (car f*))
455          (keys (cadr f*))
456          (rules (cddr f*))
457          (pseudo-flatten
458            (lambda (tree)
459              ; imported flatten doesn't work with pseudo-lists
460              (let loop ((tree tree) (result '()))
461                (cond
462                  ((pair? tree)
463                   (loop (car tree) (loop (cdr tree) result)))
464                  ((null? tree) result)
465                  (else
466                    (cons tree result))))))
467          )
468      (let* ((pats (map car rules))
469             (fpats (map pseudo-flatten pats))
470             (kpats (map (lambda (fp)
471                           ;(filter (lambda (x)
472                           ;          (memq x keys))
473                           ;        fp))
474                           (compress
475                             (map (lambda (x) (memq x keys)) fp)
476                             fp))
477                         fpats))
478             ;; compare? keywords with its names
479             (key-checks
480               (map (lambda (kp)
481                      (map (lambda (p s)
482                             `(,p (,%lambda (,%x)
483                                            (,%compare? ,%x ,s))))
484                           kp
485                           (map (lambda (x) `',x)
486                                kp)))
487                    kpats))
488             ;; prepare where clause for each rule
489             ;; to check keys
490             (all-rules (map (lambda (rule checks)
491                               (let ((second (cadr rule)))
492                                 (if (and (pair? second)
493                                          (c? (car second) %where))
494                                   `(,(car rule)
495                                      (,%where ,@(cdr second) ,@checks)
496                                      ,@(cddr rule))
497                                   `(,(car rule)
498                                      (,%where ,@checks)
499                                      ,@(cdr rule)))))
500                             rules key-checks)))
501        `(,%ir-macro-transformer
502           (,%lambda (,%form ,%inject ,%compare?)
503             (,%let ,(map (lambda (s)
504                       `(,s (,%inject ',s)))
505                     syms)
506               (,%bind-case ,%form
507                            ,@all-rules))))))))
508
509#|[
510And now a procedural version of our old friend, define-macro,
511which is hygienic, if now injections are provided.
512]|#
513
514;;; (define-macro (name . args)
515;;;   (where (x . xs) ...)
516;;;   xpr . xprs)
517;;; ----------------------------------- 
518;;; where xs is either a list of predicates, thus providing fenders,
519;;; or a singleton containing one of the symbols keyword or injection
520;;; to provide keyword arguments or nonhygienic macros
521(define-er-macro-transformer (define-macro form rename compare?)
522  (let ((code (cadr form))
523        (xpr (caddr form))
524        (xprs (cdddr form))
525        (%where (rename 'where))
526        (%keyword (rename 'keyword))
527        (%injection (rename 'injection))
528        (%define-macro (rename 'define-macro))
529        (%macro-rules (rename 'macro-rules))
530        (%define-syntax (rename 'define-syntax)))
531    (let ((name (car code)) (args (cdr code)))
532      (if (and (pair? xpr)
533               (compare? (car xpr) %where)
534               (not (null? xprs)))
535        (let ((clauses (cdr xpr)))
536          (let (
537            (fenders
538              (compress
539                (map (lambda (clause)
540                       (or (null? (cdr clause))
541                           (and (not (compare? (cadr clause) %keyword))
542                                (not (compare? (cadr clause) %injection)))))
543                  clauses)
544                clauses))
545              ;(filter (lambda (clause)
546              ;          (or (null? (cdr clause))
547              ;              (and (not (compare? (cadr clause) %keyword))
548              ;                   (not (compare? (cadr clause) %injection)))))
549              ;       clauses))
550            (keywords
551              (compress
552                (map (lambda (clause)
553                       (and (not (null? (cdr clause)))
554                            (compare? (cadr clause) %keyword)))
555                     clauses)
556                clauses))
557              ;(filter (lambda (clause)
558              ;          (and (not (null? (cdr clause)))
559              ;               (compare? (cadr clause) %keyword)))
560              ;        clauses))
561            (injections
562              (compress
563                (map (lambda (clause)
564                       (and (not (null? (cdr clause)))
565                            (compare? (cadr clause) %injection)))
566                     clauses)
567                clauses))
568              ;(filter
569              ;  (lambda (clause)
570              ;          (and (not (null? (cdr clause)))
571              ;               (compare? (cadr clause) %injection)))
572              ;        clauses))
573            )
574            (let (
575              (keywords
576                (if (null? keywords)
577                  keywords
578                  (map car keywords)))
579              (injections
580                (if (null? injections)
581                  injections
582                  (map car injections)))
583              )
584              `(,%define-syntax ,name
585                 (,%macro-rules ,@injections ,keywords
586                   ((_ ,@args) (where ,@fenders) ,@xprs))))))
587        `(,%define-syntax ,name
588           (,%macro-rules ()
589             ((_ ,@args) ,xpr ,@xprs)))))))
590
591#|[
592Now follow the local versions of define-macro, macro-let and
593macro-letrec. Since the syntax of both is identical, they are
594implemented by means of a helper macro.
595]|#
596
597;; helper for macro-let and macro-letrec
598(define-er-macro-transformer (macro-with form rename compare?)
599  (let ((op (cadr form))
600        (pat-tpl-pairs (caddr form))
601        (xpr (cadddr form))
602        (xprs (cddddr form))
603        (%macro-rules (rename 'macro-rules)))
604    (let ((pats (map car pat-tpl-pairs))
605          (tpls (map cdr pat-tpl-pairs)))
606      `(,op ,(map (lambda (pat tpl)
607                    `(,(car pat)
608                       (,%macro-rules ()
609                         ((_ ,@(cdr pat)) ,@tpl))))
610                  pats tpls)
611                   ,xpr ,@xprs))))
612
613;;; (macro-let (((name . args) (where fender ...) .. xpr ...) ...) body ....)
614;;; -------------------------------------------------------------------------
615;;; evaluates body ... in the context of parallel macros name ....
616(define-er-macro-transformer (macro-let form rename compare?)
617  (let ((pat-tpl-pairs (cadr form))
618        (xpr (caddr form))
619        (xprs (cdddr form));)
620        (%macro-with (rename 'macro-with))
621        (%let-syntax (rename 'let-syntax)))
622    `(,%macro-with ,%let-syntax ,pat-tpl-pairs ,xpr ,@xprs)))
623
624;;; (macro-letrec (((name . args) (where fender ...) .. xpr ...) ...) body ....)
625;;; ----------------------------------------------------------------------------
626;;; evaluates body ... in the context of recursive macros name ....
627(define-er-macro-transformer (macro-letrec form rename compare?)
628  (let ((pat-tpl-pairs (cadr form))
629        (xpr (caddr form))
630        (xprs (cdddr form));)
631        (%macro-with (rename 'macro-with))
632        (%letrec-syntax (rename 'letrec-syntax)))
633    `(,%macro-with ,%letrec-syntax ,pat-tpl-pairs ,xpr ,@xprs)))
634
635;;; (procedural-macros sym ..)
636;;; --------------------------
637;;; documentation procedure.
638(define procedural-macros
639  (let ((alst '(
640    (macro-rules
641      macro:
642      (macro-rules literal ... (keyword ...) (pat (where fender ...) .. tpl) ....)
643      "procedural version of syntax-rules"
644      "with optional injected literals"
645      "and quasiquoted templates")
646    (define-macro
647      macro:
648      (define-macro (name . args) (where (x . xs) ...) .. xpr ....)
649      "a version of macro-rules with only one rule"
650      "xs is either a list of predicates, thus providing fenders"
651      "or a singleton containing one of the symbols keyword or"
652      "injection, providing keyword parameters or nonhygienic macros")
653    (macro-let
654      macro:
655      (macro-let (((name . args) (where fender ...) .. xpr ...) ...) body ....)
656      "evaluates body ... in the context of parallel macros name ....")
657    (macro-letrec
658      macro:
659      (macro-letrec (((name . args) (where fender ...) .. xpr ...) ...) body ....)
660      "evaluates body ... in the context of recursive macros name ....")
661    (once-only
662      macro:
663      (once-only (x ....) xpr ....)
664      "arguments x ... are evaluated only once and"
665      "from left to right in the body xpr ....")
666    (define-er-macro-transformer
667      macro:
668      (define-er-macro-tansformer name form rename compare?)
669      "wrapper around er-macro-transformer")
670    (define-ir-macro-transformer
671      macro:
672      (define-ir-macro-tansformer name form inject compare?)
673      "wrapper around ir-macro-transformer")
674    (define-er-macro
675      macro:
676      (define-er-macro name form rename-prefix compare?)
677      "creates an explicit-renaming macro, where all symbols"
678      "starting with rename-prefix are renamed automatically")
679    (define-ir-macro
680      macro:
681      (define-ir-macro name form inject-prefix compare?)
682      "creates an implicit-renaming macro, where all symbols"
683      "starting with inject-prefix are injected automatically")
684    (with-mapped-symbols
685      macro:
686      (with-mapped-symbols mapper prefix- (prefix-x ....) xpr ....)
687      "binds a series of prefixed names, prefix-x ...."
688      "to the images of the original names, x ...., under mapper"
689      "and evaluates xpr .... in this context")
690    (with-gensyms
691      macro:
692      (with-gensyms (x ....) xpr ....)
693      "generates a series of gensyms x .... to be used in body xpr ...")
694    )))
695    (case-lambda
696      (()
697       (map car alst))
698      ((sym)
699       (let ((lst (assq sym alst)))
700         (if lst
701           (for-each print (cdr lst))
702           (error 'procedural-macros
703                  "not exported" sym)))))))
704) ; procedural-macros
705
Note: See TracBrowser for help on using the repository browser.