{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}

{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1997-1998
-}

{-# OPTIONS_GHC -Wno-orphans #-}
{-
Suppression of warnings are required for instances:
  - Binary Activation
  - Binary CompilerPhase
  - Binary InlinePragma
  - Binary InlineSaturation
  - Binary XActivation
  - Binary XInlinePragmaGhc
  - Outputable CompilerPhase
-}

module GHC.Types.InlinePragma
  ( -- * Inline Pragma Encoding
    -- ** InlinePragma
    -- *** Data-type
    InlinePragma(..)
  , InlinePragmaInfo
    -- *** Constants
  , defaultInlinePragma
  , alwaysConLikePragma
  , alwaysInlinePragma
  , alwaysInlineConLikePragma
  , dfunInlinePragma
  , neverInlinePragma
    -- *** Field accessors
  , inlinePragmaActivation
  , inlinePragmaSaturation
  , inlinePragmaName
  , inlinePragmaRuleMatchInfo
  , inlinePragmaSource
  , inlinePragmaSpec
    -- *** Queries
  , isAnyInlinePragma
  , isDefaultInlinePragma
  , isInlinablePragma
  , isInlinePragma
  , isNoInlinePragma
  , isOpaquePragma
    -- *** Mutators
  , setInlinePragmaSource
  , setInlinePragmaSaturation
  , setInlinePragmaActivation
  , setInlinePragmaSpec
  , setInlinePragmaRuleMatchInfo
    -- *** GHC pass conversions
  , tcInlinePragma
    -- *** Pretty-printing
  , pprInline
  , pprInlineDebug

    -- ** Extensible record type for GhcRn & GhcTc
  , XInlinePragmaGhc(..)
  , InlineSaturation(..)

    -- ** InlineSpec
    -- *** Data-type
  , InlineSpec(..)
    -- *** Queries
  , noUserInlineSpec

    -- ** RuleMatchInfo
    -- *** Data-type
  , RuleMatchInfo(..)
    -- *** Queries
  , isConLike
  , isFunLike

    -- * Phase Activation
    -- ** Activation
    -- *** Data-type
  , ActivationGhc
  , ActivationX(AlwaysActive, NeverActive, ActiveAfter, ActiveBefore)
  , pattern ActiveFinal
  , PhaseNum
    -- *** Construction
  , activeAfter
    -- *** Constants
  , activateAfterInitial
  , activateDuringFinal
    -- *** Queries
  , activeInFinalPhase
  , activeInInitialPhase
  , activeInPhase
  , competesWith
  , isAlwaysActive
  , isNeverActive

    -- ** CompilerPhase
    -- *** Data-type
  , CompilerPhase(..)
    -- *** Constructors
  , beginPhase
  , endPhase
    -- *** Queries
  , isActiveInPhase
  , laterPhase
  , laterThanPhase
  , nextPhase
  ) where

import GHC.Prelude

import GHC.Data.FastString
import GHC.Hs.Extension
import GHC.Types.Arity (Arity)
import GHC.Types.SourceText (SourceText(..))
import GHC.Utils.Binary
import GHC.Utils.Outputable

import Control.DeepSeq (NFData(..))
import Data.Data (Data)

import Language.Haskell.Syntax.Binds.InlinePragma
import Language.Haskell.Syntax.Extension

-- infixl so you can say (prag `set` a `set` b)
infixl 1 `setInlinePragmaActivation`,
         `setInlinePragmaSaturation`,
         `setInlinePragmaRuleMatchInfo`,
         `setInlinePragmaSource`,
         `setInlinePragmaSpec`

-- | The arity /at which to/ inline a function.
-- This may differ from the function's syntactic arity.
data InlineSaturation
    = AppliedToAtLeast !Arity
      -- ^ Inline only when applied to @n@ explicit
      -- (non-type, non-dictionary) arguments.
      --
      -- That is, 'AppliedToAtLeast' describes the number of
      --  *source-code* arguments the thing must be applied to.
    | AnySaturation
      -- ^ There does not exist an explicit number of arguments
      -- that the inlining process should be applied to.
    deriving (InlineSaturation -> InlineSaturation -> Bool
(InlineSaturation -> InlineSaturation -> Bool)
-> (InlineSaturation -> InlineSaturation -> Bool)
-> Eq InlineSaturation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InlineSaturation -> InlineSaturation -> Bool
== :: InlineSaturation -> InlineSaturation -> Bool
$c/= :: InlineSaturation -> InlineSaturation -> Bool
/= :: InlineSaturation -> InlineSaturation -> Bool
Eq, Typeable InlineSaturation
Typeable InlineSaturation =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> InlineSaturation -> c InlineSaturation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InlineSaturation)
-> (InlineSaturation -> Constr)
-> (InlineSaturation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InlineSaturation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InlineSaturation))
-> ((forall b. Data b => b -> b)
    -> InlineSaturation -> InlineSaturation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> InlineSaturation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InlineSaturation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> InlineSaturation -> m InlineSaturation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InlineSaturation -> m InlineSaturation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> InlineSaturation -> m InlineSaturation)
-> Data InlineSaturation
InlineSaturation -> Constr
InlineSaturation -> DataType
(forall b. Data b => b -> b)
-> InlineSaturation -> InlineSaturation
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) -> InlineSaturation -> u
forall u. (forall d. Data d => d -> u) -> InlineSaturation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InlineSaturation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InlineSaturation -> c InlineSaturation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InlineSaturation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InlineSaturation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InlineSaturation -> c InlineSaturation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InlineSaturation -> c InlineSaturation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InlineSaturation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InlineSaturation
$ctoConstr :: InlineSaturation -> Constr
toConstr :: InlineSaturation -> Constr
$cdataTypeOf :: InlineSaturation -> DataType
dataTypeOf :: InlineSaturation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InlineSaturation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InlineSaturation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InlineSaturation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InlineSaturation)
$cgmapT :: (forall b. Data b => b -> b)
-> InlineSaturation -> InlineSaturation
gmapT :: (forall b. Data b => b -> b)
-> InlineSaturation -> InlineSaturation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSaturation -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InlineSaturation -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> InlineSaturation -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InlineSaturation -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InlineSaturation -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InlineSaturation -> m InlineSaturation
Data)

instance NFData InlineSaturation where

  rnf :: InlineSaturation -> ()
