source: project/release/5/procedural-macros/tags/1.0.1/procedural-macros.scm @ 37432

Last change on this file since 37432 was 37432, checked in by juergen, 3 years ago

procedural-macros 1.0.1

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
97(module basic-macros
98  (define-syntax-rule
99   define-er-macro-transformer
100   define-ir-macro-transformer
101   define-er-macro
102   define-ir-macro
103   once-only
104   with-mapped-symbols
105   with-gensyms
106   basic-macros
107   )
108  (import scheme
109          ;(only bindings bind-case)
110          (only (chicken condition) condition-case)
111          (only (chicken base) case-lambda print error))
112  (import-for-syntax (only bindings bind-case))
113
114#|[Let's start with a one syntax-rule]|#
115
116;;; (define-syntax-rule (name . args) xpr . xprs)
117;;; (define-syntax-rule (name . args) (keywords . keys) xpr . xprs)
118;;; ---------------------------------------------------------------
119;;; simplyfies define-syntax in case there is only one rule
120(define-syntax define-syntax-rule
121  (syntax-rules (keywords)
122    ((_ (name . args)
123        (keywords key ...) xpr . xprs)
124     (define-syntax name
125       (syntax-rules (key ...)
126         ((_ . args) xpr . xprs))))
127    ((_ (name . args) xpr . xprs)
128     (define-syntax name
129       (syntax-rules ()
130         ((_ . args) xpr . xprs))))))
131
132#|[
133Let's start with some helpers which might be occasionally useful
134]|#
135
136;;; (define-er-macro-transformer form rename compare?)
137;;; --------------------------------------------------
138;;; wrapper around er-macro-transformer
139(define-syntax define-er-macro-transformer
140  (syntax-rules ()
141    ((_ (name form rename compare?) xpr . xprs)
142     (define-syntax name
143       (er-macro-transformer
144         (lambda (form rename compare?) xpr . xprs))))))
145
146;;; (define-ir-macro-transformer form inject compare?)
147;;; --------------------------------------------------
148;;; wrapper around ir-macro-transformer
149(define-syntax define-ir-macro-transformer
150  (syntax-rules ()
151    ((_ (name form inject compare?) xpr . xprs)
152     (define-syntax name
153       (ir-macro-transformer
154         (lambda (form inject compare?) xpr . xprs))))))
155
156;;; (once-only (x ....) xpr ....)
157;;; -----------------------------
158;;; macro-arguments x .... are only evaluated once and from left to
159;;; right in the body xpr ....
160;;; The code is more or less due to
161;;; P. Seibel, Practical Common Lisp, p. 102
162;(define-syntax once-only
163;  (er-macro-transformer
164;    (lambda (form rename compare?)
165(define-er-macro-transformer (once-only form rename compare?)
166  (let ((names (cadr form))
167        (body (cons (caddr form) (cdddr form)))
168        (%let (rename 'let))
169        (%list (rename 'list))
170        )
171    (let ((syms (map rename names)))
172      `(,%let ,(map (lambda (g) `(,g ,(rename `',g))) syms)
173         `(,',%let ,(,%list ,@(map (lambda (g n) ``(,,g ,,n))
174                               syms names))
175            ,(,%let ,(map (lambda (n g) `(,n ,g))
176                        names syms)
177               ,@body))))));))
178;(define-ir-macro-transformer (once-only form inject compare?)
179;  (let ((names (cadr form))
180;        (body (cons (caddr form) (cdddr form))))
181;    (let ((gensyms (map (lambda (x) (gensym)) names)))
182;      `(let ,(map (lambda (g) `(,g (gensym))) gensyms)
183;         `(let ,(list ,@(map (lambda (g n) ``(,,g ,,n))
184;                             gensyms names))
185;            ,(let ,(map (lambda (n g) `(,n ,g))
186;                        names gensyms)
187;               ,@body))))))
188;
189
190;;; (define-macro-with (name form prefix compare? transformer) xpr . xprs)
191;;; ----------------------------------------------------------------------
192;;; internal helper
193(define-syntax define-macro-with
194  (er-macro-transformer
195    (lambda (form rename compare?)
196      (let (
197        (header (cadr form))
198        (body (cons (caddr form) (cdddr form)))
199        (pseudo-flatten
200          (lambda (tree)
201            ; imported flatten doesn't work with pseudo-lists
202            (let loop ((tree tree) (result '()))
203              (cond
204                ((pair? tree)
205                 (loop (car tree) (loop (cdr tree) result)))
206                ((null? tree) result)
207                (else
208                  (cons tree result))))))
209        (adjoin 
210          (lambda (obj lst)
211            (if (member obj lst) lst (cons obj lst))))
212        (sym-tail
213          (lambda (pre sym)
214            (let ((spre (symbol->string pre))
215                  (ssym (symbol->string sym)))
216              (let ((prelen (string-length spre))
217                    (symlen (string-length ssym)))
218                (string->symbol (substring ssym prelen))))))
219        (sym-prepends?
220          (lambda (pre sym)
221            (let ((spre (symbol->string pre))
222                  (ssym (symbol->string sym)))
223              (let ((prelen (string-length spre))
224                    (symlen (string-length ssym)))
225                (and (< prelen symlen)
226                     (equal? (string->list spre)
227                             (string->list
228                               (substring ssym 0 prelen))))))))
229        )
230        (let (
231          (name (car header))
232          (frm (cadr header))
233          (pre (caddr header))
234          (cmp? (cadddr header))
235          (transformer (car (cddddr header)))
236          (ren 'process)
237          (%let (rename 'let))
238          (%lambda (rename 'lambda))
239          (%define-syntax (rename 'define-syntax))
240          (flat-body (pseudo-flatten body))
241          (remove-duplicates
242            (lambda (lst)
243              (let loop ((lst lst) (result '()))
244                (if (null? lst)
245                  (reverse result)
246                  (loop (cdr lst) (adjoin (car lst) result))))))
247          )
248          `(,%define-syntax ,name
249             (,transformer
250               (,%lambda (,frm ,ren ,cmp?)
251                 (,%let ,(map (lambda (sym)
252                                `(,sym (,ren ',(sym-tail pre sym))))
253                              (remove-duplicates
254                                (compress
255                                  (map (lambda (sym)
256                                         (and (symbol? sym)
257                                              (sym-prepends? pre sym)))
258                                       flat-body)
259                                  flat-body)))
260                                ;(filter
261                                ;  (lambda (sym)
262                                ;          (and (symbol? sym)
263                                ;               (sym-prepends? pre sym)))
264                                ;        (pseudo-flatten body))))
265                   ,@body)))))))))
266
267;;; (define-er-macro (name form rename-prefix compare?) xpr . xprs)
268;;; ---------------------------------------------------------------
269;;; defines an explicit-renaming macro name with use-form form,
270;;; automatically renaming symbols starting with inject-rpefix
271(define-syntax define-er-macro
272  (syntax-rules ()
273    ((_ (name form rename-prefix compare?) xpr . xprs)
274     (define-macro-with
275       (name form rename-prefix compare? er-macro-transformer)
276       xpr . xprs))))
277
278;;; (define-ir-macro (name form inject-prefix compare?) xpr . xprs)
279;;; ---------------------------------------------------------------
280;;; defines an implicit-renaming macro name with use-form form,
281;;; automatically injecting symbols starting with inject-rpefix
282(define-syntax define-ir-macro
283  (syntax-rules ()
284    ((_ (name form inject-prefix compare?) xpr . xprs)
285     (define-macro-with
286       (name form inject-prefix compare? ir-macro-transformer)
287       xpr . xprs))))
288
289;;; (with-mapped-symbols mapper prefix- (prefix-x ....) xpr ....)
290;;; -------------------------------------------------------------
291;;; binds a series of prefixed names, prefix-x ....
292;;; to the images of the original names, x ...., under mapper
293;;; and evaluates xpr .... in this context
294(define-syntax with-mapped-symbols
295  (er-macro-transformer
296    (lambda (form rename compare?)
297      (let ((mapper (cadr form))
298            (prefix (caddr form))
299            (syms (cadddr form))
300            (xpr (car (cddddr form)))
301            (xprs (cdr (cddddr form)))
302            (%let (rename 'let))
303            (sym-tail
304              (lambda (pre sym)
305                (let ((spre (symbol->string pre))
306                      (ssym (symbol->string sym)))
307                  (let ((prelen (string-length spre))
308                        (symlen (string-length ssym)))
309                    (string->symbol (substring ssym prelen)))))))
310        `(,%let ,(map (lambda (s)
311                        `(,s (,mapper ',(sym-tail prefix s))))
312                      syms)
313           ,xpr ,@xprs)))))
314
315;;; (with-gensyms (name ....) xpr ....)
316;;; -----------------------------------
317;;; binds name ... to (gensym 'name) ... in body xpr ...
318(define-syntax with-gensyms
319  (ir-macro-transformer
320    (lambda (form inject compare?)
321      `(let ,(map (lambda (n) `(,n (gensym ',n))) (cadr form))
322         ,@(cddr form)))))
323
324
325;;; (basic-macros sym ..)
326;;; ---------------------
327;;; documentation procedure.
328(define basic-macros
329  (let ((alst '(
330    (define-syntax-rule
331      macro:
332       (define-syntax-rule (name . args) xpr . xprs)
333       (define-syntax-rule (name . args) (keywords . keys) xpr . xprs)
334       "simplyfied version of syntax-rules,"
335       "if there is only one rule")
336;;;    (bind
337;;;      macro:
338;;;      (bind pat seq (where fender ...) .. xpr ....)
339;;;      "a variant of Common Lisp's destructuring-bind"
340;;;      "where pat and seq are a nested pseudo-lists and"
341;;;      "optional fenders of the form (x x? ...) are checked"
342;;;      "before evaluating the body xpr ...")
343;;;    (bind-case
344;;;      macro:
345;;;      (bind-case seq (pat (where fender ...) .. xpr ...) ....)
346;;;      "matches a nested pseudo-list seq against nested pseudo-lists"
347;;;      "pat ... with optional fenders ... in sequence in a case regime")
348    (once-only
349      macro:
350      (once-only (x ....) xpr ....)
351      "arguments x ... are evaluated only once and"
352      "from left to right in the body xpr ....")
353    (define-er-macro-transformer
354      macro:
355      (define-er-macro-tansformer name form rename compare?)
356      "wrapper around er-macro-transformer")
357    (define-ir-macro-transformer
358      macro:
359      (define-ir-macro-tansformer name form inject compare?)
360      "wrapper around ir-macro-transformer")
361    (define-er-macro
362      macro:
363      (define-er-macro name form rename-prefix compare?)
364      "creates an explicit-renaming macro, where all symbols"
365      "starting with rename-prefix are renamed automatically")
366    (define-ir-macro
367      macro:
368      (define-ir-macro name form inject-prefix compare?)
369      "creates an implicit-renaming macro, where all symbols"
370      "starting with inject-prefix are injected automatically")
371    (with-mapped-symbols
372      macro:
373      (with-mapped-symbols mapper prefix- (prefix-x ....) xpr ....)
374      "binds a series of prefixed names, prefix-x ...."
375      "to the images of the original names, x ...., under mapper"
376      "and evaluates xpr .... in this context")
377    (with-gensyms
378      macro:
379      (with-gensyms (x ....) xpr ....)
380      "generates a series of gensyms x .... to be used in body xpr ...")
381    )))
382    (case-lambda
383      (()
384       (map car alst))
385      ((sym)
386       (let ((lst (assq sym alst)))
387         (if lst
388           (for-each print (cdr lst))
389           (error 'basic-macros
390                  "not exported" sym)))))))
391
392) ; module basic-macros
393
394#|[
395This module will provide some macro-writing macros, in particular
396macro-rules and define-macro, based on explicit- and implicit-renaming.
397The syntax of macro-rules mimics that of syntax-rules, except that it
398allows for injected symbols before the keyword list and the templates
399are usually quasiquoted lists. Since we use bind-case from the bindings
400egg, this library accepts wildcards, non-symbol literals and fenders.
401]|#
402
403(module procedural-macros
404  (procedural-macros
405    define-macro
406    macro-rules
407    macro-let
408    macro-letrec
409    ;basic-macros
410    once-only
411    define-ir-macro-transformer
412    define-er-macro-transformer
413    define-ir-macro
414    define-er-macro
415    with-mapped-symbols
416    with-gensyms)
417 
418  (import scheme
419          basic-macros
420          (only (chicken base) print error case-lambda))
421  (import-for-syntax (only (chicken base) compress)
422                     (only bindings bind-case))
423
424#|[
425The workhorse of the library is the following macro, a procedural
426version of syntax-rules, but without its limitations.
427]|#
428
429;;; (macro-rules sym ... (key ...) (pat tpl) ...)
430;;; (macro-rules sym ... (key ...) (pat (where fender ...) tpl) ...)
431;;; ----------------------------------------------------------------
432;;; where sym ... are injected non-hygienig symbols, key ... are
433;;; additional keywords, pat ....  are nested lambda-lists without
434;;; spezial meaning of ellipses and tpl .... usually evaluate to
435;;; quasiquoted templates. The optional fenders belong to the pattern
436;;; matching process.
437(define-er-macro-transformer (macro-rules f r c?)
438  (let (
439    (f* (let loop ((tail (cdr f)) (head '()))
440          (if (symbol? (car tail))
441            (loop (cdr tail) (cons (car tail) head))
442            (cons head tail))))
443    (%x (r 'x))
444    (%let (r 'let))
445    (%form (r 'form))
446    (%where (r 'where))
447    (%lambda (r 'lambda))
448    (%inject (r 'inject))
449    (%compare? (r 'compare?))
450    (%bind-case (r 'bind-case))
451    (%ir-macro-transformer (r 'ir-macro-transformer))
452    )
453    (let ((syms (car f*))
454          (keys (cadr f*))
455          (rules (cddr f*))
456          (pseudo-flatten
457            (lambda (tree)
458              ; imported flatten doesn't work with pseudo-lists
459              (let loop ((tree tree) (result '()))
460                (cond
461                  ((pair? tree)
462                   (loop (car tree) (loop (cdr tree) result)))
463                  ((null? tree) result)
464                  (else
465                    (cons tree result))))))
466          )
467      (let* ((pats (map car rules))
468             (fpats (map pseudo-flatten pats))
469             (kpats (map (lambda (fp)
470                           ;(filter (lambda (x)
471                           ;          (memq x keys))
472                           ;        fp))
473                           (compress
474                             (map (lambda (x) (memq x keys)) fp)
475                             fp))
476                         fpats))
477             ;; compare? keywords with its names
478             (key-checks
479               (map (lambda (kp)
480                      (map (lambda (p s)
481                             `(,p (,%lambda (,%x)
482                                            (,%compare? ,%x ,s))))
483                           kp
484                           (map (lambda (x) `',x)
485                                kp)))
486                    kpats))
487             ;; prepare where clause for each rule
488             ;; to check keys
489             (all-rules (map (lambda (rule checks)
490                               (let ((second (cadr rule)))
491                                 (if (and (pair? second)
492                                          (c? (car second) %where))
493                                   `(,(car rule)
494                                      (,%where ,@(cdr second) ,@checks)
495                                      ,@(cddr rule))
496                                   `(,(car rule)
497                                      (,%where ,@checks)
498                                      ,@(cdr rule)))))
499                             rules key-checks)))
500        `(,%ir-macro-transformer
501           (,%lambda (,%form ,%inject ,%compare?)
502             (,%let ,(map (lambda (s)
503                       `(,s (,%inject ',s)))
504                     syms)
505               (,%bind-case ,%form
506                            ,@all-rules))))))))
507
508#|[
509And now a procedural version of our old friend, define-macro,
510which is hygienic, if now injections are provided.
511]|#
512
513;;; (define-macro (name . args)
514;;;   (where (x . xs) ...)
515;;;   xpr . xprs)
516;;; ----------------------------------- 
517;;; where xs is either a list of predicates, thus providing fenders,
518;;; or a singleton containing one of the symbols keyword or injection
519;;; to provide keyword arguments or nonhygienic macros
520(define-er-macro-transformer (define-macro form rename compare?)
521  (let ((code (cadr form))
522        (xpr (caddr form))
523        (xprs (cdddr form))
524        (%where (rename 'where))
525        (%keyword (rename 'keyword))
526        (%injection (rename 'injection))
527        (%define-macro (rename 'define-macros))
528        (%macro-rules (rename 'macro-rules))
529        (%define-syntax (rename 'define-syntax)))
530    (let ((name (car code)) (args (cdr code)))
531      (if (and (pair? xpr)
532               (compare? (car xpr) %where)
533               (not (null? xprs)))
534        (let ((clauses (cdr xpr)))
535          (let (
536            (fenders
537              (compress
538                (map (lambda (clause)
539                       (or (null? (cdr clause))
540                           (and (not (compare? (cadr clause) %keyword))
541                                (not (compare? (cadr clause) %injection)))))
542                  clauses)
543                clauses))
544              ;(filter (lambda (clause)
545              ;          (or (null? (cdr clause))
546              ;              (and (not (compare? (cadr clause) %keyword))
547              ;                   (not (compare? (cadr clause) %injection)))))
548              ;       clauses))
549            (keywords
550              (compress
551                (map (lambda (clause)
552                       (and (not (null? (cdr clause)))
553                            (compare? (cadr clause) %keyword)))
554                     clauses)
555                clauses))
556              ;(filter (lambda (clause)
557              ;          (and (not (null? (cdr clause)))
558              ;               (compare? (cadr clause) %keyword)))
559              ;        clauses))
560            (injections
561              (compress
562                (map (lambda (clause)
563                       (and (not (null? (cdr clause)))
564                            (compare? (cadr clause) %injection)))
565                     clauses)
566                clauses))
567              ;(filter
568              ;  (lambda (clause)
569              ;          (and (not (null? (cdr clause)))
570              ;               (compare? (cadr clause) %injection)))
571              ;        clauses))
572            )
573            (let (
574              (keywords
575                (if (null? keywords)
576                  keywords
577                  (map car keywords)))
578              (injections
579                (if (null? injections)
580                  injections
581                  (map car injections)))
582              )
583              `(,%define-syntax ,name
584                 (,%macro-rules ,@injections ,keywords
585                   ((_ ,@args) (where ,@fenders) ,@xprs))))))
586        `(,%define-syntax ,name
587           (,%macro-rules ()
588             ((_ ,@args) ,xpr ,@xprs)))))))
589
590#|[
591Now follow the local versions of define-macro, macro-let and
592macro-letrec. Since the syntax of both is identical, they are
593implemented by means of a helper macro.
594]|#
595
596;; helper for macro-let and macro-letrec
597(define-er-macro-transformer (macro-with form rename compare?)
598  (let ((op (cadr form))
599        (pat-tpl-pairs (caddr form))
600        (xpr (cadddr form))
601        (xprs (cddddr form))
602        (%macro-rules (rename 'macro-rules)))
603    (let ((pats (map car pat-tpl-pairs))
604          (tpls (map cdr pat-tpl-pairs)))
605      `(,op ,(map (lambda (pat tpl)
606                    `(,(car pat)
607                       (,%macro-rules ()
608                         ((_ ,@(cdr pat)) ,@tpl))))
609                  pats tpls)
610                   ,xpr ,@xprs))))
611
612;;; (macro-let (((name . args) (where fender ...) .. xpr ...) ...) body ....)
613;;; -------------------------------------------------------------------------
614;;; evaluates body ... in the context of parallel macros name ....
615(define-er-macro-transformer (macro-let form rename compare?)
616  (let ((pat-tpl-pairs (cadr form))
617        (xpr (caddr form))
618        (xprs (cdddr form));)
619        (%macro-with (rename 'macro-with))
620        (%let-syntax (rename 'let-syntax)))
621    `(,%macro-with ,%let-syntax ,pat-tpl-pairs ,xpr ,@xprs)))
622
623;;; (macro-letrec (((name . args) (where fender ...) .. xpr ...) ...) body ....)
624;;; ----------------------------------------------------------------------------
625;;; evaluates body ... in the context of recursive macros name ....
626(define-er-macro-transformer (macro-letrec form rename compare?)
627  (let ((pat-tpl-pairs (cadr form))
628        (xpr (caddr form))
629        (xprs (cdddr form));)
630        (%macro-with (rename 'macro-with))
631        (%letrec-syntax (rename 'letrec-syntax)))
632    `(,%macro-with ,%letrec-syntax ,pat-tpl-pairs ,xpr ,@xprs)))
633
634;;; (procedural-macros sym ..)
635;;; --------------------------
636;;; documentation procedure.
637(define procedural-macros
638  (let ((alst '(
639    (macro-rules
640      macro:
641      (macro-rules literal ... (keyword ...) (pat (where fender ...) .. tpl) ....)
642      "procedural version of syntax-rules"
643      "with optional injected literals"
644      "and quasiquoted templates")
645    (define-macro
646      macro:
647      (define-macro (name . args) (where (x . xs) ...) .. xpr ....)
648      "a version of macro-rules with only one rule"
649      "xs is either a list of predicates, thus providing fenders"
650      "or a singleton containing one of the symbols keyword or"
651      "injection, providing keyword parameters or nonhygienic macros")
652    (macro-let
653      macro:
654      (macro-let (((name . args) (where fender ...) .. xpr ...) ...) body ....)
655      "evaluates body ... in the context of parallel macros name ....")
656    (macro-letrec
657      macro:
658      (macro-letrec (((name . args) (where fender ...) .. xpr ...) ...) body ....)
659      "evaluates body ... in the context of recursive macros name ....")
660    (once-only
661      macro:
662      (once-only (x ....) xpr ....)
663      "arguments x ... are evaluated only once and"
664      "from left to right in the body xpr ....")
665    (define-er-macro-transformer
666      macro:
667      (define-er-macro-tansformer name form rename compare?)
668      "wrapper around er-macro-transformer")
669    (define-ir-macro-transformer
670      macro:
671      (define-ir-macro-tansformer name form inject compare?)
672      "wrapper around ir-macro-transformer")
673    (define-er-macro
674      macro:
675      (define-er-macro name form rename-prefix compare?)
676      "creates an explicit-renaming macro, where all symbols"
677      "starting with rename-prefix are renamed automatically")
678    (define-ir-macro
679      macro:
680      (define-ir-macro name form inject-prefix compare?)
681      "creates an implicit-renaming macro, where all symbols"
682      "starting with inject-prefix are injected automatically")
683    (with-mapped-symbols
684      macro:
685      (with-mapped-symbols mapper prefix- (prefix-x ....) xpr ....)
686      "binds a series of prefixed names, prefix-x ...."
687      "to the images of the original names, x ...., under mapper"
688      "and evaluates xpr .... in this context")
689    (with-gensyms
690      macro:
691      (with-gensyms (x ....) xpr ....)
692      "generates a series of gensyms x .... to be used in body xpr ...")
693    )))
694    (case-lambda
695      (()
696       (map car alst))
697      ((sym)
698       (let ((lst (assq sym alst)))
699         (if lst
700           (for-each print (cdr lst))
701           (error 'procedural-macros
702                  "not exported" sym)))))))
703) ; procedural-macros
704
Note: See TracBrowser for help on using the repository browser.