{-# LANGUAGE OverloadedStrings #-}
-- | This module provides an enumeration of the various transformation (e.g. optimization) passes
-- provided by LLVM. They can be used to create a 'LLVM.PassManager.PassManager' to, in turn,
-- run the passes on 'LLVM.Module.Module's. If you don't know what passes you want, consider
-- instead using 'LLVM.PassManager.CuratedPassSetSpec'.
module LLVM.Transforms where

import LLVM.Prelude

-- | <http://llvm.org/docs/Passes.html#transform-passes>
-- A few passes can make use of information in a 'LLVM.Target.TargetMachine' if one
-- is provided to 'LLVM.PassManager.createPassManager'.
-- <http://llvm.org/doxygen/classllvm_1_1Pass.html>
data Pass
  -- here begin the Scalar passes
  = AggressiveDeadCodeElimination
  | BreakCriticalEdges
  -- | can use a 'LLVM.Target.TargetMachine'
  | CodeGenPrepare
  | CorrelatedValuePropagation
  | DeadCodeElimination
  | DeadStoreElimination
  | DemoteRegisterToMemory
  | EarlyCommonSubexpressionElimination
  | GlobalValueNumbering { Pass -> Bool
noLoads :: Bool }
  | InductionVariableSimplify
  | InstructionCombining
  -- | Instruction simplification includes constant folding
  | InstructionSimplify
  | JumpThreading
  | LoopClosedSingleStaticAssignment
  | LoopInvariantCodeMotion
  | LoopDeletion
  | LoopIdiom
  | LoopInstructionSimplify
  | LoopRotate
  | LoopStrengthReduce
  | LoopUnroll { Pass -> Maybe Word
loopUnrollThreshold :: Maybe Word, Pass -> Maybe Word
count :: Maybe Word, Pass -> Maybe Bool
allowPartial :: Maybe Bool }
  | LoopUnswitch { Pass -> Bool
optimizeForSize :: Bool }
  | LowerAtomic
  | LowerInvoke
  | LowerSwitch
  | LowerExpectIntrinsic
  | MemcpyOptimization
  | PromoteMemoryToRegister
  | Reassociate
  | ScalarReplacementOfAggregates { Pass -> Bool
requiresDominatorTree :: Bool }
  | OldScalarReplacementOfAggregates {
      Pass -> Maybe Word
oldScalarReplacementOfAggregatesThreshold :: Maybe Word,
      Pass -> Bool
useDominatorTree :: Bool,
      Pass -> Maybe Word
structMemberThreshold :: Maybe Word,
      Pass -> Maybe Word
arrayElementThreshold :: Maybe Word,
      Pass -> Maybe Word
scalarLoadThreshold :: Maybe Word
    }
  | SparseConditionalConstantPropagation
  | SimplifyLibCalls
  | SimplifyControlFlowGraph
  | Sinking
  | TailCallElimination

  -- here begin the Interprocedural passes
  | AlwaysInline { Pass -> Bool
insertLifetime :: Bool }
  | ArgumentPromotion
  | ConstantMerge
  | FunctionAttributes
  | FunctionInlining {
      Pass -> Word
functionInliningThreshold :: Word
    }
  | GlobalDeadCodeElimination
  | InternalizeFunctions { Pass -> [String]
exportList :: [String] }
  | InterproceduralSparseConditionalConstantPropagation
  | MergeFunctions
  | PartialInlining
  | PruneExceptionHandling
  | StripDeadDebugInfo
  | StripDebugDeclare
  | StripNonDebugSymbols
  | StripSymbols { Pass -> Bool
onlyDebugInfo :: Bool }

  -- here begin the vectorization passes
  | LoopVectorize {
      Pass -> Bool
interleaveOnlyWhenForced :: Bool,
      Pass -> Bool
vectorizeOnlyWhenForced :: Bool
    }
  | SuperwordLevelParallelismVectorize

  -- here begin the instrumentation passes
  | GCOVProfiler {
      Pass -> Bool
emitNotes :: Bool,
      Pass -> Bool
emitData :: Bool,
      Pass -> GCOVVersion
version :: GCOVVersion,
      Pass -> Bool
noRedZone :: Bool,
      Pass -> Bool
atomic :: Bool,
      Pass -> String
filter :: String,
      Pass -> String
exclude :: String
    }
  | AddressSanitizer
  | AddressSanitizerModule
  | MemorySanitizer {
      Pass -> Bool
trackOrigins :: Bool,
      Pass -> Bool
recover :: Bool,
      Pass -> Bool
kernel :: Bool
    }
  | ThreadSanitizer
  | BoundsChecking
  deriving (Pass -> Pass -> Bool
(Pass -> Pass -> Bool) -> (Pass -> Pass -> Bool) -> Eq Pass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pass -> Pass -> Bool
== :: Pass -> Pass -> Bool
$c/= :: Pass -> Pass -> Bool
/= :: Pass -> Pass -> Bool
Eq, Eq Pass
Eq Pass
-> (Pass -> Pass -> Ordering)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Bool)
-> (Pass -> Pass -> Pass)
-> (Pass -> Pass -> Pass)
-> Ord Pass
Pass -> Pass -> Bool
Pass -> Pass -> Ordering
Pass -> Pass -> Pass
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Pass -> Pass -> Ordering
compare :: Pass -> Pass -> Ordering
$c< :: Pass -> Pass -> Bool
< :: Pass -> Pass -> Bool
$c<= :: Pass -> Pass -> Bool
<= :: Pass -> Pass -> Bool
$c> :: Pass -> Pass -> Bool
> :: Pass -> Pass -> Bool
$c>= :: Pass -> Pass -> Bool
>= :: Pass -> Pass -> Bool
$cmax :: Pass -> Pass -> Pass
max :: Pass -> Pass -> Pass
$cmin :: Pass -> Pass -> Pass
min :: Pass -> Pass -> Pass
Ord, ReadPrec [Pass]
ReadPrec Pass
Int -> ReadS Pass
ReadS [Pass]
(Int -> ReadS Pass)
-> ReadS [Pass] -> ReadPrec Pass -> ReadPrec [Pass] -> Read Pass
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Pass
readsPrec :: Int -> ReadS Pass
$creadList :: ReadS [Pass]
readList :: ReadS [Pass]
$creadPrec :: ReadPrec Pass
readPrec :: ReadPrec Pass
$creadListPrec :: ReadPrec [Pass]
readListPrec :: ReadPrec [Pass]
Read, Int -> Pass -> ShowS
[Pass] -> ShowS
Pass -> String
(Int -> Pass -> ShowS)
-> (Pass -> String) -> ([Pass] -> ShowS) -> Show Pass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pass -> ShowS
showsPrec :: Int -> Pass -> ShowS
$cshow :: Pass -> String
show :: Pass -> String
$cshowList :: [Pass] -> ShowS
showList :: [Pass] -> ShowS
Show, Typeable, Typeable Pass
Typeable Pass
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Pass -> c Pass)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Pass)
-> (Pass -> Constr)
-> (Pass -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Pass))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass))
-> ((forall b. Data b => b -> b) -> Pass -> Pass)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r)
-> (forall u. (forall d. Data d => d -> u) -> Pass -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Pass -> m Pass)
-> Data Pass
Pass -> Constr
Pass -> DataType
(forall b. Data b => b -> b) -> Pass -> Pass
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u
forall u. (forall d. Data d => d -> u) -> Pass -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pass
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pass -> c Pass
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pass)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pass -> c Pass
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Pass -> c Pass
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pass
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Pass
$ctoConstr :: Pass -> Constr
toConstr :: Pass -> Constr
$cdataTypeOf :: Pass -> DataType
dataTypeOf :: Pass -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pass)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Pass)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Pass)
$cgmapT :: (forall b. Data b => b -> b) -> Pass -> Pass
gmapT :: (forall b. Data b => b -> b) -> Pass -> Pass
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Pass -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Pass -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Pass -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Pass -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Pass -> m Pass
Data, (forall x. Pass -> Rep Pass x)
-> (forall x. Rep Pass x -> Pass) -> Generic Pass
forall x. Rep Pass x -> Pass
forall x. Pass -> Rep Pass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Pass -> Rep Pass x
from :: forall x. Pass -> Rep Pass x
$cto :: forall x. Rep Pass x -> Pass
to :: forall x. Rep Pass x -> Pass
Generic)

