Fix bug: check type of arguments to MAKE-RECTANGULAR and MAKE-POLAR,

allowing exactly those numbers that satisfy REAL?.

diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm
index 002057820e1747ab7b844302411d3cef7d9cc438..d8660e38401a9572fbaaf24802875f056aac7835 100644 (file)
--- a/v7/src/runtime/arith.scm
+++ b/v7/src/runtime/arith.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/arith.scm,v 1.18 1991/03/06 05:04:37 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/arith.scm,v 1.19 1991/04/26 02:39:56 cph Exp $
 
 Copyright (c) 1989-91 Massachusetts Institute of Technology
 
@@ -1031,9 +1031,9 @@ MIT in each case. |#
   (if (recnum? x) (rec:real-arg name x) x))
 
 (define (rec:real-arg name x)
-  (if (real:zero? (rec:imag-part x))
-      (rec:real-part x)
-      (error:wrong-type-argument x false name)))
+  (if (not (real:zero? (rec:imag-part x)))
+      (error:wrong-type-argument x false name))
+  (rec:real-part x))
 
 (define (complex:= z1 z2)
   (if (recnum? z1)
@@ -1099,7 +1099,7 @@ MIT in each case. |#
 (define (complex:+ z1 z2)
   (if (recnum? z1)
       (if (recnum? z2)
-         (complex:make-rectangular
+         (complex:%make-rectangular
           (real:+ (rec:real-part z1) (rec:real-part z2))
           (real:+ (rec:imag-part z1) (rec:imag-part z2)))
          (make-recnum (real:+ (rec:real-part z1) z2)
@@ -1126,32 +1126,32 @@ MIT in each case. |#
                (z1i (rec:imag-part z1))
                (z2r (rec:real-part z2))
                (z2i (rec:imag-part z2)))
-           (complex:make-rectangular
+           (complex:%make-rectangular
             (real:- (real:* z1r z2r) (real:* z1i z2i))
             (real:+ (real:* z1r z2i) (real:* z1i z2r))))
-         (complex:make-rectangular (real:* (rec:real-part z1) z2)
-                                   (real:* (rec:imag-part z1) z2)))
+         (complex:%make-rectangular (real:* (rec:real-part z1) z2)
+                                    (real:* (rec:imag-part z1) z2)))
       (if (recnum? z2)
-         (complex:make-rectangular (real:* z1 (rec:real-part z2))
-                                   (real:* z1 (rec:imag-part z2)))
+         (complex:%make-rectangular (real:* z1 (rec:real-part z2))
+                                    (real:* z1 (rec:imag-part z2)))
          ((copy real:*) z1 z2))))
 
 (define (complex:+i* z)
   (if (recnum? z)
-      (complex:make-rectangular (real:negate (rec:imag-part z))
-                               (rec:real-part z))
-      (complex:make-rectangular 0 z)))
+      (complex:%make-rectangular (real:negate (rec:imag-part z))
+                                (rec:real-part z))
+      (complex:%make-rectangular 0 z)))
 
 (define (complex:-i* z)
   (if (recnum? z)
-      (complex:make-rectangular (rec:imag-part z)
-                               (real:negate (rec:real-part z)))
-      (complex:make-rectangular 0 (real:negate z))))
+      (complex:%make-rectangular (rec:imag-part z)
+                                (real:negate (rec:real-part z)))
+      (complex:%make-rectangular 0 (real:negate z))))
 \f
 (define (complex:- z1 z2)
   (if (recnum? z1)
       (if (recnum? z2)
-         (complex:make-rectangular
+         (complex:%make-rectangular
           (real:- (rec:real-part z1) (rec:real-part z2))
           (real:- (rec:imag-part z1) (rec:imag-part z2)))
          (make-recnum (real:- (rec:real-part z1) z2)
@@ -1184,7 +1184,7 @@ MIT in each case. |#
                (z2r (rec:real-part z2))
                (z2i (rec:imag-part z2)))
            (let ((d (real:+ (real:square z2r) (real:square z2i))))
-             (complex:make-rectangular
+             (complex:%make-rectangular
               (real:/ (real:+ (real:* z1r z2r) (real:* z1i z2i)) d)
               (real:/ (real:- (real:* z1i z2r) (real:* z1r z2i)) d))))
          (make-recnum (real:/ (rec:real-part z1) z2)
@@ -1193,7 +1193,7 @@ MIT in each case. |#
          (let ((z2r (rec:real-part z2))
                (z2i (rec:imag-part z2)))
            (let ((d (real:+ (real:square z2r) (real:square z2i))))
-             (complex:make-rectangular
+             (complex:%make-rectangular
               (real:/ (real:* z1 z2r) d)
               (real:/ (real:negate (real:* z1 z2i)) d))))
          ((copy real:/) z1 z2))))
@@ -1310,14 +1310,14 @@ MIT in each case. |#
 \f
 (define (complex:exp z)
   (if (recnum? z)
-      (complex:make-polar (real:exp (rec:real-part z))
-                         (rec:imag-part z))
+      (complex:%make-polar (real:exp (rec:real-part z))
+                          (rec:imag-part z))
       ((copy real:exp) z)))
 
 (define (complex:log z)
   (cond ((recnum? z)
-        (complex:make-rectangular (real:log (complex:magnitude z))
-                                  (complex:angle z)))
+        (complex:%make-rectangular (real:log (complex:magnitude z))
+                                   (complex:angle z)))
        ((real:negative? z)
         (make-recnum (real:log (real:negate z)) rec:pi))
        (else
@@ -1416,12 +1416,32 @@ MIT in each case. |#
                          (complex:log (complex:- 1 iz))))
             +2i))
 \f
+(define (complex:angle z)
+  (cond ((recnum? z)
+        (if (and (real:zero? (rec:real-part z))
+                 (real:zero? (rec:imag-part z)))
+            (real:0 (complex:exact? z))
+            (real:atan2 (rec:imag-part z) (rec:real-part z))))
+       ((real:negative? z) rec:pi)
+       (else (real:0 (real:exact? z)))))
+
+(define (complex:magnitude z)
+  (if (recnum? z)
+      (let ((ar (real:abs (rec:real-part z)))
+           (ai (real:abs (rec:imag-part z))))
+       (let ((v (real:max ar ai))
+             (w (real:min ar ai)))
+         (if (real:zero? v)
+             v
+             (real:* v (real:sqrt (real:1+ (real:square (real:/ w v))))))))
+      (real:abs z)))
+
 (define (complex:sqrt z)
   (cond ((recnum? z)
-        (complex:make-polar (real:sqrt (complex:magnitude z))
-                            (real:/ (complex:angle z) 2)))
+        (complex:%make-polar (real:sqrt (complex:magnitude z))
+                             (real:/ (complex:angle z) 2)))
        ((real:negative? z)
-        (complex:make-rectangular 0 (real:sqrt (real:negate z))))
+        (complex:%make-rectangular 0 (real:sqrt (real:negate z))))
        (else
         ((copy real:sqrt) z))))
 
