From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 1 Jan 2003 02:36:10 +0000 (+0000)
Subject: Implement GUARANTEE-* for number types.
X-Git-Tag: 20090517-FFI~2083
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=594cf951fb54945d760d58efd9de104a20d2d2b4;p=mit-scheme.git

Implement GUARANTEE-* for number types.
---

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index ab6c15e6a..f9fb625f1 100644
--- 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"))
+
 ;; Replaced with arity-dispatched version in INITIALIZE-PACKAGE!
 
 (define =)
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index bc4881bec..3b6c60924 100644
--- 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?