rnf (AppliedToAtLeast !Int
w) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
w () -> () -> ()
forall a b. a -> b -> b
`seq` ()
  rnf !InlineSaturation
AnySaturation = ()


{-
************************************************************************
*                                                                      *
\subsection{Inline-pragma information}
*                                                                      *
************************************************************************
-}

-- | Inline Pragma Information
--
-- Tells when the inlining is active.
-- When it is active the thing may be inlined, depending on how
-- big it is.
--
-- If there was an @INLINE@ pragma, then as a separate matter, the
-- RHS will have been made to look small with a Core inline 'Note'
--
-- The default 'InlinePragInfo' is 'AlwaysActive', so the info serves
-- entirely as a way to inhibit inlining until we want it
type InlinePragmaInfo = InlinePragma GhcTc

type ActivationGhc = ActivationX XXActivationGhc

data XInlinePragmaGhc = XInlinePragmaGhc
  { XInlinePragmaGhc -> SourceText
xinl_src :: SourceText
      -- ^ See Note [Pragma source text]
  , XInlinePragmaGhc -> InlineSaturation
xinl_sat :: InlineSaturation
      -- ^ Inline only when applied to @n@ explicit
      -- (non-type, non-dictionary) arguments.
      --
      -- That is, 'xinl_sat' describes the number of *source-code*
      -- arguments the thing must be applied to.  We add on the
      -- number of implicit, dictionary arguments when making
      -- the Unfolding, and don't look at inl_sat further
  }
  deriving (XInlinePragmaGhc -> XInlinePragmaGhc -> Bool
(XInlinePragmaGhc -> XInlinePragmaGhc -> Bool)
-> (XInlinePragmaGhc -> XInlinePragmaGhc -> Bool)
-> Eq XInlinePragmaGhc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XInlinePragmaGhc -> XInlinePragmaGhc -> Bool
== :: XInlinePragmaGhc -> XInlinePragmaGhc -> Bool
$c/= :: XInlinePragmaGhc -> XInlinePragmaGhc -> Bool
/= :: XInlinePragmaGhc -> XInlinePragmaGhc -> Bool
Eq, Typeable XInlinePragmaGhc
Typeable XInlinePragmaGhc =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> XInlinePragmaGhc -> c XInlinePragmaGhc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c XInlinePragmaGhc)
-> (XInlinePragmaGhc -> Constr)
-> (XInlinePragmaGhc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c XInlinePragmaGhc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c XInlinePragmaGhc))
-> ((forall b. Data b => b -> b)
    -> XInlinePragmaGhc -> XInlinePragmaGhc)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> XInlinePragmaGhc -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> XInlinePragmaGhc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> XInlinePragmaGhc -> m XInlinePragmaGhc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> XInlinePragmaGhc -> m XInlinePragmaGhc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> XInlinePragmaGhc -> m XInlinePragmaGhc)
-> Data XInlinePragmaGhc
XInlinePragmaGhc -> Constr
XInlinePragmaGhc -> DataType
(forall b. Data b => b -> b)
-> XInlinePragmaGhc -> XInlinePragmaGhc
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) -> XInlinePragmaGhc -> u
forall u. (forall d. Data d => d -> u) -> XInlinePragmaGhc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XInlinePragmaGhc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XInlinePragmaGhc -> c XInlinePragmaGhc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XInlinePragmaGhc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XInlinePragmaGhc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XInlinePragmaGhc -> c XInlinePragmaGhc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XInlinePragmaGhc -> c XInlinePragmaGhc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XInlinePragmaGhc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XInlinePragmaGhc
$ctoConstr :: XInlinePragmaGhc -> Constr
toConstr :: XInlinePragmaGhc -> Constr
$cdataTypeOf :: XInlinePragmaGhc -> DataType
dataTypeOf :: XInlinePragmaGhc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XInlinePragmaGhc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XInlinePragmaGhc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XInlinePragmaGhc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XInlinePragmaGhc)
$cgmapT :: (forall b. Data b => b -> b)
-> XInlinePragmaGhc -> XInlinePragmaGhc
gmapT :: (forall b. Data b => b -> b)
-> XInlinePragmaGhc -> XInlinePragmaGhc
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XInlinePragmaGhc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> XInlinePragmaGhc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> XInlinePragmaGhc -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> XInlinePragmaGhc -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> XInlinePragmaGhc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XInlinePragmaGhc -> m XInlinePragmaGhc
Data)

instance NFData XInlinePragmaGhc where
  rnf :: XInlinePragmaGhc -> ()
rnf (XInlinePragmaGhc SourceText
s InlineSaturation
a) = SourceText -> ()
forall a. NFData a => a -> ()
rnf SourceText
s () -> () -> ()
forall a b. a -> b -> b
`seq` InlineSaturation -> ()
forall a. NFData a => a -> ()
rnf InlineSaturation
a () -> () -> ()
forall a b. a -> b -> b
`seq` ()

data XXActivationGhc = XActiveFinal
  deriving (XXActivationGhc -> XXActivationGhc -> Bool
(XXActivationGhc -> XXActivationGhc -> Bool)
-> (XXActivationGhc -> XXActivationGhc -> Bool)
-> Eq XXActivationGhc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XXActivationGhc -> XXActivationGhc -> Bool
== :: XXActivationGhc -> XXActivationGhc -> Bool
$c/= :: XXActivationGhc -> XXActivationGhc -> Bool
/= :: XXActivationGhc -> XXActivationGhc -> Bool
Eq, Typeable XXActivationGhc
Typeable XXActivationGhc =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> XXActivationGhc -> c XXActivationGhc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c XXActivationGhc)
-> (XXActivationGhc -> Constr)
-> (XXActivationGhc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c XXActivationGhc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c XXActivationGhc))
-> ((forall b. Data b => b -> b)
    -> XXActivationGhc -> XXActivationGhc)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> XXActivationGhc -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> XXActivationGhc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> XXActivationGhc -> m XXActivationGhc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> XXActivationGhc -> m XXActivationGhc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> XXActivationGhc -> m XXActivationGhc)