-- | Defaults for the 'LoopVectorize' pass
defaultLoopVectorize :: Pass
defaultLoopVectorize :: Pass
defaultLoopVectorize = LoopVectorize {
    interleaveOnlyWhenForced :: Bool
interleaveOnlyWhenForced = Bool
False,
    vectorizeOnlyWhenForced :: Bool
vectorizeOnlyWhenForced = Bool
False
  }

-- | See <http://gcc.gnu.org/viewcvs/gcc/trunk/gcc/gcov-io.h?view=markup>.
newtype GCOVVersion = GCOVVersion ShortByteString
  deriving (GCOVVersion -> GCOVVersion -> Bool
(GCOVVersion -> GCOVVersion -> Bool)
-> (GCOVVersion -> GCOVVersion -> Bool) -> Eq GCOVVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GCOVVersion -> GCOVVersion -> Bool
== :: GCOVVersion -> GCOVVersion -> Bool
$c/= :: GCOVVersion -> GCOVVersion -> Bool
/= :: GCOVVersion -> GCOVVersion -> Bool
Eq, Eq GCOVVersion
Eq GCOVVersion
-> (GCOVVersion -> GCOVVersion -> Ordering)
-> (GCOVVersion -> GCOVVersion -> Bool)
-> (GCOVVersion -> GCOVVersion -> Bool)
-> (GCOVVersion -> GCOVVersion -> Bool)
-> (GCOVVersion -> GCOVVersion -> Bool)
-> (GCOVVersion -> GCOVVersion -> GCOVVersion)
-> (GCOVVersion -> GCOVVersion -> GCOVVersion)
-> Ord GCOVVersion
GCOVVersion -> GCOVVersion -> Bool
GCOVVersion -> GCOVVersion -> Ordering
GCOVVersion -> GCOVVersion -> GCOVVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GCOVVersion -> GCOVVersion -> Ordering
compare :: GCOVVersion -> GCOVVersion -> Ordering
$c< :: GCOVVersion -> GCOVVersion -> Bool
< :: GCOVVersion -> GCOVVersion -> Bool
$c<= :: GCOVVersion -> GCOVVersion -> Bool
<= :: GCOVVersion -> GCOVVersion -> Bool
$c> :: GCOVVersion -> GCOVVersion -> Bool
> :: GCOVVersion -> GCOVVersion -> Bool
$c>= :: GCOVVersion -> GCOVVersion -> Bool
>= :: GCOVVersion -> GCOVVersion -> Bool
$cmax :: GCOVVersion -> GCOVVersion -> GCOVVersion
max :: GCOVVersion -> GCOVVersion -> GCOVVersion
$cmin :: GCOVVersion -> GCOVVersion -> GCOVVersion
min :: GCOVVersion -> GCOVVersion -> GCOVVersion
Ord, ReadPrec [GCOVVersion]
ReadPrec GCOVVersion
Int -> ReadS GCOVVersion
ReadS [GCOVVersion]
(Int -> ReadS GCOVVersion)
-> ReadS [GCOVVersion]
-> ReadPrec GCOVVersion
-> ReadPrec [GCOVVersion]
-> Read GCOVVersion
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS GCOVVersion
readsPrec :: Int -> ReadS GCOVVersion
$creadList :: ReadS [GCOVVersion]
readList :: ReadS [GCOVVersion]
$creadPrec :: ReadPrec GCOVVersion
readPrec :: ReadPrec GCOVVersion
$creadListPrec :: ReadPrec [GCOVVersion]
readListPrec :: ReadPrec [GCOVVersion]
Read, Int -> GCOVVersion -> ShowS
[GCOVVersion] -> ShowS
GCOVVersion -> String
(Int -> GCOVVersion -> ShowS)
-> (GCOVVersion -> String)
-> ([GCOVVersion] -> ShowS)
-> Show GCOVVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GCOVVersion -> ShowS
showsPrec :: Int -> GCOVVersion -> ShowS
$cshow :: GCOVVersion -> String
show :: GCOVVersion -> String
$cshowList :: [GCOVVersion] -> ShowS
showList :: [GCOVVersion] -> ShowS
Show, Typeable, Typeable GCOVVersion
Typeable GCOVVersion
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> GCOVVersion -> c GCOVVersion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GCOVVersion)
-> (GCOVVersion -> Constr)
-> (GCOVVersion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GCOVVersion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GCOVVersion))
-> ((forall b. Data b => b -> b) -> GCOVVersion -> GCOVVersion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r)
-> (forall u. (forall d. Data d => d -> u) -> GCOVVersion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GCOVVersion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion)
-> Data GCOVVersion
GCOVVersion -> Constr
GCOVVersion -> DataType
(forall b. Data b => b -> b) -> GCOVVersion -> GCOVVersion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GCOVVersion -> u
forall u. (forall d. Data d => d -> u) -> GCOVVersion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCOVVersion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCOVVersion -> c GCOVVersion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GCOVVersion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GCOVVersion)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCOVVersion -> c GCOVVersion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCOVVersion -> c GCOVVersion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCOVVersion
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCOVVersion
$ctoConstr :: GCOVVersion -> Constr
toConstr :: GCOVVersion -> Constr
$cdataTypeOf :: GCOVVersion -> DataType
dataTypeOf :: GCOVVersion -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GCOVVersion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GCOVVersion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GCOVVersion)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GCOVVersion)
$cgmapT :: (forall b. Data b => b -> b) -> GCOVVersion -> GCOVVersion
gmapT :: (forall b. Data b => b -> b) -> GCOVVersion -> GCOVVersion
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GCOVVersion -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GCOVVersion -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> GCOVVersion -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GCOVVersion -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GCOVVersion -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCOVVersion -> m GCOVVersion
Data, (forall x. GCOVVersion -> Rep GCOVVersion x)
-> (forall x. Rep GCOVVersion x -> GCOVVersion)
-> Generic GCOVVersion
forall x. Rep GCOVVersion x -> GCOVVersion
forall x. GCOVVersion -> Rep GCOVVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GCOVVersion -> Rep GCOVVersion x
from :: forall x. GCOVVersion -> Rep GCOVVersion x
$cto :: forall x. Rep GCOVVersion x -> GCOVVersion
to :: forall x. Rep GCOVVersion x -> GCOVVersion
Generic)

