New syntax DEFINE-GUARANTEE.

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index 77dc12cbeb7426d608653b46b42fb80823439753..2ab691431733ba9b803cf27a2a460e81f4571212 100644 (file)
--- a/v7/src/runtime/arith.scm
+++ b/v7/src/runtime/arith.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: arith.scm,v 1.61 2004/10/13 03:22:40 cph Exp $
+$Id: arith.scm,v 1.62 2005/01/11 03:56:44 cph Exp $
 
 Copyright 1989,1990,1991,1992,1993,1994 Massachusetts Institute of Technology
 Copyright 1995,1996,1997,1999,2001,2002 Massachusetts Institute of Technology
-Copyright 2003,2004 Massachusetts Institute of Technology
+Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -1813,17 +1813,6 @@ USA.
   (and (int:integer? object)
        (int:positive? object)))
 
-(define-syntax define-guarantee
-  (sc-macro-transformer
-   (lambda (form environment)
-     `(DEFINE (,(symbol-append 'GUARANTEE- (cadr form)) OBJECT OPERATOR)
-       (IF (NOT (,(symbol-append (cadr form) '?) OBJECT))
-           (ERROR:WRONG-TYPE-ARGUMENT OBJECT
-                                      ,(close-syntax (caddr form)
-                                                     environment)
-                                      OPERATOR))
-       OBJECT))))
-
 (define-guarantee number "number")
 (define-guarantee complex "complex number")
 (define-guarantee real "real number")

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index e565d3754a8d7dcac077ec79778475c661965071..9c1726b8d618bce66a9407a1d6e4cdc1f594a63d 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.526 2005/01/07 15:10:06 cph Exp $
+$Id: runtime.pkg,v 14.527 2005/01/11 03:57:00 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -3931,6 +3931,7 @@ USA.
   (files "sysmac")
   (parent (runtime))
   (export (runtime)
+         define-guarantee
          define-primitives
          ucode-primitive
          ucode-return-address

diff --git a/v7/src/runtime/sfile.scm b/v7/src/runtime/sfile.scm
index e4771805d8045f9be1975b058ace32c9d6f0d2ca..814e365a982802a5e2005b9160264b0a09bf725e 100644 (file)
--- a/v7/src/runtime/sfile.scm
+++ b/v7/src/runtime/sfile.scm
@@ -1,9 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: sfile.scm,v 14.39 2004/10/29 16:30:25 cph Exp $
+$Id: sfile.scm,v 14.40 2005/01/11 03:57:16 cph Exp $
 
 Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
-Copyright 1999,2001,2003,2004 Massachusetts Institute of Technology
+Copyright 1999,2001,2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -373,23 +373,6 @@ USA.
            i)
        end)))
 
-(define-syntax define-guarantee
-  (sc-macro-transformer
-   (lambda (form environment)
-     (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form))
-        (let ((root (cadr form))
-              (desc (close-syntax (caddr form) environment)))
-          (let ((p-name (symbol root '?))
-                (g-name (symbol 'guarantee- root))
-                (e-name (symbol 'error:not- root)))
-            `(BEGIN
-               (DEFINE (,g-name OBJECT CALLER)
-                 (IF (NOT (,(close-syntax p-name environment) OBJECT))
-                     (,(close-syntax e-name environment) OBJECT CALLER)))
-               (DEFINE (,e-name OBJECT CALLER)
-                 (ERROR:WRONG-TYPE-ARGUMENT OBJECT ,desc CALLER)))))
-        (ill-formed-syntax form)))))
-
 (define-guarantee mime-type "MIME type")
 (define-guarantee mime-type-string "MIME type string")
 (define-guarantee mime-token "MIME token")

diff --git a/v7/src/runtime/sysmac.scm b/v7/src/runtime/sysmac.scm
index 43136f256812fb5b575df0c51b13ec6d6f18168c..32d7924ed6ce583638bf1ed88f080a8a009c3b39 100644 (file)
--- a/v7/src/runtime/sysmac.scm
+++ b/v7/src/runtime/sysmac.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: sysmac.scm,v 14.12 2003/02/14 18:28:34 cph Exp $
+$Id: sysmac.scm,v 14.13 2005/01/11 03:57:23 cph Exp $
 
-Copyright (c) 1988, 1999, 2001, 2002 Massachusetts Institute of Technology
+Copyright 1988,2001,2002,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -61,4 +61,21 @@ USA.
   (sc-macro-transformer
    (lambda (form environment)
      environment
-     (make-return-address (apply microcode-return (cdr form))))))
\ No newline at end of file
+     (make-return-address (apply microcode-return (cdr form))))))
+
+(define-syntax define-guarantee
+  (sc-macro-transformer
+   (lambda (form environment)
+     (if (syntax-match? '(SYMBOL EXPRESSION) (cdr form))
+        (let ((root (cadr form))
+              (desc (close-syntax (caddr form) environment)))
+          (let ((p-name (symbol root '?))
+                (g-name (symbol 'guarantee- root))
+                (e-name (symbol 'error:not- root)))
+            `(BEGIN
+               (DEFINE (,g-name OBJECT CALLER)
+                 (IF (NOT (,(close-syntax p-name environment) OBJECT))
+                     (,(close-syntax e-name environment) OBJECT CALLER)))
+               (DEFINE (,e-name OBJECT CALLER)
+                 (ERROR:WRONG-TYPE-ARGUMENT OBJECT ,desc CALLER)))))
+        (ill-formed-syntax form)))))
\ No newline at end of file