-> Data XXActivationGhc
XXActivationGhc -> Constr
XXActivationGhc -> DataType
(forall b. Data b => b -> b) -> XXActivationGhc -> XXActivationGhc
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) -> XXActivationGhc -> u
forall u. (forall d. Data d => d -> u) -> XXActivationGhc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XXActivationGhc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XXActivationGhc -> c XXActivationGhc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XXActivationGhc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XXActivationGhc)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XXActivationGhc -> c XXActivationGhc
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> XXActivationGhc -> c XXActivationGhc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XXActivationGhc
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c XXActivationGhc
$ctoConstr :: XXActivationGhc -> Constr
toConstr :: XXActivationGhc -> Constr
$cdataTypeOf :: XXActivationGhc -> DataType
dataTypeOf :: XXActivationGhc -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XXActivationGhc)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c XXActivationGhc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XXActivationGhc)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c XXActivationGhc)
$cgmapT :: (forall b. Data b => b -> b) -> XXActivationGhc -> XXActivationGhc
gmapT :: (forall b. Data b => b -> b) -> XXActivationGhc -> XXActivationGhc
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> XXActivationGhc -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> XXActivationGhc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> XXActivationGhc -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> XXActivationGhc -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> XXActivationGhc -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> XXActivationGhc -> m XXActivationGhc
Data)

instance NFData XXActivationGhc where
  rnf :: XXActivationGhc -> ()
rnf !XXActivationGhc
x = XXActivationGhc
x XXActivationGhc -> () -> ()
forall a b. a -> b -> b
`seq` ()


