conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sqrt now supports negative arguments properly.

This commit is contained in:
Abdulaziz Ghuloum 2008-07-26 12:39:11 -07:00
parent 3b80d4f321
commit b3d8a8f9fd
2 changed files with 8 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
scheme/ikarus.numerics.ss
View File

@ -2543,15 +2543,15 @@
(define sqrt (define sqrt
(lambda (x) (lambda (x)
(cond (cond
[(flonum? x) (foreign-call "ikrt_fl_sqrt" x)] [(flonum? x)
(if ($fl< x 0.0)
(make-rectangular 0.0
(foreign-call "ikrt_fl_sqrt" ($fl- 0.0 x)))
(foreign-call "ikrt_fl_sqrt" x))]
[(fixnum? x) [(fixnum? x)
(cond (cond
[($fx< x 0) [($fx< x 0)
(let-values ([(s r) (exact-integer-sqrt (- x))]) (make-rectangular 0 (sqrt (- x)))]
(cond
[(eq? r 0) ($make-rectangular 0 s)]
[else
(error 'sqrt "inexact complex numbers not supported yet")]))]
[else [else
(let-values ([(s r) (exact-integer-sqrt x)]) (let-values ([(s r) (exact-integer-sqrt x)])
(cond (cond
@ -2576,11 +2576,7 @@
(inexact s))] (inexact s))]
[else v]))]))] [else v]))]))]
[else [else
(let-values ([(s r) (exact-integer-sqrt (- x))]) (make-rectangular 0 (sqrt (- x)))])]
(cond
[(eq? r 0) (make-rectangular 0 s)]
[else
(error 'sqrt "inexact complex numbers not supported yet")]))])]
[(ratnum? x) [(ratnum? x)
;;; FIXME: incorrect as per bug 180170 ;;; FIXME: incorrect as per bug 180170
(/ (sqrt ($ratnum-n x)) (sqrt ($ratnum-d x)))] (/ (sqrt ($ratnum-n x)) (sqrt ($ratnum-d x)))]

2
scheme/last-revision
View File

@ -1 +1 @@
1554 1555