@@ -1461,13 +1481,28 @@ MIT in each case. |#
           (real:expt z1 z2)))))
 \f
 (define (complex:make-rectangular real imag)
+  (let ((check-arg
+        (lambda (x)
+          (if (recnum? x)
+              (rec:real-arg 'MAKE-RECTANGULAR x)
+              (begin
+                (if (not (real:real? x))
+                    (error:wrong-type-argument x false 'MAKE-RECTANGULAR))
+                x)))))
+    ((copy complex:%make-rectangular) (check-arg real) (check-arg imag))))
+
+(define (complex:make-polar real imag)
+  ((copy complex:%make-polar) (complex:real-arg 'MAKE-POLAR real)
+                             (complex:real-arg 'MAKE-POLAR imag)))
+
+(define (complex:%make-rectangular real imag)
   (if (real:exact0= imag)
       real
       (make-recnum real imag)))
 
-(define (complex:make-polar magnitude angle)
-  (complex:make-rectangular (real:* magnitude (real:cos angle))
-                           (real:* magnitude (real:sin angle))))
+(define (complex:%make-polar magnitude angle)
+  (complex:%make-rectangular (real:* magnitude (real:cos angle))
+                            (real:* magnitude (real:sin angle))))
 
 (define (complex:real-part z)
   (cond ((recnum? z) (rec:real-part z))
@@ -1479,36 +1514,16 @@ MIT in each case. |#
        ((real:real? z) 0)
        (else (error:wrong-type-argument z false 'IMAG-PART))))
 
-(define (complex:magnitude z)
-  (if (recnum? z)
-      (let ((ar (real:abs (rec:real-part z)))
-           (ai (real:abs (rec:imag-part z))))
-       (let ((v (real:max ar ai))
-             (w (real:min ar ai)))
-         (if (real:zero? v)
-             v
-             (real:* v (real:sqrt (real:1+ (real:square (real:/ w v))))))))
-      (real:abs z)))
-
-(define (complex:angle z)
-  (cond ((recnum? z)
-        (if (and (real:zero? (rec:real-part z))
-                 (real:zero? (rec:imag-part z)))
-            (real:0 (complex:exact? z))
-            (real:atan2 (rec:imag-part z) (rec:real-part z))))
-       ((real:negative? z) rec:pi)
-       (else (real:0 (real:exact? z)))))
-
 (define (complex:exact->inexact z)
   (if (recnum? z)
-      (complex:make-rectangular (real:exact->inexact (rec:real-part z))
-                               (real:exact->inexact (rec:imag-part z)))
+      (complex:%make-rectangular (real:exact->inexact (rec:real-part z))
+                                (real:exact->inexact (rec:imag-part z)))
       ((copy real:exact->inexact) z)))
 
 (define (complex:inexact->exact z)
   (if (recnum? z)
-      (complex:make-rectangular (real:inexact->exact (rec:real-part z))
-                               (real:inexact->exact (rec:imag-part z)))
+      (complex:%make-rectangular (real:inexact->exact (rec:real-part z))
+                                (real:inexact->exact (rec:imag-part z)))
       ((copy real:inexact->exact) z)))
 
 (define (complex:->string z radix)