{-# COMPLETE AlwaysActive, ActiveBefore, ActiveAfter, NeverActive, ActiveFinal #-}
pattern ActiveFinal :: Activation (GhcPass p)
pattern $mActiveFinal :: forall {r} {p :: Pass}.
Activation (GhcPass p) -> ((# #) -> r) -> ((# #) -> r) -> r
$bActiveFinal :: forall (p :: Pass). Activation (GhcPass p)
ActiveFinal = XActivation XActiveFinal

type instance XInlinePragma GhcPs = SourceText
type instance XInlinePragma GhcRn = XInlinePragmaGhc
type instance XInlinePragma GhcTc = XInlinePragmaGhc
type instance XXInlinePragma (GhcPass _) = DataConCantHappen
type instance XXActivation   (GhcPass _) = XXActivationGhc

-- | The default 'InlinePragma' definition for GHC.
-- The type and value of 'inl_ext' provided will differ
-- between the passes of GHC. Consequently, it may be
-- necessary to apply type annotation at the call site
-- to help the type checker disambiguate the correct
-- type of 'inl_ext'.
defaultInlinePragma :: forall p. IsPass p => InlinePragma (GhcPass p)
defaultInlinePragma :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
defaultInlinePragma =
  let srcTxt :: SourceText
srcTxt = FastString -> SourceText
FastString -> SourceText
SourceText (FastString -> SourceText) -> FastString -> SourceText
forall a b. (a -> b) -> a -> b
$ String -> FastString
fsLit String
"{-# INLINE"
      inlExt :: XInlinePragma (GhcPass p)
inlExt =  case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
        GhcPass p
GhcPs -> XInlinePragma (GhcPass p)
SourceText
srcTxt
        GhcPass p
GhcRn -> SourceText -> InlineSaturation -> XInlinePragmaGhc
XInlinePragmaGhc SourceText
srcTxt InlineSaturation
AnySaturation
        GhcPass p
GhcTc -> SourceText -> InlineSaturation -> XInlinePragmaGhc
XInlinePragmaGhc SourceText
srcTxt InlineSaturation
AnySaturation
  in  InlinePragma
        { inl_ext :: XInlinePragma (GhcPass p)
inl_ext = XInlinePragma (GhcPass p)
inlExt
        , inl_act :: Activation (GhcPass p)
inl_act = Activation (GhcPass p)
ActivationX XXActivationGhc
forall e. ActivationX e
AlwaysActive
        , inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
FunLike
        , inl_inline :: InlineSpec
inl_inline = InlineSpec
NoUserInlinePrag }

-- | The default 'InlinePragma' definition for the "parser pass" of GHC.
alwaysInlinePragma, neverInlinePragma, alwaysConLikePragma, alwaysInlineConLikePragma, dfunInlinePragma
  :: forall p. IsPass p => InlinePragma (GhcPass p)


alwaysInlinePragma :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
alwaysInlinePragma        = (forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
defaultInlinePragma @p) { inl_inline = Inline }
neverInlinePragma :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
neverInlinePragma         = (forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
defaultInlinePragma @p) { inl_act    = NeverActive }
alwaysConLikePragma :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
alwaysConLikePragma       = (forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
defaultInlinePragma @p) { inl_rule   = ConLike }
alwaysInlineConLikePragma :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
alwaysInlineConLikePragma = (forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
alwaysInlinePragma  @p) { inl_rule   = ConLike }

-- A DFun has an always-active inline activation so that
-- exprIsConApp_maybe can "see" its unfolding
-- (However, its actual Unfolding is a DFunUnfolding, which is
--  never inlined other than via exprIsConApp_maybe.)
dfunInlinePragma :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
dfunInlinePragma = (forall (p :: Pass). IsPass p => InlinePragma (GhcPass p)
defaultInlinePragma @p) { inl_act  = AlwaysActive
                                            , inl_rule = ConLike }

isDefaultInlinePragma :: InlinePragma (GhcPass p) -> Bool
isDefaultInlinePragma :: forall (p :: Pass). InlinePragma (GhcPass p) -> Bool
isDefaultInlinePragma (InlinePragma { inl_act :: forall pass. InlinePragma pass -> Activation pass
inl_act = Activation (GhcPass p)
activation
                                    , inl_rule :: forall pass. InlinePragma pass -> RuleMatchInfo
inl_rule = RuleMatchInfo
match_info
                                    , inl_inline :: forall pass. InlinePragma pass -> InlineSpec
inl_inline = InlineSpec
inline })
  = InlineSpec -> Bool
noUserInlineSpec InlineSpec
inline Bool -> Bool -> Bool
&& ActivationX XXActivationGhc -> Bool
isAlwaysActive Activation (GhcPass p)
ActivationX XXActivationGhc
activation Bool -> Bool -> Bool
&& RuleMatchInfo -> Bool
isFunLike RuleMatchInfo
match_info

inlinePragmaSource :: forall p. IsPass p => InlinePragma (GhcPass p) -> SourceText
inlinePragmaSource :: forall (p :: Pass).
IsPass p =>
InlinePragma (GhcPass p) -> SourceText
inlinePragmaSource (InlinePragma { inl_ext :: forall pass. InlinePragma pass -> XInlinePragma pass
inl_ext = XInlinePragma (GhcPass p)
src }) = SourceText
srcTxt
  where
    srcTxt :: SourceText
srcTxt = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> XInlinePragma (GhcPass p)
SourceText
src
      GhcPass p
GhcRn -> XInlinePragmaGhc -> SourceText
xinl_src XInlinePragma (GhcPass p)
XInlinePragmaGhc
src
      GhcPass p
GhcTc -> XInlinePragmaGhc -> SourceText
xinl_src XInlinePragma (GhcPass p)
XInlinePragmaGhc
src

inlinePragmaSaturation :: forall p. (XInlinePragma (GhcPass p) ~ XInlinePragmaGhc)
  => InlinePragma (GhcPass p) -> InlineSaturation
inlinePragmaSaturation :: forall (p :: Pass).
(XInlinePragma (GhcPass p) ~ XInlinePragmaGhc) =>
InlinePragma (GhcPass p) -> InlineSaturation
inlinePragmaSaturation = XInlinePragmaGhc -> InlineSaturation
xinl_sat (XInlinePragmaGhc -> InlineSaturation)
-> (InlinePragma (GhcPass p) -> XInlinePragmaGhc)
-> InlinePragma (GhcPass p)
-> InlineSaturation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InlinePragma (GhcPass p) -> XInlinePragma (GhcPass p)
InlinePragma (GhcPass p) -> XInlinePragmaGhc
forall pass. InlinePragma pass -> XInlinePragma pass
inl_ext

inlinePragmaSpec :: InlinePragma (GhcPass p) -> InlineSpec
inlinePragmaSpec :: forall (p :: Pass). InlinePragma (GhcPass p) -> InlineSpec
inlinePragmaSpec = InlinePragma (GhcPass p) -> InlineSpec
forall pass. InlinePragma pass -> InlineSpec
inl_inline

inlinePragmaActivation :: InlinePragma (GhcPass p) -> ActivationGhc
inlinePragmaActivation :: forall (p :: Pass).
InlinePragma (GhcPass p) -> ActivationX XXActivationGhc
inlinePragmaActivation (InlinePragma { inl_act :: forall pass. InlinePragma pass -> Activation pass
inl_act = Activation (GhcPass p)
activation }) = Activation (GhcPass p)
ActivationX XXActivationGhc
activation

inlinePragmaRuleMatchInfo :: InlinePragma (GhcPass p) -> RuleMatchInfo
inlinePragmaRuleMatchInfo :: forall (p :: Pass). InlinePragma (GhcPass p) -> RuleMatchInfo
inlinePragmaRuleMatchInfo (InlinePragma { inl_rule :: forall pass. InlinePragma pass -> RuleMatchInfo
inl_rule = RuleMatchInfo
info }) = RuleMatchInfo
info

setInlinePragmaSource :: forall p. IsPass p
  => InlinePragma (GhcPass p) -> SourceText -> InlinePragma (GhcPass p)
setInlinePragmaSource :: forall (p :: Pass).
IsPass p =>
InlinePragma (GhcPass p) -> SourceText -> InlinePragma (GhcPass p)
setInlinePragmaSource InlinePragma (GhcPass p)
prag SourceText
srcTxt = InlinePragma (GhcPass p)
prag { inl_ext = newExt }
  where
    oldExt :: XInlinePragma (GhcPass p)
oldExt = InlinePragma (GhcPass p) -> XInlinePragma (GhcPass p)
forall pass. InlinePragma pass -> XInlinePragma pass
inl_ext InlinePragma (GhcPass p)
prag
    newExt :: XInlinePragma (GhcPass p)
newExt = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
      GhcPass p
GhcPs -> XInlinePragma (GhcPass p)
SourceText
srcTxt
      GhcPass p
GhcRn -> XInlinePragma (GhcPass p)
oldExt { xinl_src = srcTxt }
      GhcPass p
GhcTc -> XInlinePragma (GhcPass p)
oldExt { xinl_src = srcTxt }

setInlinePragmaActivation ::
  InlinePragma (GhcPass p) -> ActivationGhc -> InlinePragma (GhcPass p)
setInlinePragmaActivation :: forall (p :: Pass).
InlinePragma (GhcPass p)
-> ActivationX XXActivationGhc -> InlinePragma (GhcPass p)
setInlinePragmaActivation InlinePragma (GhcPass p)
prag ActivationX XXActivationGhc
activation = InlinePragma (GhcPass p)
prag { inl_act = activation }

setInlinePragmaRuleMatchInfo ::
  InlinePragma (GhcPass p) -> RuleMatchInfo -> InlinePragma (GhcPass p)
setInlinePragmaRuleMatchInfo :: forall (p :: Pass).
InlinePragma (GhcPass p)
-> RuleMatchInfo -> InlinePragma (GhcPass p)
setInlinePragmaRuleMatchInfo InlinePragma (GhcPass p)
prag RuleMatchInfo
info = InlinePragma (GhcPass p)
prag { inl_rule = info }

setInlinePragmaSaturation :: forall p q. (IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc)
  => InlinePragma (GhcPass p) -> InlineSaturation -> InlinePragma (GhcPass q)
setInlinePragmaSaturation :: forall (p :: Pass) (q :: Pass).
(IsPass p, XInlinePragma (GhcPass q) ~ XInlinePragmaGhc) =>
InlinePragma (GhcPass p)
-> InlineSaturation -> InlinePragma (GhcPass q)
setInlinePragmaSaturation InlinePragma (GhcPass p)
prag InlineSaturation
sat =
    InlinePragma (GhcPass p)
prag { inl_ext = XInlinePragmaGhc (inlinePragmaSource prag) sat
         , inl_act = inl_act prag
         }

setInlinePragmaSpec ::
  InlinePragma (GhcPass p) -> InlineSpec -> InlinePragma (GhcPass p)
setInlinePragmaSpec :: forall (p :: Pass).
InlinePragma (GhcPass p) -> InlineSpec -> InlinePragma (GhcPass p)
setInlinePragmaSpec InlinePragma (GhcPass p)
prag InlineSpec
spec = InlinePragma (GhcPass p)
prag { inl_inline = spec }

tcInlinePragma :: InlinePragma GhcRn -> InlinePragma GhcTc
tcInlinePragma :: InlinePragma GhcRn -> InlinePragma GhcTc
tcInlinePragma prag :: InlinePragma GhcRn
prag@(InlinePragma { inl_ext :: forall pass. InlinePragma pass -> XInlinePragma pass
inl_ext = XInlinePragma GhcRn
src }) =
  InlinePragma GhcRn
prag { inl_ext = src
       , inl_act = inl_act prag
       }

{-
************************************************************************
*                                                                      *
\subsection{Activation}
*                                                                      *
************************************************************************

When a rule or inlining is active

Note [Compiler phases]
~~~~~~~~~~~~~~~~~~~~~~
The CompilerPhase says which phase the simplifier is running in:

* InitialPhase: before all user-visible phases

* Phase 2,1,0: user-visible phases; the phase number
  controls rule ordering an inlining.

* FinalPhase: used for all subsequent simplifier
  runs. By delaying inlining of wrappers to FinalPhase we can
  ensure that RULE have a good chance to fire. See
  Note [Wrapper activation] in GHC.Core.Opt.WorkWrap

  NB: FinalPhase is run repeatedly, not just once.

  NB: users don't have access to InitialPhase or FinalPhase.
  They write {-# INLINE[n] f #-}, meaning (Phase n)

The phase sequencing is done by GHC.Opt.Simplify.Driver
-}

-- | Compilation phase number, including the user-specifiable 'PhaseNum'
-- and the GHC internal "initial" and "final" phases.
data CompilerPhase
  = InitialPhase    -- ^ The first phase; number = infinity!
  | Phase PhaseNum  -- ^ User-specifiable phases
  | FinalPhase      -- ^ The last phase; number = -infinity!
  deriving (CompilerPhase -> CompilerPhase -> Bool
(CompilerPhase -> CompilerPhase -> Bool)
-> (CompilerPhase -> CompilerPhase -> Bool) -> Eq CompilerPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CompilerPhase -> CompilerPhase -> Bool
== :: CompilerPhase -> CompilerPhase -> Bool
$c/= :: CompilerPhase -> CompilerPhase -> Bool
/= :: CompilerPhase -> CompilerPhase -> Bool
Eq, Typeable CompilerPhase
Typeable CompilerPhase =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> CompilerPhase -> c CompilerPhase)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CompilerPhase)
-> (CompilerPhase -> Constr)
-> (CompilerPhase -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CompilerPhase))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CompilerPhase))
-> ((forall b. Data b => b -> b) -> CompilerPhase -> CompilerPhase)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r)
-> (forall u. (forall d. Data d => d -> u) -> CompilerPhase -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CompilerPhase -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase)
-> Data CompilerPhase
CompilerPhase -> Constr
CompilerPhase -> DataType
(forall b. Data b => b -> b) -> CompilerPhase -> CompilerPhase
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) -> CompilerPhase -> u
forall u. (forall d. Data d => d -> u) -> CompilerPhase -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerPhase
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerPhase -> c CompilerPhase
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerPhase)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerPhase)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerPhase -> c CompilerPhase
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompilerPhase -> c CompilerPhase
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerPhase
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompilerPhase
$ctoConstr :: CompilerPhase -> Constr
toConstr :: CompilerPhase -> Constr
$cdataTypeOf :: CompilerPhase -> DataType
dataTypeOf :: CompilerPhase -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerPhase)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompilerPhase)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerPhase)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompilerPhase)
$cgmapT :: (forall b. Data b => b -> b) -> CompilerPhase -> CompilerPhase
gmapT :: (forall b. Data b => b -> b) -> CompilerPhase -> CompilerPhase
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompilerPhase -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CompilerPhase -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompilerPhase -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CompilerPhase -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CompilerPhase -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CompilerPhase -> m CompilerPhase
Data)

