Implement GUARANTEE-* for number types.

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index ab6c15e6a0b81446b9893221bb467abda30c7d7e..f9fb625f174a9ab95c828dd3eb43fbfe96c209cf 100644 (file)
--- a/v7/src/runtime/arith.scm
+++ b/v7/src/runtime/arith.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: arith.scm,v 1.51 2002/11/20 19:46:18 cph Exp $
+$Id: arith.scm,v 1.52 2003/01/01 02:35:50 cph Exp $
 
 Copyright (c) 1989-1999, 2001, 2002 Massachusetts Institute of Technology
 
@@ -1787,6 +1787,28 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 (define (inexact? z)
   (not (complex:exact? z)))
 
+(let-syntax
+    ((define-guarantee
+       (sc-macro-transformer
+       (lambda (form environment)
+         `(DEFINE (,(symbol-append 'GUARANTEE- (car form)) OBJECT OPERATOR)
+            (IF (NOT (,(symbol-append (car form) '?) OBJECT))
+                (ERROR:WRONG-TYPE-ARGUMENT OBJECT
+                                           ,(close-syntax (cadr form)
+                                                          environment)
+                                           OPERATOR))
+            OBJECT)))))
+  (define-guarantee number "number")
+  (define-guarantee complex "complex number")
+  (define-guarantee real "real number")
+  (define-guarantee rational "rational number")
+  (define-guarantee integer "integer")
+  (define-guarantee exact "exact number")
+  (define-guarantee exact-rational "exact rational number")
+  (define-guarantee exact-integer "exact integer")
+  (define-guarantee exact-nonnegative-integer "exact non-negative integer")
+  (define-guarantee inexact "inexact number"))
+\f
 ;; Replaced with arity-dispatched version in INITIALIZE-PACKAGE!
 
 (define =)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index bc4881becc572c50496155cac9de227cf53c9393..3b6c60924887fbd9da27c8c11ece9ea8000c96dc 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.417 2002/12/09 05:39:38 cph Exp $
+$Id: runtime.pkg,v 14.418 2003/01/01 02:36:10 cph Exp $
 
 Copyright (c) 1988-2002 Massachusetts Institute of Technology
 
@@ -2221,6 +2221,16 @@ Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
          floor
          floor->exact
          gcd
+         guarantee-complex
+         guarantee-exact
+         guarantee-exact-integer
+         guarantee-exact-nonnegative-integer
+         guarantee-exact-rational
+         guarantee-inexact
+         guarantee-integer
+         guarantee-number
+         guarantee-rational
+         guarantee-real
          imag-part
          inexact->exact
          inexact?