{-# LANGUAGE ForeignFunctionInterface #-}

{- |
  Module      :  Numeric.IEEE.RoundMode
  Copyright   :  (c) Matt Morrow 2008
  License     :  BSD3
  Maintainer  :  Matt Morrow <mjm2002@gmail.com>
  Stability   :  provisional
  Portability :  portable (FFI)
-}

module Numeric.IEEE.RoundMode (
    RoundMode(..)
  , getRound
  , setRound
) where

import Foreign.C(CInt(..))
import Foreign.Ptr(Ptr)
import Foreign.Storable(peek)
import System.IO.Unsafe(unsafePerformIO)

data RoundMode
  = ToNearest
  | Upward
  | Downward
  | TowardZero
  deriving (Eq,Ord,Show,Read)

foreign import ccall unsafe "fenv.h fegetround" c_fegetround :: IO CInt
foreign import ccall unsafe "fenv.h fesetround" c_fesetround :: CInt -> IO CInt

-- | Gets the fpu's current rounding mode.
getRound :: IO RoundMode
getRound = (toEnum . fromIntegral) `fmap` c_fegetround

-- | Sets the fpu's rounding mode. Returns @True@ if successful.
setRound :: RoundMode -> IO Bool
setRound m = (==0) `fmap` c_fesetround (fromIntegral . fromEnum $ m)

instance Enum RoundMode where
  toEnum n
    | n==feToNearest  = ToNearest
    | n==feUpward     = Upward
    | n==feDownward   = Downward
    | n==feTowardZero = TowardZero
  fromEnum ToNearest  = feToNearest
  fromEnum Upward     = feUpward
  fromEnum Downward   = feDownward
  fromEnum TowardZero = feTowardZero

feToNearest     :: Int
feUpward        :: Int
feDownward      :: Int
feTowardZero    :: Int
feToNearest   = fromIntegral (unsafePerformIO (peek fe_tonearest))
feUpward      = fromIntegral (unsafePerformIO (peek fe_upward))
feDownward    = fromIntegral (unsafePerformIO (peek fe_downward))
feTowardZero  = fromIntegral (unsafePerformIO (peek fe_towardzero))
foreign import ccall unsafe "&" fe_tonearest  :: Ptr CInt
foreign import ccall unsafe "&" fe_upward     :: Ptr CInt
foreign import ccall unsafe "&" fe_downward   :: Ptr CInt
foreign import ccall unsafe "&" fe_towardzero :: Ptr CInt