[commit: ghc] master: base: Fix (**) implementation for Data.Complex (4f467b2)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/4f467b2e57ee3060d158a6505873df8c75b38c5c/ghc

>---------------------------------------------------------------

commit 4f467b2e57ee3060d158a6505873df8c75b38c5c
Author: Alexander <alex.dontexist at gmail.com>
Date:   Mon Feb 23 05:44:33 2015 -0600

    base: Fix (**) implementation for Data.Complex
    
    See the extensive discussion in #8539.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


>---------------------------------------------------------------

4f467b2e57ee3060d158a6505873df8c75b38c5c
 libraries/base/Data/Complex.hs | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/libraries/base/Data/Complex.hs b/libraries/base/Data/Complex.hs
index 1c06d46..ecd8301 100644
--- a/libraries/base/Data/Complex.hs
+++ b/libraries/base/Data/Complex.hs
@@ -140,6 +140,22 @@ instance  (RealFloat a) => Floating (Complex a) where
                       where expx = exp x
     log z          =  log (magnitude z) :+ phase z
 
+    x ** y = case (x,y) of
+      (_ , (0:+0))  -> 1 :+ 0
+      ((0:+0), (exp_re:+_)) -> case compare exp_re 0 of
+                 GT -> 0 :+ 0
+                 LT -> inf :+ 0
+                 EQ -> nan :+ nan
+      ((re:+im), (exp_re:+_))
+        | (isInfinite re || isInfinite im) -> case compare exp_re 0 of
+                 GT -> inf :+ 0
+                 LT -> 0 :+ 0
+                 EQ -> nan :+ nan
+        | otherwise -> exp (log x * y)
+      where
+        inf = 1/0
+        nan = 0/0
+
     sqrt (0:+0)    =  0
     sqrt z@(x:+y)  =  u :+ (if y < 0 then -v else v)
                       where (u,v) = if x < 0 then (v',u') else (u',v')