source: project/release/4/list-bindings/tags/1.7/list-bindings.scm @ 29964

Last change on this file since 29964 was 29964, checked in by juergen, 8 years ago

macro-rules added

File size: 25.0 KB
Line 
1#|[
2Author: Juergen Lorenz
3ju (at) jugilo (dot) de
4
5Copyright (c) 2013, Juergen Lorenz
6All rights reserved.
7
8Redistribution and use in source and binary forms, with or without
9modification, are permitted provided that the following conditions are
10met:
11
12Redistributions of source code must retain the above copyright
13notice, this list of conditions and the following disclaimer.
14
15Redistributions in binary form must reproduce the above copyright
16notice, this list of conditions and the following disclaimer in the
17documentation and/or other materials provided with the distribution.
18
19Neither the name of the author nor the names of its contributors may be
20used to endorse or promote products derived from this software without
21specific prior written permission.
22
23THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
24IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
25TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
26PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
27HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
28SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
29TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
30PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
31LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
32NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
33SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
34
35This module provides simplyfied versions of some of the bindings
36macros, restricting destructuring to nested list expressions, as well
37as macros making the writing of low-level-macros easy.
38]|# 
39
40(module list-bindings
41  (export list-bindings bind-define bind-set! bind bindable? bind-lambda
42          bind-case bind/cc bind-let bind-let* define-syntax-rule
43          define-macro let-macro letrec-macro (macro-rules strip))
44  (import scheme
45          (only chicken condition-case error)
46          (only extras format))
47
48#|[
49Binding macros
50==============
51]|# 
52
53;;; (bindable? pat)
54;;; ---------------
55;;; returns a procedure, which checks, if subexpressions of its only
56;;; agument, tpl, are bindable to the pattern variables of pat.
57(define-syntax bindable?
58  (syntax-rules ()
59    ((_ (a . b))
60     (lambda (seq)
61       (and (pair? seq)
62            ((bindable? a) (car seq))
63            ((bindable? b) (cdr seq)))))
64    ((_ ())
65     (lambda (seq) (null? seq)))
66    ((_ a) (lambda (seq) #t))))
67
68;;; (bind pat seq . body)
69;;; --------------------------
70;;; Common Lisp's destructuring-bind:
71;;; binds pattern variables of pat to corresponding subexpression of
72;;; seq and evalueates body in this context
73(define-syntax bind
74  (syntax-rules ()
75    ((_(a . b) seq xpr . xprs)
76     (if (pair? seq)
77       (bind a (car seq) (bind b (cdr seq) xpr . xprs))
78       (error 'bind
79              (format #f "template ~s doesn't match pattern ~s"
80                      seq '(a . b)))))
81    ((_ () seq xpr . xprs)
82     (if (null? seq)
83       (let () xpr . xprs)
84       (error 'bind
85              (format #f "template ~s doesn't match pattern ~s"
86                      seq '()))))
87    ((_ a seq xpr . xprs)
88     (let ((a seq)) xpr . xprs))))
89;(define-syntax bind
90;  (ir-macro-transformer
91;    (lambda (form inject compare?)
92;      (let ((pat (cadr form))
93;            (seq (caddr form))
94;            (xpr (cadddr form))
95;            (xprs (cddddr form)))
96;        `(if ((bindable? ,pat) ,seq)
97;          (let
98;             ,(map (lambda (ks)
99;                     `(,(apply tree-ref pat ks)
100;                        (tree-ref ,seq ,@(quote-last ks))))
101;                   (pindex pat))
102;             ,xpr ,@xprs)
103;          (error 'bind
104;                 (format #f "template ~s doesn't match pattern ~s"
105;                         ,seq ',pat)))))))
106;(define-syntax bind
107;  (er-macro-transformer
108;    (lambda (form rename compare?)
109;      (let ((pat (cadr form))
110;            (seq (caddr form))
111;            (xpr (cadddr form))
112;            (xprs (cddddr form))
113;            (%if (rename 'if))
114;            (%let (rename 'let))
115;            (%error (rename 'error))
116;            (%format (rename 'format))
117;            (%bindable? (rename 'bindable?))
118;            (%tree-ref (rename 'tree-ref)))
119;        `(,%if ((,%bindable? ,pat) ,seq)
120;          (,%let
121;             ,(map (lambda (ks)
122;                     `(,(apply tree-ref pat ks)
123;                        (,%tree-ref ,seq ,@(quote-last ks))))
124;                   (pindex pat))
125;             ,xpr ,@xprs)
126;          (,%error 'bind
127;                   (,%format #f "template ~s doesn't match pattern ~s"
128;                             ,seq ',pat)))))))
129
130;;; (bind-lambda pat xpr . xprs)
131;;; ------------------------------
132;;; Combination of bind and lambda
133(define-syntax bind-lambda
134  (syntax-rules ()
135    ((_ pat xpr . xprs)
136     (lambda (x)
137       (bind pat x xpr . xprs)))))
138
139;;; (bind-case seq (pat xpr . xprs) ....)
140;;; -------------------------------------
141;;; Checks if seq matches pattern pat in sequence, binds the pattern
142;;; variables of the first matching pattern to corresponding sublists of
143;;; seq and executes corresponding body xpr . xprs
144(define-syntax bind-case
145  (syntax-rules ()
146    ((_ seq (pat0  xpr0 . xprs0) (pat1 xpr1 . xprs1) ...)
147     (cond
148       (((bindable? pat0) seq)
149        (bind pat0 seq  xpr0 . xprs0))
150       (((bindable? pat1) seq)
151        (bind pat1 seq  xpr1 . xprs1))
152       ...
153       (else
154         (error 'bind-case (format #f "template ~s doesn't match any of the patterns ~s"
155                                   seq '(pat0 pat1 ...))))))))
156
157#|[
158The next two macros provide simultaneous setting and defining of pattern
159variables to subexpressions of a template. The following first try would
160perfectly work, if seq is simply a list, but not if it is a list wrapped
161by a let storing common state. But the latter is the most often used
162case of bind-define.
163
164(define-syntax bind-define
165  (syntax-rules ()
166    ((_ (a . b) seq)
167     (begin
168       (bind-define a (car seq))
169       (bind-define b (cdr seq))))
170    ((_ () seq)
171     (if (null? seq) (void) (error 'bind-define "match error")))
172    ((_ a seq)
173     (define a seq))))
174
175What we need is one further indirection provided in the following
176versions, which first map the pattern, pat, to some auxiliary pattern,
177aux, of the same form with gensym.
178In bind-set! the template, seq, is then bound to some variable x which
179in turn can be bound to aux in the macro expansion. Since we used gensym
180instead of rename above, there will be no name-clash - rename is
181referentially transparent!
182We could have used implicit-renaming macros as well, but then the
183gensyms would be automatically renamed again, which isn't necessary.
184Note, that there is some code duplication in the two macros below, which
185could have been avoided by defining two helpers, pmap and pflatten, in a
186separate helper module which must be imported for syntax. I've done this
187in a former version.
188]|#
189
190;;; (bind-set! pat seq)
191;;; -------------------
192;;; sets pattern variables of the pattern pat to corresponding
193;;; subexpressions of the template seq
194(define-syntax bind-set!
195  (er-macro-transformer
196    (lambda (form rename compare?)
197      (let ((pat (cadr form)) (seq (caddr form)))
198        (let ((aux (let recur ((pat pat))
199                     (cond
200                       ((null? pat) '())
201                       ((symbol? pat) (gensym))
202                       ((pair? pat)
203                        (cons (recur (car pat)) (recur (cdr pat)))))))
204              ; rename would potentially clash with the %x below
205              (%bind (rename 'bind))
206              (%set! (rename 'set!))
207              (%let (rename 'let))
208              (%x (rename 'x)))
209          `(,%let ((,%x ,seq))
210             (,%bind ,aux ,%x
211               ,@(let recur ((pat pat) (aux aux))
212                   (cond
213                     ((null? pat) '())
214                     ((symbol? pat) `((set! ,pat ,aux)))
215                     ((pair? pat)
216                      (append (recur (car pat) (car aux))
217                              (recur (cdr pat) (cdr aux)))))))))))))
218;(define-syntax bind-set!
219;  (ir-macro-transformer
220;    (lambda (form inject compare?)
221;      (let ((pat (cadr form)) (seq (caddr form)))
222;        (let ((aux (pmap gensym pat)))
223;          `(let ((x ,seq))
224;             (bind ,aux x
225;               ,@(map (lambda (p a) `(set! ,p ,a))
226;                      (pflatten pat) (pflatten aux)))))))))
227
228;;; (bind-define pat seq)
229;;; ---------------------
230;;; defines pattern variables of the pattern pat by setting them to
231;;; corresponding subexpressions of the template seq
232(define-syntax bind-define
233  (er-macro-transformer
234    (lambda (form rename compare?)
235      (let ((pat (cadr form)) (seq (caddr form)))
236        (let ((aux (let recur ((pat pat))
237                     (cond
238                       ((null? pat) '())
239                       ((symbol? pat) (gensym))
240                       ((pair? pat)
241                        (cons (recur (car pat)) (recur (cdr pat)))))))
242              (%bind-set! (rename 'bind-set!))
243              (%define (rename 'define))
244              (%begin (rename 'begin)))
245          `(,%begin
246             (,%bind-set! ,aux ,seq)
247             ,@(let recur ((pat pat) (aux aux))
248                 (cond
249                   ((null? pat) '())
250                   ((symbol? pat) `((set! ,pat ,aux)))
251                   ((pair? pat)
252                    (append (recur (car pat) (car aux))
253                            (recur (cdr pat) (cdr aux))))))))))))
254;(define-syntax bind-define
255;  (ir-macro-transformer
256;    (lambda (form inject compare?)
257;      (let ((pat (cadr form)) (seq (caddr form)))
258;        (let ((aux (pmap gensym pat)))
259;          `(begin
260;             (bind-set! ,aux ,seq)
261;             ,@(map (lambda (p a) `(define ,p ,a))
262;                    (pflatten pat) (pflatten aux))))))))
263
264;;; (bind-let* ((pat seq) ...) xpr . xprs)
265;;; --------------------------------------
266(define-syntax bind-let*
267  (syntax-rules ()
268    ((_ () xpr . xprs)
269     (let () xpr . xprs))
270    ((_ ((pat0 seq0) (pat1 seq1) ...) xpr . xprs)
271     (bind pat0 seq0
272       (bind-let* ((pat1 seq1) ...) xpr . xprs)))))
273
274;;; (bind-let ((pat seq) ...) xpr . xprs)
275;;; -------------------------------------
276(define-syntax bind-let
277  (ir-macro-transformer
278    (lambda (form inject compare?)
279      (let ((binds (cadr form))
280            (xpr (caddr form))
281            (xprs (cdddr form)))
282        (let ((syms (map (lambda (x) (gensym)) binds)))
283          `(bind ,syms ,(cons 'list (map cadr binds))
284             (bind-let* ,(map (lambda (p s) `(,p ,s))
285                              (map car binds)
286                              syms)
287               ,xpr ,@xprs)))))))
288
289;;; (bind/cc k xpr . xprs)
290;;; ----------------------
291(define-syntax bind/cc
292  (syntax-rules ()
293    ((_ k xpr . xprs)
294     (call-with-current-continuation
295       (lambda (k) xpr . xprs)))))
296
297#|[
298Low-level-macros made easy
299==========================
300As an application of our binding macros, especially bind, we will now
301provide macros define-macro, letrec-macro and let-macro to make
302low-level macros easy.
303
304The following two macros are internal. They are only used in
305define-macro below
306]|#
307
308;;; (define-ir-macro (name . args)
309;;;   (injecting (identifier ...)
310;;;     (comparing ()|(suffix . suffixed-keywords)
311;;;       . body)))
312;;; -------------------------------------------------
313;;; where transformer is a unary procedure accepting
314;;; ir-macro-transformer' s last parameter, compare?
315(define-syntax define-ir-macro
316  (ir-macro-transformer
317    (lambda (f i c?)
318      (let ((macro-code (cadr f))
319            (inject-xpr (caddr f))
320            (strip-suffix
321              (lambda (suf id)
322                (let ((sufstring (symbol->string suf))
323                      (idstring (symbol->string id)))
324                  (string->symbol
325                    (substring idstring
326                               0 
327                               (- (string-length idstring)
328                                  (string-length sufstring))))))))
329        (let ((name (car macro-code))
330              (args (cdr macro-code))
331              (identifiers (cadr inject-xpr))
332              (compare-xpr (caddr inject-xpr)))
333          (let ((predicates (cadr compare-xpr))
334                (body (caddr compare-xpr)))
335            (cond
336              ((and (null? identifiers) (null? predicates))
337               `(define-syntax ,name
338                  (ir-macro-transformer
339                    (lambda (form inject compare?)
340                      (bind ,args (cdr form)
341                        ,body)))))
342              ((null? predicates)
343               `(define-syntax ,name
344                  (ir-macro-transformer
345                    (lambda (form inject compare?)
346                      (bind ,args (cdr form)
347                        (bind ,identifiers (map inject ',identifiers)
348                          ,body))))))
349              (else
350                (let ((suffix (car predicates))
351                      (suffixed-keywords (cdr predicates)))
352                  (let ((syms (map (lambda (id) (strip-suffix suffix id))
353                                   suffixed-keywords)))
354                    (if (null? identifiers)
355                      `(define-syntax ,name
356                         (ir-macro-transformer
357                           (lambda (form inject compare?)
358                             (bind ,args (cdr form)
359                               (bind ,suffixed-keywords
360                                 (list ,@(map (lambda (s)
361                                                `(lambda (n)
362                                                   (compare? n ',(i s))))
363                                              syms))
364                                 ,body)))))
365                      `(define-syntax ,name
366                         (ir-macro-transformer
367                           (lambda (form inject compare?)
368                             (bind ,args (cdr form)
369                               (bind ,identifiers (map inject ',identifiers)
370                                 (bind ,suffixed-keywords
371                                   (list ,@(map (lambda (s)
372                                                  `(lambda (n)
373                                                     (compare? n ',(i s))))
374                                                syms))
375                                   ,body)))))))))))))))))
376
377;;; (define-er-macro (name . args)
378;;;   (renaming (prefix . prefixed-identifiers)
379;;;     (comparing ()|(suffix . suffixed-keywords)
380;;;     . body)))
381;;; -------------------------------------------------
382;;; where transformer is a unary procedure accepting
383;;; er-macro-transformer' s last parameter, compare?
384(define-syntax define-er-macro
385  (er-macro-transformer
386    (lambda (f r c?)
387      (let ((macro-code (cadr f))
388            (rename-xpr (caddr f))
389            (strip-prefix (lambda (pre id)
390                            (string->symbol
391                              (substring (symbol->string id)
392                                         (string-length
393                                           (symbol->string pre))))))
394            (strip-suffix
395              (lambda (suf id)
396                (let ((sufstring (symbol->string suf))
397                      (idstring (symbol->string id)))
398                  (string->symbol
399                    (substring idstring
400                               0 
401                               (- (string-length idstring)
402                                  (string-length sufstring))))))))
403        (let ((name (car macro-code))
404              (args (cdr macro-code))
405              (prefix (caadr rename-xpr))
406              (prefixed-identifiers (cdadr rename-xpr))
407              (compare-xpr (caddr rename-xpr)))
408          (let ((identifiers (map (lambda (id) (strip-prefix prefix id))
409                                  prefixed-identifiers))
410                (predicates (cadr compare-xpr))
411                (body (caddr compare-xpr))
412                (%er-macro-transformer (r 'er-macro-transformer))
413                (%define-syntax (r 'define-syntax))
414                (%compare? (r 'compare?))
415                (%rename (r 'rename))
416                (%lambda (r 'lambda))
417                (%bind (r 'bind))
418                (%list (r 'list))
419                (%form (r 'form))
420                (%cdr (r 'cdr))
421                (%map (r 'map)))
422            (if (null? predicates)
423              `(,%define-syntax ,name
424                  (,%er-macro-transformer
425                    (,%lambda (,%form ,%rename ,%compare?)
426                      (,%bind ,args (,%cdr ,%form)
427                              (,%bind ,prefixed-identifiers
428                                      (,%map ,%rename ',identifiers)
429                                ,body)))))
430              (let ((suffix (car predicates))
431                    (suffixed-keywords (cdr predicates)))
432                (let ((syms (map (lambda (id) (strip-suffix suffix id))
433                                 suffixed-keywords)))
434                  `(,%define-syntax ,name
435                      (,%er-macro-transformer
436                        (,%lambda (,%form ,%rename ,%compare?)
437                          (,%bind ,args (,%cdr ,%form)
438                            (,%bind ,prefixed-identifiers
439                                    (,%map ,%rename ',identifiers)
440                              (,%bind ,suffixed-keywords
441                                      (,%list ,@(map (lambda (s)
442                                                       `(lambda (n)
443                                                          (,%compare? n (,%rename ',s))))
444                                                     syms))
445                                      ,body)))))))))))))))
446
447;;; (define-macro (name . args)
448;;;   [(injecting (identifier ...) | (renaming (prefix . prefixed-identifiers))]
449;;;     [(comaring (suffix . suffixed-keywords)]
450;;;       . body)))
451;;; ----------------------------------------------------------------------------
452(define-syntax define-macro
453  (ir-macro-transformer 
454    (lambda (form inject compare?)
455      (if (not (= (length form) 3))
456        (error 'define-macro "macro-code doesn't match pattern"
457               '(_ macro-code body))
458        (let ((macro-code (cadr form)) (body (caddr form)))
459          ;; create standard body
460          (let ((body (if (and (list? body)
461                               (= (length body) 3)
462                               (list? (cadr body)))
463                        (cond
464                          ((compare? (car body) 'comparing)
465                           `(injecting () ,body))
466                          ((compare? (car body) 'injecting)
467                           (let ((rest (caddr body)))
468                             (if (and (list? rest)
469                                      (= (length rest) 3)
470                                      (list? (cadr rest))
471                                      (compare? (car rest) 'comparing))
472                               body
473                               `(injecting ,(cadr body)
474                                  (comparing () ,(caddr body))))))
475                          ((compare? (car body) 'renaming)
476                           (let ((rest (caddr body)))
477                             (if (and (list? rest)
478                                      (= (length rest) 3)
479                                      (list? (cadr rest))
480                                      (compare? (car rest) 'comparing))
481                               body
482                               `(renaming ,(cadr body)
483                                 (comparing () ,(caddr body))))))
484                          (else
485                            (error 'define-macro "not a macro body" body)))
486                        `(injecting ()
487                          (comparing () ,body)))))
488            (if (compare? (car body) 'injecting)
489              `(define-ir-macro ,macro-code ,body)
490              `(define-er-macro ,macro-code ,body))))))))
491
492;;; (letrec-macro ((macro-code tpl) ...) . body)
493;;; --------------------------------------------
494;;; defines local macros by binding recursively macro-codes to templates
495;;; and evaluating body in this context.
496(define-syntax letrec-macro
497  (er-macro-transformer
498    (lambda (f r c?)
499      (let ((binds (cadr f))
500            (body (cddr f))
501            (%letrec-syntax (r 'letrec-syntax)))
502        `(,%letrec-syntax
503           ,(map (lambda (m)
504                   `(,(cadr m) ,(caddr m)))
505                 (map (lambda (b)
506                        (expand `(define-macro ,@b)))
507                      binds))
508           ,@body)))))
509
510;;; (let-macro ((macro-code tpl) ...) . body)
511;;; -----------------------------------------
512;;; defines local macros by binding in parallel macro-codes to templates
513;;; and evaluating body in this context.
514(define-syntax let-macro
515  (er-macro-transformer
516    (lambda (f r c?)
517      (let ((binds (cadr f))
518            (body (cddr f))
519            (%let-syntax (r 'let-syntax)))
520        `(,%let-syntax
521           ,(map (lambda (m)
522                   `(,(cadr m) ,(caddr m)))
523                 (map (lambda (b)
524                        (expand `(define-macro ,@b)))
525                      binds))
526           ,@body)))))
527
528;;; (macro-rules sym ... (suffix suffixed-keyword ...)
529;;;   (pat0 tpl0) (pat1 tpl1) ...)
530;;; --------------------------------------------------
531;;; where sym ... are injected non-hygienig symbols, the keyword-list is
532;;; either empty or of the form (? sym? ...) with a predicates sym? ...
533;;; checking for their own names with the suffix ? stripped, pat0 pat1
534;;; ... are like syntax-rules patterns, but tpl0 tpl1 ... evaluate to
535;;; quasiquoted templates.
536(define-syntax macro-rules
537  (ir-macro-transformer
538    (lambda (f i c?)
539      ;; head is list of injected syms, tail starts with keyword-list
540      (let (
541        (tail-head
542          (call-with-values
543            (lambda ()
544              (let loop ((tail (cdr f)) (head '()))
545                (if (or (null? tail) (list? (car tail)))
546                  (values tail head)
547                  (loop (cdr tail) (cons (car tail) head)))))
548            list))
549        )
550        (let ((tail (car tail-head)) (head (cadr tail-head)))
551          (let ((keywords (car tail)) (rule (cadr tail)) (rules (cddr tail)))
552            (let (
553              (keyword-query (lambda (skey)
554                               `(,skey (lambda (x)
555                                         (compare? x
556                                                   (strip ',(car keywords)
557                                                          ',skey))))))
558              (inject-it (lambda (h) `(,h (inject ',h))))
559              )
560              (cond
561                ((and (null? head) (null? keywords))
562                 ; no injected symbols, no additional keywords
563                 `(ir-macro-transformer
564                    (lambda (form inject compare?)
565                      (bind-case form ,rule ,@rules))))
566                ((null? head)
567                 ; no injected symbols
568                 `(ir-macro-transformer
569                    (lambda (form inject compare?)
570                      (let ,(map keyword-query
571                                 (cdr keywords))
572                        (bind-case form ,rule ,@rules)))))
573                ((null? keywords)
574                 ;; no additional keywords
575                 `(ir-macro-transformer
576                    (lambda (form inject compare?)
577                      (let ,(map inject-it head)
578                        (bind-case form ,rule ,@rules)))))
579                (else
580                  `(ir-macro-transformer
581                     (lambda (form inject compare?)
582                       (let ,(append
583                               (map inject-it head)
584                               (map keyword-query (cdr keywords)))
585                         (bind-case form ,rule ,@rules)))))))))))))
586  ;; unfortunately, this simpler implementation doesn't work because of
587  ;; two ellipses at the same nesting level
588  ;  (syntax-rules ()
589  ;    ((_ injected-sym ... (suffix suffixed-keyword ...)
590  ;        ((pat0 tpl0)
591  ;        (pat1 tpl1)
592  ;        ...)
593  ;     (ir-macro-transformer
594  ;         (lambda (form inject compare?)
595  ;           (let ((injected-sym (inject 'injected-sym))
596  ;                 ...
597  ;                 (suffixed-keyword
598  ;                   (lambda (x) (compare? x (strip suffix
599  ;                                                  suffixed-keyword))))
600  ;                 ...)
601  ;             (bind-case form
602  ;               (pat0 tpl0) (pat1 tpl1) ...)))))
603  ;    ((_ sym ... () (pat0 tpl0) (pat1 tpl1) ...)
604  ;     (ir-macro-transformer sym ... (suffix) (pat0 tpl0) (pat1 tpl1) ...))
605  ;    ))
606
607(define (strip s skey)
608  (let ((s-str (symbol->string s))
609        (skey-str (symbol->string skey)))
610    (string->symbol
611      (substring skey-str 0 (- (string-length skey-str)
612                               (string-length s-str))))))
613
614;;; (define-syntax-rule (macro-code) tpl)
615;;; -------------------------------------
616;;; simplyfies define-syntax in case there are no auxiliary keywords
617;;; and only one syntax-rule.
618(define-syntax define-syntax-rule
619  (syntax-rules ()
620    ((_ (name . args) tpl)
621     (define-syntax name
622       (syntax-rules ()
623         ((_ . args) tpl))))))
624
625(define (list-bindings)
626  '(bind-define bind-set! bind bind-lambda bind-let* bind-let bind-case bindable? bind/cc
627    macro-rules define-macro let-macro letrec-macro define-syntax-rule))
628
629) ; module list-bindings
630
Note: See TracBrowser for help on using the repository browser.