From c4e131a46558ab142334cd5afe1ad704be110a3e Mon Sep 17 00:00:00 2001
From: Nick Bowler <nbowler@draconx.ca>
Date: Fri, 20 Nov 2009 00:52:51 -0500
Subject: [PATCH] floating: Add fma function.

---
 Data/Floating/Classes.hs | 3 +++
 Data/Floating/Double.hs  | 8 ++++++++
 2 files changed, 11 insertions(+)

diff --git a/Data/Floating/Classes.hs b/Data/Floating/Classes.hs
index f692894..fc24c0b 100644
--- a/Data/Floating/Classes.hs
+++ b/Data/Floating/Classes.hs
@@ -6,6 +6,8 @@
  - There is NO WARRANTY, to the extent permitted by law.
  -}
 
+-- | Generic classes for floating point types.  The interface is loosely based
+-- off of the C math library.
 module Data.Floating.Classes where
 
 import Prelude hiding (Floating(..), RealFloat(..))
@@ -38,6 +40,7 @@ class Fractional a => Floating a where
 --
 -- Minimal complete definition: all except pi, infinity and nan.
 class Floating a => RealFloat a where
+    fma       :: a -> a -> a -> a
     copysign  :: a -> a -> a
     nextafter :: a -> a -> a
     atan2     :: a -> a -> a
diff --git a/Data/Floating/Double.hs b/Data/Floating/Double.hs
index c271f78..adcd4d1 100644
--- a/Data/Floating/Double.hs
+++ b/Data/Floating/Double.hs
@@ -41,6 +41,8 @@ foreign import ccall unsafe "strtod"
 
 foreign import ccall unsafe "fabs"
     c_fabs :: CDouble -> CDouble
+foreign import ccall unsafe "fma"
+    c_fma :: CDouble -> CDouble -> CDouble -> CDouble
 foreign import ccall unsafe "copysign"
     c_copysign :: CDouble -> CDouble -> CDouble
 foreign import ccall unsafe "nextafter"
@@ -92,6 +94,11 @@ libmDouble f a = toFloating $ f (toFloating a)
 libmDouble2 :: (CDouble -> CDouble -> CDouble) -> Double -> Double -> Double
 libmDouble2 f a b = toFloating $ f (toFloating a) (toFloating b)
 
+libmDouble3 :: (CDouble -> CDouble -> CDouble -> CDouble)
+    -> Double -> Double -> Double -> Double
+libmDouble3 f a b c = toFloating
+    $ f (toFloating a) (toFloating b) (toFloating c)
+
 instance Show Double where
     show x = unsafePerformIO . withCString "%a" $ \fmt -> do
         size <- double_format nullPtr fmt (toFloating x)
@@ -146,6 +153,7 @@ instance Floating Double where
     atanh = libmDouble c_atanh
 
 instance RealFloat Double where
+    fma       = libmDouble3 c_fma
     copysign  = libmDouble2 c_copysign
     nextafter = libmDouble2 c_nextafter
     fmod      = libmDouble2 c_fmod
-- 
2.11.4.GIT