{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.Trafo.Config
-- Copyright   : [2008..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Trafo.Config (

  Config(..),
  Flag(..),
  defaultOptions,

  -- Other options not controlled by the command line flags
  -- float_out_acc,

) where

import Data.Bits
import Data.BitSet
import Data.Array.Accelerate.Debug.Flags                  as F

import Data.Word
import System.IO.Unsafe
import Foreign.Storable


data Config = Config
  { Config -> BitSet Word32 Flag
options                   :: {-# UNPACK #-} !(BitSet Word32 Flag)
  , Config -> Int
unfolding_use_threshold   :: {-# UNPACK #-} !Int
  , Config -> Int
max_simplifier_iterations :: {-# UNPACK #-} !Int
  }
  deriving Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show

{-# NOINLINE defaultOptions #-}
defaultOptions :: Config
defaultOptions :: Config
defaultOptions = IO Config -> Config
forall a. IO a -> a
unsafePerformIO (IO Config -> Config) -> IO Config -> Config
forall a b. (a -> b) -> a -> b
$!
  BitSet Word32 Flag -> Int -> Int -> Config
Config (BitSet Word32 Flag -> Int -> Int -> Config)
-> (Word32 -> BitSet Word32 Flag) -> Word32 -> Int -> Int -> Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> BitSet Word32 Flag
forall c a. c -> BitSet c a
BitSet (Word32 -> BitSet Word32 Flag)
-> (Word32 -> Word32) -> Word32 -> BitSet Word32 Flag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word32
0x80000000 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.)) (Word32 -> Int -> Int -> Config)
-> IO Word32 -> IO (Int -> Int -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
F.__cmd_line_flags
         IO (Int -> Int -> Config) -> IO Int -> IO (Int -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> IO Word32
F.getValue Value
F.unfolding_use_threshold)
         IO (Int -> Config) -> IO Int -> IO Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> IO Word32
F.getValue Value
F.max_simplifier_iterations)

-- Extra options not covered by command line flags
--
-- float_out_acc          = Flag 31