instance NFData CompilerPhase where
  rnf :: CompilerPhase -> ()
rnf = \case
    CompilerPhase
InitialPhase -> ()
    CompilerPhase
FinalPhase -> ()
    Phase Int
i -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
i

-- ^ @activeAfter p@ makes an 'Activation' that is active in phase @p@ and after
--
-- Invariant: @beginPhase (activeAfter p) = p@
activeAfter :: CompilerPhase -> ActivationGhc
activeAfter :: CompilerPhase -> ActivationX XXActivationGhc
activeAfter CompilerPhase
InitialPhase = ActivationX XXActivationGhc
forall e. ActivationX e
AlwaysActive
activeAfter (Phase Int
n)    = Int -> ActivationX XXActivationGhc
forall e. Int -> ActivationX e
ActiveAfter Int
n
activeAfter CompilerPhase
FinalPhase   = Activation (GhcPass (ZonkAny 0))
ActivationX XXActivationGhc
forall (p :: Pass). Activation (GhcPass p)
ActiveFinal

activeInPhase :: PhaseNum -> ActivationGhc -> Bool
activeInPhase :: Int -> ActivationX XXActivationGhc -> Bool
activeInPhase Int
_ ActivationX XXActivationGhc
AlwaysActive     = Bool
True
activeInPhase Int
_ ActivationX XXActivationGhc
NeverActive      = Bool
False
activeInPhase Int
_ Activation (GhcPass (ZonkAny 1))
ActivationX XXActivationGhc
ActiveFinal      = Bool
False
activeInPhase Int
p (ActiveAfter  Int
n) = Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
activeInPhase Int
p (ActiveBefore Int
n) = Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
n

activeInFinalPhase :: ActivationGhc -> Bool
activeInFinalPhase :: ActivationX XXActivationGhc -> Bool
activeInFinalPhase ActivationX XXActivationGhc
AlwaysActive     = Bool
True
activeInFinalPhase Activation (GhcPass (ZonkAny 2))
ActivationX XXActivationGhc
ActiveFinal      = Bool
True
activeInFinalPhase (ActiveAfter {}) = Bool
True
activeInFinalPhase ActivationX XXActivationGhc
_                = Bool
False

isNeverActive, isAlwaysActive :: ActivationGhc -> Bool
isNeverActive :: ActivationX XXActivationGhc -> Bool
isNeverActive ActivationX XXActivationGhc
NeverActive = Bool
True
isNeverActive ActivationX XXActivationGhc
_           = Bool
False

isAlwaysActive :: ActivationX XXActivationGhc -> Bool
isAlwaysActive ActivationX XXActivationGhc
AlwaysActive = Bool
True
isAlwaysActive ActivationX XXActivationGhc
_            = Bool
False

