diff options
author | David N. Welton <davidw@efn.org> | 1998-12-11 20:21:49 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:25 -0800 |
commit | a47af30d2f0e96afcd1f14b1984575c359faa3d6 (patch) | |
tree | 2ed08ce2d757f917de7c3c7c04fd7e309f454c83 /Macro.scm | |
parent | f64b2806c1d66a1341bb8b1491f384169ab1d65f (diff) | |
parent | db04688faa20f3576257c0fe41752ec435beab9a (diff) | |
download | scm-a47af30d2f0e96afcd1f14b1984575c359faa3d6.tar.gz scm-a47af30d2f0e96afcd1f14b1984575c359faa3d6.zip |
Import Debian changes 5c3-5debian/5c3-5
scm (5c3-5) frozen unstable; urgency=low
* debian/rules chmod +x's bld.scm. Fixes #30521.
scm (5c3-4) frozen unstable; urgency=low
* Made bld.scm executable. Fixes #29578.
scm (5c3-3) frozen unstable; urgency=low
* -nw
* Fixes #16762.
* Fixes #18163.
* Fixes #18164.
* Fixes #23743.
* Fixes #24098.
* Fixes #24099.
* Fixes #24547.
scm (5c3-2) frozen unstable; urgency=low
* Re-uploading for slink freeze.
scm (5c3-1) unstable; urgency=low
* New upstream version.
Diffstat (limited to 'Macro.scm')
-rw-r--r-- | Macro.scm | 60 |
1 files changed, 58 insertions, 2 deletions
@@ -1,4 +1,45 @@ -;; Support for R4RS macros. +;; Copyright (C) 1997, 1998 Free Software Foundation, Inc. +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this software; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; +;; As a special exception, the Free Software Foundation gives permission +;; for additional uses of the text contained in its release of GUILE. +;; +;; The exception is that, if you link the GUILE library with other files +;; to produce an executable, this does not by itself cause the +;; resulting executable to be covered by the GNU General Public License. +;; Your use of that executable is in no way restricted on account of +;; linking the GUILE library code into it. +;; +;; This exception does not however invalidate any other reasons why +;; the executable file might be covered by the GNU General Public License. +;; +;; This exception applies only to the code released by the +;; Free Software Foundation under the name GUILE. If you copy +;; code from other Free Software Foundation releases into a copy of +;; GUILE, as the General Public License permits, the exception does +;; not apply to the code that you add in this way. To avoid misleading +;; anyone as to the status of such modified files, you must delete +;; this exception notice from them. +;; +;; If you write modifications of your own for GUILE, it is your choice +;; whether to permit this exception to apply to your modifications. +;; If you do not wish that, delete this exception notice. + +;;;; "Macro.scm", Support for syntax-rules macros. +;;; Author: Radey Shouman ;; ;; As in SYNTAX-CASE, the identifier ... may be quoted in a ;; SYNTAX-RULES pattern or template as (... ...). @@ -98,7 +139,13 @@ (recur (cdr pat) vars rank (lambda (comp2 vars2) (k (cons comp1 comp2) - (append2 vars1 vars2))))))))))) + (append2 vars1 vars2)))))))) + ((vector? pat) + (recur (vector->list pat) vars rank + (lambda (comp vars) + (k (list->vector comp) vars)))) + (else + (k pat vars))))) (define (rewrite-template template vars env-def) (let recur ((tmpl template) @@ -146,6 +193,10 @@ (k (cons comp1 comp2) (append2 ins1 ins2) (append2 op1 op2)))))))) + ((vector? tmpl) + (recur (vector->list tmpl) rank inserted + (lambda (compiled inserted opened) + (k (list->vector compiled) inserted opened)))) (else (k tmpl '() '()))))) @@ -187,6 +238,9 @@ '())) ((pattern-variable? r) (list (cons r x))) + ((vector? r) + (and (vector? x) + (recur (vector->list r) (vector->list x)))) (else (and (equal? r x) '()))))) @@ -221,6 +275,8 @@ (if a (cdr a) tmpl))) ((pattern-variable? tmpl) (@copy-tree (cdr (assq tmpl vars)))) + ((vector? tmpl) + (list->vector (recur (vector->list tmpl) vars))) (else tmpl))))) |