From 4eb27be43cf0380dd93a0947a519ec264d667711 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 26 Apr 1991 02:39:56 +0000 Subject: [PATCH] Fix bug: check type of arguments to MAKE-RECTANGULAR and MAKE-POLAR, allowing exactly those numbers that satisfy REAL?. --- v7/src/runtime/arith.scm | 121 ++++++++++++++++++++++----------------- 1 file changed, 68 insertions(+), 53 deletions(-) diff --git a/v7/src/runtime/arith.scm b/v7/src/runtime/arith.scm index 002057820..d8660e384 100644 --- 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)))) (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. |# (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)) +(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))))) (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) -- 2.25.1