-- | Defaults for 'GCOVProfiler'.
defaultGCOVProfiler :: Pass
defaultGCOVProfiler :: Pass
defaultGCOVProfiler = GCOVProfiler {
    emitNotes :: Bool
emitNotes = Bool
True,
    emitData :: Bool
emitData = Bool
True,
    version :: GCOVVersion
version = ShortByteString -> GCOVVersion
GCOVVersion ShortByteString
"402*",
    noRedZone :: Bool
noRedZone = Bool
False,
    atomic :: Bool
atomic = Bool
True,
    filter :: String
LLVM.Transforms.filter = String
"",
    exclude :: String
exclude = String
""
  }

-- | Defaults for 'AddressSanitizer'.
defaultAddressSanitizer :: Pass
defaultAddressSanitizer :: Pass
defaultAddressSanitizer = Pass
AddressSanitizer

-- | Defaults for 'AddressSanitizerModule'.
defaultAddressSanitizerModule :: Pass
defaultAddressSanitizerModule :: Pass
defaultAddressSanitizerModule = Pass
AddressSanitizerModule

-- | Defaults for 'MemorySanitizer'.
defaultMemorySanitizer :: Pass
defaultMemorySanitizer :: Pass
defaultMemorySanitizer = MemorySanitizer {
  trackOrigins :: Bool
trackOrigins = Bool
False,
  recover :: Bool
recover = Bool
False,
  kernel :: Bool
kernel = Bool
False
}

-- | Defaults for 'ThreadSanitizer'.
defaultThreadSanitizer :: Pass
defaultThreadSanitizer :: Pass
defaultThreadSanitizer = Pass
ThreadSanitizer