activateAfterInitial :: ActivationGhc
-- ^ Active in the first phase after the initial phase
activateAfterInitial :: ActivationX XXActivationGhc
activateAfterInitial = CompilerPhase -> ActivationX XXActivationGhc
activeAfter (CompilerPhase -> CompilerPhase
nextPhase CompilerPhase
InitialPhase)

activateDuringFinal :: ActivationGhc
-- ^ Active in the final simplification phase (which is repeated)
activateDuringFinal :: ActivationX XXActivationGhc
activateDuringFinal = Activation (GhcPass (ZonkAny 3))
ActivationX XXActivationGhc
forall (p :: Pass). Activation (GhcPass p)
ActiveFinal

activeInInitialPhase :: ActivationGhc -> Bool
activeInInitialPhase :: ActivationX XXActivationGhc -> Bool
activeInInitialPhase ActivationX XXActivationGhc
act = ActivationX XXActivationGhc -> CompilerPhase
beginPhase ActivationX XXActivationGhc
act CompilerPhase -> CompilerPhase -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerPhase
InitialPhase

beginPhase :: ActivationGhc -> CompilerPhase
-- ^ First phase in which the 'Activation' is active,
-- or 'FinalPhase' if it is never active
beginPhase :: ActivationX XXActivationGhc -> CompilerPhase
beginPhase ActivationX XXActivationGhc
AlwaysActive      = CompilerPhase
InitialPhase
beginPhase (ActiveBefore {}) = CompilerPhase
InitialPhase
beginPhase (ActiveAfter Int
n)   = Int -> CompilerPhase
Phase Int
n
beginPhase Activation (GhcPass (ZonkAny 4))
ActivationX XXActivationGhc
ActiveFinal       = CompilerPhase
FinalPhase
beginPhase ActivationX XXActivationGhc
NeverActive       = CompilerPhase
FinalPhase

endPhase :: ActivationGhc -> CompilerPhase
-- ^ Last phase in which the 'Activation' is active,
-- or 'InitialPhase' if it is never active
endPhase :: ActivationX XXActivationGhc -> CompilerPhase
endPhase ActivationX XXActivationGhc
AlwaysActive       = CompilerPhase
FinalPhase
endPhase (ActiveBefore Int
n)   =
  if CompilerPhase -> CompilerPhase
nextPhase CompilerPhase
InitialPhase CompilerPhase -> CompilerPhase -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> CompilerPhase
Phase Int
n
  then CompilerPhase
InitialPhase
  else Int -> CompilerPhase
Int -> CompilerPhase
Phase (Int -> CompilerPhase) -> Int -> CompilerPhase
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
endPhase (ActiveAfter {})   = CompilerPhase
FinalPhase
endPhase Activation (GhcPass (ZonkAny 5))
ActivationX XXActivationGhc
ActiveFinal        = CompilerPhase
FinalPhase
endPhase ActivationX XXActivationGhc
NeverActive        = CompilerPhase
InitialPhase

