From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 2 May 2018 06:45:02 +0000 (-0700)
Subject: Implement finite?, infinite?, and nan? from R7RS.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~81
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9ee1afb420e5bf8b9ab8db7f1fa994488ec20ddf;p=mit-scheme.git

Implement finite?, infinite?, and nan? from R7RS.
---

diff --git a/src/runtime/arith.scm b/src/runtime/arith.scm
index 87e6c11b5..6ca9e1de2 100644
--- a/src/runtime/arith.scm
+++ b/src/runtime/arith.scm
@@ -937,6 +937,15 @@ USA.
        (or (rat:rational? x)
 	   (error:wrong-type-argument x #f 'exact?))))
 
+(define (real:finite? x)
+  (if (flonum? x) (flo:finite? x) #t))
+
+(define (real:infinite? x)
+  (if (flonum? x) (flo:infinite? x) #f))
+
+(define (real:nan? x)
+  (if (flonum? x) (flo:nan? x) #f))
+
 (define (real:zero? x)
   (if (flonum? x) (flo:zero? x) ((copy rat:zero?) x)))
 
@@ -1301,6 +1310,33 @@ USA.
   (and (real:exact? (rec:real-part z))
        (real:exact? (rec:imag-part z))))
 
+(define (complex:finite? z)
+  (if (recnum? z)
+      ((copy rec:finite?) z)
+      ((copy real:finite?) z)))
+
+(define (rec:finite? z)
+  (and (real:finite? (rec:real-part z))
+       (real:finite? (rec:imag-part z))))
+
+(define (complex:infinite? z)
+  (if (recnum? z)
+      ((copy rec:infinite?) z)
+      ((copy real:infinite?) z)))
+
+(define (rec:infinite? z)
+  (or (real:infinite? (rec:real-part z))
+      (real:infinite? (rec:imag-part z))))
+
+(define (complex:nan? z)
+  (if (recnum? z)
+      ((copy rec:nan?) z)
+      ((copy real:nan?) z)))
+
+(define (rec:nan? z)
+  (or (real:nan? (rec:real-part z))
+      (real:nan? (rec:imag-part z))))
+
 (define (complex:real-arg name x)
   (if (recnum? x) (rec:real-arg name x) x))
 
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 378feabb2..9747d4e4c 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3272,11 +3272,13 @@ USA.
 	  (exact? complex:exact?)
 	  (exp complex:exp)
 	  (expt complex:expt)
+	  (finite? complex:finite?)
 	  (floor complex:floor)
 	  (floor->exact complex:floor->exact)
 	  (imag-part complex:imag-part)
 	  (inexact complex:exact->inexact)
 	  (inexact->exact complex:inexact->exact)
+	  (infinite? complex:infinite?)
 	  (integer-ceiling complex:integer-ceiling)
 	  (integer-divide complex:divide)
 	  (integer-floor complex:integer-floor)
@@ -3287,6 +3289,7 @@ USA.
 	  (magnitude complex:magnitude)
 	  (make-polar complex:make-polar)
 	  (make-rectangular complex:make-rectangular)
+	  (nan? complex:nan?)
 	  (negative? complex:negative?)
 	  (number:eqv? complex:eqv?)
 	  (number? complex:complex?)