From db04688faa20f3576257c0fe41752ec435beab9a Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:25 -0800 Subject: Import Upstream version 5c3 --- Macro.scm | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 2 deletions(-) (limited to 'Macro.scm') diff --git a/Macro.scm b/Macro.scm index f053b9c..76fc495 100644 --- a/Macro.scm +++ b/Macro.scm @@ -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))))) -- cgit v1.2.3