content: {-# LANGUAGE 
    MultiParamTypeClasses
    #-}
  module LLVM.Internal.FastMathFlags where
  
  import LLVM.Prelude
  
  import Control.Monad.Trans
  import Control.Monad.AnyCont
  import Control.Monad.State
  import Control.Exception
  
  import Data.Bits
  
  import qualified LLVM.Internal.FFI.Builder as FFI
  import qualified LLVM.Internal.FFI.LLVMCTypes as FFI
  
  import LLVM.Internal.Coding
  import LLVM.Internal.EncodeAST
  
  import qualified LLVM.AST as A
  
  instance EncodeM IO A.FastMathFlags FFI.FastMathFlags where
    encodeM f = return $ foldr1 (.|.) [
                 if a f then b else 0
                 | (a,b) <- [
                  (A.allowReassoc, FFI.fastMathFlagsAllowReassoc),
                  (A.noNaNs, FFI.fastMathFlagsNoNaNs),
                  (A.noInfs, FFI.fastMathFlagsNoInfs),
                  (A.noSignedZeros, FFI.fastMathFlagsNoSignedZeros),
                  (A.allowReciprocal, FFI.fastMathFlagsAllowReciprocal),
                  (A.allowContract, FFI.fastMathFlagsAllowContract),
                  (A.approxFunc, FFI.fastMathFlagsApproxFunc)
                 ] 
                ]
  
  instance EncodeM EncodeAST A.FastMathFlags () where
    encodeM f = do 
      f <- liftIO $ encodeM f
      builder <- gets encodeStateBuilder
      anyContToM $ bracket (FFI.setFastMathFlags builder f) (\() -> FFI.setFastMathFlags builder 0)
  
  instance Monad m => DecodeM m A.FastMathFlags FFI.FastMathFlags where
    decodeM f = return A.FastMathFlags {
                  A.allowReassoc = FFI.fastMathFlagsAllowReassoc .&. f /= 0,
                  A.noNaNs = FFI.fastMathFlagsNoNaNs .&. f /= 0,
                  A.noInfs = FFI.fastMathFlagsNoInfs .&. f /= 0,
                  A.noSignedZeros = FFI.fastMathFlagsNoSignedZeros .&. f /= 0,
                  A.allowReciprocal = FFI.fastMathFlagsAllowReciprocal .&. f /= 0,
                  A.allowContract = FFI.fastMathFlagsAllowContract .&. f /= 0,
                  A.approxFunc = FFI.fastMathFlagsApproxFunc .&. f /= 0
                }
  
  