From 4e987026148fe65c323afbc93cd560c07bf06b3f Mon Sep 17 00:00:00 2001
From: Yale AI Dept <ai@nebula.cs.yale.edu>
Date: Wed, 14 Jul 1993 13:08:00 -0500
Subject: Import to github.

---
 progs/prelude/PreludeComplex.hs | 94 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 94 insertions(+)
 create mode 100644 progs/prelude/PreludeComplex.hs

(limited to 'progs/prelude/PreludeComplex.hs')

diff --git a/progs/prelude/PreludeComplex.hs b/progs/prelude/PreludeComplex.hs
new file mode 100644
index 0000000..2044129
--- /dev/null
+++ b/progs/prelude/PreludeComplex.hs
@@ -0,0 +1,94 @@
+-- Complex Numbers
+
+module PreludeComplex where
+
+{-#Prelude#-}  -- Indicates definitions of compiler prelude symbols
+
+infixl  6  :+
+
+data  (RealFloat a)     => Complex a = a {-#STRICT#-} :+ a {-#STRICT #-}
+                               deriving (Eq,Binary,Text)
+
+instance  (RealFloat a) => Num (Complex a)  where
+    (x:+y) + (x':+y')	=  (x+x') :+ (y+y')
+    (x:+y) - (x':+y')	=  (x-x') :+ (y-y')
+    (x:+y) * (x':+y')	=  (x*x'-y*y') :+ (x*y'+y*x')
+    negate (x:+y)	=  negate x :+ negate y
+    abs z		=  magnitude z :+ 0
+    signum 0		=  0
+    signum z@(x:+y)	=  x/r :+ y/r  where r = magnitude z
+    fromInteger n	=  fromInteger n :+ 0
+
+instance  (RealFloat a) => Fractional (Complex a)  where
+    (x:+y) / (x':+y')	=  (x*x''+y*y'') / d :+ (y*x''-x*y'') / d
+			   where x'' = scaleFloat k x'
+				 y'' = scaleFloat k y'
+				 k   = - max (exponent x') (exponent y')
+				 d   = x'*x'' + y'*y''
+
+    fromRational a	=  fromRational a :+ 0
+
+instance  (RealFloat a) => Floating (Complex a)	where
+    pi             =  pi :+ 0
+    exp (x:+y)     =  expx * cos y :+ expx * sin y
+                      where expx = exp x
+    log z          =  log (magnitude z) :+ phase z
+
+    sqrt 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')
+                            v'    = abs y / (u'*2)
+                            u'    = sqrt ((magnitude z + abs x) / 2)
+
+    sin (x:+y)     =  sin x * cosh y :+ cos x * sinh y
+    cos (x:+y)     =  cos x * cosh y :+ (- sin x * sinh y)
+    tan (x:+y)     =  (sinx*coshy:+cosx*sinhy)/(cosx*coshy:+(-sinx*sinhy))
+                      where sinx  = sin x
+                            cosx  = cos x
+                            sinhy = sinh y
+                            coshy = cosh y
+
+    sinh (x:+y)    =  cos y * sinh x :+ sin  y * cosh x
+    cosh (x:+y)    =  cos y * cosh x :+ sin y * sinh x
+    tanh (x:+y)    =  (cosy*sinhx:+siny*coshx)/(cosy*coshx:+siny*sinhx)
+                      where siny  = sin y
+                            cosy  = cos y
+                            sinhx = sinh x
+                            coshx = cosh x
+
+    asin z@(x:+y)  =  y':+(-x')
+                      where  (x':+y') = log (((-y):+x) + sqrt (1 - z*z))
+    acos z@(x:+y)  =  y'':+(-x'')
+                      where (x'':+y'') = log (z + ((-y'):+x'))
+                            (x':+y')   = sqrt (1 - z*z)
+    atan z@(x:+y)  =  y':+(-x')
+                      where (x':+y') = log (((1-y):+x) / sqrt (1+z*z))
+
+    asinh z        =  log (z + sqrt (1+z*z))
+    acosh z        =  log (z + (z+1) * sqrt ((z-1)/(z+1)))
+    atanh z        =  log ((1+z) / sqrt (1-z*z))
+
+
+realPart, imagPart :: (RealFloat a) => Complex a -> a
+realPart (x:+y)	 =  x
+imagPart (x:+y)	 =  y
+
+conjugate	 :: (RealFloat a) => Complex a -> Complex a
+conjugate (x:+y) =  x :+ (-y)
+
+mkPolar		 :: (RealFloat a) => a -> a -> Complex a
+mkPolar r theta	 =  r * cos theta :+ r * sin theta
+
+cis		 :: (RealFloat a) => a -> Complex a
+cis theta	 =  cos theta :+ sin theta
+
+polar		 :: (RealFloat a) => Complex a -> (a,a)
+polar z		 =  (magnitude z, phase z)
+
+magnitude, phase :: (RealFloat a) => Complex a -> a
+magnitude (x:+y) =  scaleFloat k
+		     (sqrt ((scaleFloat mk x)^2 + (scaleFloat mk y)^2))
+		    where k  = max (exponent x) (exponent y)
+		          mk = - k
+
+phase (x:+y)	 =  atan2 y x
-- 
cgit v1.2.3