nextPhase :: CompilerPhase -> CompilerPhase
-- ^ Tells you the next phase after this one
--
-- Currently we have just phases @[2,1,0,FinalPhase,FinalPhase,...]@,
-- where FinalPhase means GHC's internal simplification steps
-- after all rules have run
nextPhase :: CompilerPhase -> CompilerPhase
nextPhase CompilerPhase
InitialPhase = Int -> CompilerPhase
Phase Int
2
nextPhase (Phase Int
0)    = CompilerPhase
FinalPhase
nextPhase (Phase Int
n)    = Int -> CompilerPhase
Phase (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
nextPhase CompilerPhase
FinalPhase   = CompilerPhase
FinalPhase

laterPhase :: CompilerPhase -> CompilerPhase -> CompilerPhase
-- ^ Returns the later of two phases
laterPhase :: CompilerPhase -> CompilerPhase -> CompilerPhase
laterPhase (Phase Int
n1)   (Phase Int
n2)   = Int -> CompilerPhase
Phase (Int
n1 Int -> Int -> Int
forall a. Ord a => a -> a -> a
`min` Int
n2)
laterPhase CompilerPhase
InitialPhase CompilerPhase
p2           = CompilerPhase
p2
laterPhase CompilerPhase
FinalPhase   CompilerPhase
_            = CompilerPhase
FinalPhase
laterPhase CompilerPhase
p1           CompilerPhase
InitialPhase = CompilerPhase
p1
laterPhase CompilerPhase
_            CompilerPhase
FinalPhase   = CompilerPhase
FinalPhase

-- | @p1 `laterThanOrEqualPhase` p2@ computes whether @p1@ happens (strictly)
-- after @p2@.
laterThanPhase :: CompilerPhase -> CompilerPhase -> Bool
CompilerPhase
p1 laterThanPhase :: CompilerPhase -> CompilerPhase -> Bool
`laterThanPhase` CompilerPhase
p2 = CompilerPhase -> Int
toNum CompilerPhase
p1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< CompilerPhase -> Int
toNum CompilerPhase
p2
  where
    toNum :: CompilerPhase -> Int
    toNum :: CompilerPhase -> Int
toNum CompilerPhase
InitialPhase = Int
forall a. Bounded a => a
maxBound
    toNum (Phase Int
i)    = Int
i
    toNum CompilerPhase
FinalPhase   = Int
forall a. Bounded a => a
minBound

isActiveInPhase :: CompilerPhase -> ActivationGhc -> Bool
isActiveInPhase :: CompilerPhase -> ActivationX XXActivationGhc -> Bool
isActiveInPhase CompilerPhase
InitialPhase ActivationX XXActivationGhc
act = ActivationX XXActivationGhc -> Bool
activeInInitialPhase ActivationX XXActivationGhc
act
isActiveInPhase (Phase Int
p)    ActivationX XXActivationGhc
act = Int -> ActivationX XXActivationGhc -> Bool
activeInPhase Int
p ActivationX XXActivationGhc
act
isActiveInPhase CompilerPhase
FinalPhase   ActivationX XXActivationGhc
act = ActivationX XXActivationGhc -> Bool
activeInFinalPhase ActivationX XXActivationGhc
act

-- | @act1 `competesWith` act2@ returns whether @act1@ is active in the phase
-- when @act2@ __becomes__ active.
--
-- This answers the question: might @act1@ fire first?
--
-- NB: this is not the same as computing whether @act1@ and @act2@ are
-- ever active at the same time.
--
-- See Note [Competing activations]
competesWith :: ActivationGhc -> ActivationGhc-> Bool
competesWith :: ActivationX XXActivationGhc -> ActivationX XXActivationGhc -> Bool
competesWith ActivationX XXActivationGhc
NeverActive  ActivationX XXActivationGhc
_           = Bool
False
competesWith ActivationX XXActivationGhc
_            ActivationX XXActivationGhc
NeverActive = Bool
False -- See Wrinkle [Never active rules]
competesWith ActivationX XXActivationGhc
act1         ActivationX XXActivationGhc
act2        = CompilerPhase -> ActivationX XXActivationGhc -> Bool
isActiveInPhase (ActivationX XXActivationGhc -> CompilerPhase
beginPhase ActivationX XXActivationGhc
act2) ActivationX XXActivationGhc
act1

{- Note [Competing activations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sometimes a RULE and an inlining may compete, or two RULES.
See Note [Rules and inlining/other rules] in GHC.HsToCore.

We say that act1 "competes with" act2 iff
   act1 is active in the phase when act2 *becomes* active
NB: remember that phases count *down*: 2, 1, 0!

It's too conservative to ensure that the two are never simultaneously
active.  For example, a rule might be always active, and an inlining
might switch on in phase 2.  We could switch off the rule, but it does
no harm.

  Wrinkle [Never active rules]

    Rules can be declared as "never active" by users, using the syntax:

      {-# RULE "blah" [~] ... #-}

        (This feature exists solely for compiler plugins, by making it possible
        to define a RULE that is never run by GHC, but is nevertheless parsed,
        typechecked etc, so that it is available to the plugin.)

    We should not warn about competing rules, so make sure that 'competesWith'
    always returns 'False' when its second argument is 'NeverActive'.
-}

{- TODO: These orphan instance should be moved to the GHC.Utils.{Binary,Outputable}
modules once TTG has progressed and the Language.Haskell.Syntax.Types module
no longer depends on importing GHC.Hs.Doc.
-}
instance Binary XInlinePragmaGhc where
    put_ :: WriteBinHandle -> XInlinePragmaGhc -> IO ()
put_ WriteBinHandle
bh (XInlinePragmaGhc SourceText
s InlineSaturation
a) = do
            WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SourceText
s
            WriteBinHandle -> InlineSaturation -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh InlineSaturation
a

    get :: ReadBinHandle -> IO XInlinePragmaGhc
get ReadBinHandle
bh = do
           s <- ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
           a <- get bh
           return (XInlinePragmaGhc s a)

instance forall p. IsPass p => Binary (InlinePragma (GhcPass p)) where
    put_ :: WriteBinHandle -> InlinePragma (GhcPass p) -> IO ()
put_ WriteBinHandle
bh (InlinePragma XInlinePragma (GhcPass p)
s InlineSpec
a Activation (GhcPass p)
b RuleMatchInfo
c) = do
            WriteBinHandle -> InlineSpec -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh InlineSpec
a
            WriteBinHandle -> ActivationX XXActivationGhc -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Activation (GhcPass p)
ActivationX XXActivationGhc
b
            WriteBinHandle -> RuleMatchInfo -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh RuleMatchInfo
c
            case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
              GhcPass p
GhcPs -> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XInlinePragma (GhcPass p)
SourceText
s
              GhcPass p
GhcRn -> WriteBinHandle -> XInlinePragmaGhc -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XInlinePragma (GhcPass p)
XInlinePragmaGhc
s
              GhcPass p
GhcTc -> WriteBinHandle -> XInlinePragmaGhc -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh XInlinePragma (GhcPass p)
XInlinePragmaGhc
s

    get :: ReadBinHandle -> IO (InlinePragma (GhcPass p))
get ReadBinHandle
bh = do
           a <- ReadBinHandle -> IO InlineSpec
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
           b <- get bh
           c <- get bh
           s <- case ghcPass @p of
                  GhcPass p
GhcPs -> ReadBinHandle -> IO (XInlinePragma (GhcPass p))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                  GhcPass p
GhcRn -> ReadBinHandle -> IO (XInlinePragma (GhcPass p))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
                  GhcPass p
GhcTc -> ReadBinHandle -> IO (XInlinePragma (GhcPass p))
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
           return (InlinePragma s a b c)

instance Binary InlineSaturation where
    put_ :: WriteBinHandle -> InlineSaturation -> IO ()
put_ WriteBinHandle
bh InlineSaturation
AnySaturation = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh (AppliedToAtLeast Int
w) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
w

    get :: ReadBinHandle -> IO InlineSaturation
get ReadBinHandle
bh = do
      h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
      if h == 0 then pure AnySaturation
                else AppliedToAtLeast <$> get bh

instance Binary ActivationGhc where
    put_ :: WriteBinHandle -> ActivationX XXActivationGhc -> IO ()
put_ WriteBinHandle
bh = \case
      ActivationX XXActivationGhc
NeverActive     -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
      ActivationX XXActivationGhc
AlwaysActive    -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
      ActiveBefore Int
aa -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
aa
      ActiveAfter  Int
ab -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
ab
      XActivation  XXActivationGhc
_  -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4

    get :: ReadBinHandle -> IO (ActivationX XXActivationGhc)
get ReadBinHandle
bh = do
      h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
      case h of
        Word8
0 -> ActivationX XXActivationGhc -> IO (ActivationX XXActivationGhc)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivationX XXActivationGhc
forall e. ActivationX e
NeverActive
        Word8
1 -> ActivationX XXActivationGhc -> IO (ActivationX XXActivationGhc)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ActivationX XXActivationGhc
forall e. ActivationX e
AlwaysActive
        Word8
2 -> Int -> ActivationX XXActivationGhc
Int -> ActivationX XXActivationGhc
forall e. Int -> ActivationX e
ActiveBefore (Int -> ActivationX XXActivationGhc)
-> IO Int -> IO (ActivationX XXActivationGhc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        Word8
3 -> Int -> ActivationX XXActivationGhc
Int -> ActivationX XXActivationGhc
forall e. Int -> ActivationX e
ActiveAfter  (Int -> ActivationX XXActivationGhc)
-> IO Int -> IO (ActivationX XXActivationGhc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        Word8
_ -> ActivationX XXActivationGhc -> IO (ActivationX XXActivationGhc)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Activation (GhcPass (ZonkAny 6))
ActivationX XXActivationGhc
forall (p :: Pass). Activation (GhcPass p)
ActiveFinal

instance Binary CompilerPhase where
  put_ :: WriteBinHandle -> CompilerPhase -> IO ()
put_ WriteBinHandle
bh CompilerPhase
InitialPhase = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
  put_ WriteBinHandle
bh (Phase Int
i)    = do { WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1; WriteBinHandle -> Int -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh Int
i }
  put_ WriteBinHandle
bh CompilerPhase
FinalPhase   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2

  get :: ReadBinHandle -> IO CompilerPhase
get ReadBinHandle
bh = do
    h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
    case h of
      Word8
0 -> CompilerPhase -> IO CompilerPhase
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerPhase
InitialPhase
      Word8
1 -> do { p <- ReadBinHandle -> IO Int
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh; return (Phase p) }
      Word8
_ -> CompilerPhase -> IO CompilerPhase
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CompilerPhase
FinalPhase

instance Outputable CompilerPhase where
   ppr :: CompilerPhase -> SDoc
ppr (Phase Int
n)    = Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n
   ppr CompilerPhase
InitialPhase = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"initial"
   ppr CompilerPhase
FinalPhase   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"final"

-- | Outputs string for pragma name for any of INLINE/INLINABLE/NOINLINE. This
-- differs from the Outputable instance for the InlineSpec type where the pragma
-- name string as well as the accompanying SourceText (if any) is printed.
inlinePragmaName :: InlineSpec -> SDoc
inlinePragmaName :: InlineSpec -> SDoc
inlinePragmaName InlineSpec
Inline           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"INLINE"
inlinePragmaName InlineSpec
Inlinable        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"INLINABLE"
inlinePragmaName InlineSpec
NoInline         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NOINLINE"
inlinePragmaName InlineSpec
Opaque           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OPAQUE"
inlinePragmaName InlineSpec
NoUserInlinePrag = SDoc
forall doc. IsOutput doc => doc
empty

-- | Pretty-print without displaying the user-specified 'InlineSpec'.
pprInline :: forall p. IsPass p => InlinePragma (GhcPass p) -> SDoc
pprInline :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p) -> SDoc
pprInline = Bool -> InlinePragma (GhcPass p) -> SDoc
forall (p :: Pass).
IsPass p =>
Bool -> InlinePragma (GhcPass p) -> SDoc
pprInline' Bool
True

-- | Pretty-print including the user-specified 'InlineSpec'.
pprInlineDebug :: forall p. IsPass p => InlinePragma (GhcPass p) -> SDoc
pprInlineDebug :: forall (p :: Pass). IsPass p => InlinePragma (GhcPass p) -> SDoc
pprInlineDebug = Bool -> InlinePragma (GhcPass p) -> SDoc
forall (p :: Pass).
IsPass p =>
Bool -> InlinePragma (GhcPass p) -> SDoc
pprInline' Bool
False

pprInline' :: forall p. IsPass p
           => Bool           -- True <=> do not display the inl_inline field
           -> InlinePragma (GhcPass p)
           -> SDoc
pprInline' :: forall (p :: Pass).
IsPass p =>
Bool -> InlinePragma (GhcPass p) -> SDoc
pprInline' Bool
emptyInline (InlinePragma
                        { inl_ext :: forall pass. InlinePragma pass -> XInlinePragma pass
inl_ext = XInlinePragma (GhcPass p)
ext,
                          inl_inline :: forall pass. InlinePragma pass -> InlineSpec
inl_inline = InlineSpec
inline,
                          inl_act :: forall pass. InlinePragma pass -> Activation pass
inl_act = Activation (GhcPass p)
activation,
                          inl_rule :: forall pass. InlinePragma pass -> RuleMatchInfo
inl_rule = RuleMatchInfo
info })
    = InlineSpec -> SDoc
pp_inl InlineSpec
inline SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> InlineSpec -> ActivationX XXActivationGhc -> SDoc
forall {e}. InlineSpec -> ActivationX e -> SDoc
pp_act InlineSpec
inline Activation (GhcPass p)
ActivationX XXActivationGhc
activation SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_sat SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_info
    where
      pp_inl :: InlineSpec -> SDoc
pp_inl InlineSpec
x = if Bool
emptyInline then SDoc
forall doc. IsOutput doc => doc
empty else InlineSpec -> SDoc
inlinePragmaName InlineSpec
x

      pp_act :: InlineSpec -> ActivationX e -> SDoc
pp_act Inline   {}  ActivationX e
AlwaysActive = SDoc
forall doc. IsOutput doc => doc
empty
      pp_act NoInline {}  ActivationX e
NeverActive  = SDoc
forall doc. IsOutput doc => doc
empty
      pp_act Opaque   {}  ActivationX e
NeverActive  = SDoc
forall doc. IsOutput doc => doc
empty
      pp_act InlineSpec
_            ActivationX e
act          = ActivationX e -> SDoc
forall a. Outputable a => a -> SDoc
ppr ActivationX e
act

      pp_sat :: SDoc
pp_sat = case forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p of
        GhcPass p
GhcPs -> SDoc
forall doc. IsOutput doc => doc
empty -- No saturation information
        GhcPass p
GhcRn -> InlineSaturation -> SDoc
getSat (XInlinePragmaGhc -> InlineSaturation
xinl_sat XInlinePragma (GhcPass p)
XInlinePragmaGhc
ext)
        GhcPass p
GhcTc -> InlineSaturation -> SDoc
getSat (XInlinePragmaGhc -> InlineSaturation
xinl_sat XInlinePragma (GhcPass p)
XInlinePragmaGhc
ext)

      pp_info :: SDoc
pp_info | RuleMatchInfo -> Bool
isFunLike RuleMatchInfo
info = SDoc
forall doc. IsOutput doc => doc
empty
              | Bool
otherwise      = RuleMatchInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr RuleMatchInfo
info

      getSat :: InlineSaturation -> SDoc
      getSat :: InlineSaturation -> SDoc
getSat = \case
        InlineSaturation
AnySaturation -> SDoc
forall doc. IsOutput doc => doc
empty
        AppliedToAtLeast Int
ar -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sat-args=" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
ar)

instance forall p. IsPass p => Outputable (InlinePragma (GhcPass p)) where
  ppr :: InlinePragma (GhcPass p) -> SDoc
ppr = InlinePragma (GhcPass p) -> SDoc
forall (p :: Pass). IsPass p => InlinePragma (GhcPass p) -> SDoc
pprInline