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

\section[BasicTypes]{Miscellaneous types}

This module defines a miscellaneously collection of very simple
types that

\begin{itemize}
\item have no other obvious home
\item don't depend on any other complicated types
\item are used in more than one "part" of the compiler
\end{itemize}
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

module GHC.Types.Basic (
        LeftOrRight(..),
        pickLR,

        ConTag, ConTagZ, fIRST_TAG,

        Arity, RepArity, JoinArity, FullArgCount,

        Alignment, mkAlignment, alignmentOf, alignmentBytes,

        PromotionFlag(..), isPromoted,
        FunctionOrData(..),

        RecFlag(..), isRec, isNonRec, boolToRecFlag,
        Origin(..), isGenerated,

        RuleName, pprRuleName,

        TopLevelFlag(..), isTopLevel, isNotTopLevel,

        OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe,
        hasOverlappingFlag, hasOverlappableFlag, hasIncoherentFlag,

        Boxity(..), isBoxed,

        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, starPrec, appPrec,
        maybeParen,

        TupleSort(..), tupleSortBoxity, boxityTupleSort,
        tupleParens,

        sumParens, pprAlternative,

        -- ** The OneShotInfo type
        OneShotInfo(..),
        noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
        bestOneShot, worstOneShot,

        OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,
        isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
        isNoOccInfo, strongLoopBreaker, weakLoopBreaker,

        InsideLam(..),
        BranchCount, oneBranch,
        InterestingCxt(..),
        TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
        isAlwaysTailCalled,

        EP(..),

        DefMethSpec(..),
        SwapFlag(..), flipSwap, unSwap, isSwapped,

        CompilerPhase(..), PhaseNum,

        Activation(..), isActive, competesWith,
        isNeverActive, isAlwaysActive, activeInFinalPhase,
        activateAfterInitial, activateDuringFinal,

        RuleMatchInfo(..), isConLike, isFunLike,
        InlineSpec(..), noUserInlineSpec,
        InlinePragma(..), defaultInlinePragma, alwaysInlinePragma,
        neverInlinePragma, dfunInlinePragma,
        isDefaultInlinePragma,
        isInlinePragma, isInlinablePragma, isAnyInlinePragma,
        inlinePragmaSpec, inlinePragmaSat,
        inlinePragmaActivation, inlinePragmaRuleMatchInfo,
        setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,
        pprInline, pprInlineDebug,

        SuccessFlag(..), succeeded, failed, successIf,

        IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,

        SpliceExplicitFlag(..),

        TypeOrKind(..), isTypeLevel, isKindLevel,

        ForeignSrcLang (..)
   ) where

import GHC.Prelude

import GHC.ForeignSrcLang
import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Binary
import GHC.Types.SourceText
import Data.Data
import qualified Data.Semigroup as Semi

{-
************************************************************************
*                                                                      *
          Binary choice
*                                                                      *
************************************************************************
-}

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

pickLR :: LeftOrRight -> (a,a) -> a
pickLR :: forall a. LeftOrRight -> (a, a) -> a
pickLR LeftOrRight
CLeft  (a
l,a
_) = a
l
pickLR LeftOrRight
CRight (a
_,a
r) = a
r

instance Outputable LeftOrRight where
  ppr :: LeftOrRight -> SDoc
ppr LeftOrRight
CLeft    = String -> SDoc
text String
"Left"
  ppr LeftOrRight
CRight   = String -> SDoc
text String
"Right"

instance Binary LeftOrRight where
   put_ :: BinHandle -> LeftOrRight -> IO ()
put_ BinHandle
bh LeftOrRight
CLeft  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
   put_ BinHandle
bh LeftOrRight
CRight = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1

   get :: BinHandle -> IO LeftOrRight
get BinHandle
bh = do { Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
               ; case Word8
h of
                   Word8
0 -> LeftOrRight -> IO LeftOrRight
forall (m :: * -> *) a. Monad m => a -> m a
return LeftOrRight
CLeft
                   Word8
_ -> LeftOrRight -> IO LeftOrRight
forall (m :: * -> *) a. Monad m => a -> m a
return LeftOrRight
CRight }


{-
************************************************************************
*                                                                      *
\subsection[Arity]{Arity}
*                                                                      *
************************************************************************
-}

-- | The number of value arguments that can be applied to a value before it does
-- "real work". So:
--  fib 100     has arity 0
--  \x -> fib x has arity 1
-- See also Note [Definition of arity] in "GHC.Core.Opt.Arity"
type Arity = Int

-- | Representation Arity
--
-- The number of represented arguments that can be applied to a value before it does
-- "real work". So:
--  fib 100                    has representation arity 0
--  \x -> fib x                has representation arity 1
--  \(# x, y #) -> fib (x + y) has representation arity 2
type RepArity = Int

-- | The number of arguments that a join point takes. Unlike the arity of a
-- function, this is a purely syntactic property and is fixed when the join
-- point is created (or converted from a value). Both type and value arguments
-- are counted.
type JoinArity = Int

-- | FullArgCount is the number of type or value arguments in an application,
-- or the number of type or value binders in a lambda.  Note: it includes
-- both type and value arguments!
type FullArgCount = Int

{-
************************************************************************
*                                                                      *
              Constructor tags
*                                                                      *
************************************************************************
-}

-- | A *one-index* constructor tag
--
-- Type of the tags associated with each constructor possibility or superclass
-- selector
type ConTag = Int

-- | A *zero-indexed* constructor tag
type ConTagZ = Int

fIRST_TAG :: ConTag
-- ^ Tags are allocated from here for real constructors
--   or for superclass selectors
fIRST_TAG :: Int
fIRST_TAG =  Int
1

{-
************************************************************************
*                                                                      *
\subsection[Alignment]{Alignment}
*                                                                      *
************************************************************************
-}

-- | A power-of-two alignment
newtype Alignment = Alignment { Alignment -> Int
alignmentBytes :: Int } deriving (Alignment -> Alignment -> Bool
(Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool) -> Eq Alignment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c== :: Alignment -> Alignment -> Bool
Eq, Eq Alignment
Eq Alignment
-> (Alignment -> Alignment -> Ordering)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Bool)
-> (Alignment -> Alignment -> Alignment)
-> (Alignment -> Alignment -> Alignment)
-> Ord Alignment
Alignment -> Alignment -> Bool
Alignment -> Alignment -> Ordering
Alignment -> Alignment -> Alignment
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
min :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmax :: Alignment -> Alignment -> Alignment
>= :: Alignment -> Alignment -> Bool
$c>= :: Alignment -> Alignment -> Bool
> :: Alignment -> Alignment -> Bool
$c> :: Alignment -> Alignment -> Bool
<= :: Alignment -> Alignment -> Bool
$c<= :: Alignment -> Alignment -> Bool
< :: Alignment -> Alignment -> Bool
$c< :: Alignment -> Alignment -> Bool
compare :: Alignment -> Alignment -> Ordering
$ccompare :: Alignment -> Alignment -> Ordering
Ord)

-- Builds an alignment, throws on non power of 2 input. This is not
-- ideal, but convenient for internal use and better then silently
-- passing incorrect data.
mkAlignment :: Int -> Alignment
mkAlignment :: Int -> Alignment
mkAlignment Int
n
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Int -> Alignment
Alignment Int
1
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Int -> Alignment
Alignment Int
2
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Int -> Alignment
Alignment Int
4
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8 = Int -> Alignment
Alignment Int
8
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = Int -> Alignment
Alignment Int
16
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = Int -> Alignment
Alignment Int
32
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64 = Int -> Alignment
Alignment Int
64
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
128 = Int -> Alignment
Alignment Int
128
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
256 = Int -> Alignment
Alignment Int
256
  | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
512 = Int -> Alignment
Alignment Int
512
  | Bool
otherwise = String -> Alignment
forall a. String -> a
panic String
"mkAlignment: received either a non power of 2 argument or > 512"

-- Calculates an alignment of a number. x is aligned at N bytes means
-- the remainder from x / N is zero. Currently, interested in N <= 8,
-- but can be expanded to N <= 16 or N <= 32 if used within SSE or AVX
-- context.
alignmentOf :: Int -> Alignment
alignmentOf :: Int -> Alignment
alignmentOf Int
x = case Int
x Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
7 of
  Int
0 -> Int -> Alignment
Alignment Int
8
  Int
4 -> Int -> Alignment
Alignment Int
4
  Int
2 -> Int -> Alignment
Alignment Int
2
  Int
_ -> Int -> Alignment
Alignment Int
1

instance Outputable Alignment where
  ppr :: Alignment -> SDoc
ppr (Alignment Int
m) = Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
m

instance OutputableP env Alignment where
  pdoc :: env -> Alignment -> SDoc
pdoc env
_ = Alignment -> SDoc
forall a. Outputable a => a -> SDoc
ppr

{-
************************************************************************
*                                                                      *
         One-shot information
*                                                                      *
************************************************************************
-}

{-
Note [OneShotInfo overview]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
Lambda-bound Ids (and only lambda-bound Ids) may be decorated with
one-shot info.  The idea is that if we see
    (\x{one-shot}. e)
it means that this lambda will only be applied once.  In particular
that means we can float redexes under the lambda without losing
work.  For example, consider
    let t = expensive in
    (\x{one-shot}. case t of { True -> ...; False -> ... })

Because it's a one-shot lambda, we can safely inline t, giving
    (\x{one_shot}. case <expensive> of
                       { True -> ...; False -> ... })

Moving parts:

* Usage analysis, performed as part of demand-analysis, finds
  out whether functions call their argument once.  Consider
     f g x = Just (case g x of { ... })

  Here 'f' is lazy in 'g', but it guarantees to call it no
  more than once.  So g will get a C1(U) usage demand.

* Occurrence analysis propagates this usage information
  (in the demand signature of a function) to its calls.
  Example, given 'f' above
     f (\x.e) blah

  Since f's demand signature says it has a C1(U) usage demand on its
  first argument, the occurrence analyser sets the \x to be one-shot.
  This is done via the occ_one_shots field of OccEnv.

* Float-in and float-out take account of one-shot-ness

* Occurrence analysis doesn't set "inside-lam" for occurrences inside
  a one-shot lambda

Other notes

* A one-shot lambda can use its argument many times.  To elaborate
  the example above
    let t = expensive in
    (\x{one-shot}. case t of { True -> x+x; False -> x*x })

  Here the '\x' is one-shot, which justifies inlining 't',
  but x is used many times. That's absolutely fine.

* It's entirely possible to have
     (\x{one-shot}. \y{many-shot}. e)

  For example
     let t = expensive
         g = \x -> let v = x+t in
             \y -> x + v
     in map (g 5) xs

  Here the `\x` is a one-shot binder: `g` is applied to one argument
  exactly once.  And because the `\x` is one-shot, it would be fine to
  float that `let t = expensive` binding inside the `\x`.

  But the `\y` is most definitely not one-shot!
-}

-- | If the 'Id' is a lambda-bound variable then it may have lambda-bound
-- variable info. Sometimes we know whether the lambda binding this variable
-- is a "one-shot" lambda; that is, whether it is applied at most once.
--
-- This information may be useful in optimisation, as computations may
-- safely be floated inside such a lambda without risk of duplicating
-- work.
--
-- See also Note [OneShotInfo overview] above.
data OneShotInfo
  = NoOneShotInfo -- ^ No information
  | OneShotLam    -- ^ The lambda is applied at most once.
  deriving (OneShotInfo -> OneShotInfo -> Bool
(OneShotInfo -> OneShotInfo -> Bool)
-> (OneShotInfo -> OneShotInfo -> Bool) -> Eq OneShotInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OneShotInfo -> OneShotInfo -> Bool
$c/= :: OneShotInfo -> OneShotInfo -> Bool
== :: OneShotInfo -> OneShotInfo -> Bool
$c== :: OneShotInfo -> OneShotInfo -> Bool
Eq)

-- | It is always safe to assume that an 'Id' has no lambda-bound variable information
noOneShotInfo :: OneShotInfo
noOneShotInfo :: OneShotInfo
noOneShotInfo = OneShotInfo
NoOneShotInfo

isOneShotInfo, hasNoOneShotInfo :: OneShotInfo -> Bool
isOneShotInfo :: OneShotInfo -> Bool
isOneShotInfo OneShotInfo
OneShotLam = Bool
True
isOneShotInfo OneShotInfo
_          = Bool
False

hasNoOneShotInfo :: OneShotInfo -> Bool
hasNoOneShotInfo OneShotInfo
NoOneShotInfo = Bool
True
hasNoOneShotInfo OneShotInfo
_             = Bool
False

worstOneShot, bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
worstOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
worstOneShot OneShotInfo
NoOneShotInfo OneShotInfo
_             = OneShotInfo
NoOneShotInfo
worstOneShot OneShotInfo
OneShotLam    OneShotInfo
os            = OneShotInfo
os

bestOneShot :: OneShotInfo -> OneShotInfo -> OneShotInfo
bestOneShot OneShotInfo
NoOneShotInfo OneShotInfo
os         = OneShotInfo
os
bestOneShot OneShotInfo
OneShotLam    OneShotInfo
_          = OneShotInfo
OneShotLam

pprOneShotInfo :: OneShotInfo -> SDoc
pprOneShotInfo :: OneShotInfo -> SDoc
pprOneShotInfo OneShotInfo
NoOneShotInfo = SDoc
empty
pprOneShotInfo OneShotInfo
OneShotLam    = String -> SDoc
text String
"OneShot"

instance Outputable OneShotInfo where
    ppr :: OneShotInfo -> SDoc
ppr = OneShotInfo -> SDoc
pprOneShotInfo

{-
************************************************************************
*                                                                      *
           Swap flag
*                                                                      *
************************************************************************
-}

data SwapFlag
  = NotSwapped  -- Args are: actual,   expected
  | IsSwapped   -- Args are: expected, actual

instance Outputable SwapFlag where
  ppr :: SwapFlag -> SDoc
ppr SwapFlag
IsSwapped  = String -> SDoc
text String
"Is-swapped"
  ppr SwapFlag
NotSwapped = String -> SDoc
text String
"Not-swapped"

flipSwap :: SwapFlag -> SwapFlag
flipSwap :: SwapFlag -> SwapFlag
flipSwap SwapFlag
IsSwapped  = SwapFlag
NotSwapped
flipSwap SwapFlag
NotSwapped = SwapFlag
IsSwapped

isSwapped :: SwapFlag -> Bool
isSwapped :: SwapFlag -> Bool
isSwapped SwapFlag
IsSwapped  = Bool
True
isSwapped SwapFlag
NotSwapped = Bool
False

unSwap :: SwapFlag -> (a->a->b) -> a -> a -> b
unSwap :: forall a b. SwapFlag -> (a -> a -> b) -> a -> a -> b
unSwap SwapFlag
NotSwapped a -> a -> b
f a
a a
b = a -> a -> b
f a
a a
b
unSwap SwapFlag
IsSwapped  a -> a -> b
f a
a a
b = a -> a -> b
f a
b a
a


{- *********************************************************************
*                                                                      *
           Promotion flag
*                                                                      *
********************************************************************* -}

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

isPromoted :: PromotionFlag -> Bool
isPromoted :: PromotionFlag -> Bool
isPromoted PromotionFlag
IsPromoted  = Bool
True
isPromoted PromotionFlag
NotPromoted = Bool
False

instance Outputable PromotionFlag where
  ppr :: PromotionFlag -> SDoc
ppr PromotionFlag
NotPromoted = String -> SDoc
text String
"NotPromoted"
  ppr PromotionFlag
IsPromoted  = String -> SDoc
text String
"IsPromoted"

instance Binary PromotionFlag where
   put_ :: BinHandle -> PromotionFlag -> IO ()
put_ BinHandle
bh PromotionFlag
NotPromoted = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
   put_ BinHandle
bh PromotionFlag
IsPromoted  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1

   get :: BinHandle -> IO PromotionFlag
get BinHandle
bh = do
       Word8
n <- BinHandle -> IO Word8
getByte BinHandle
bh
       case Word8
n of
         Word8
0 -> PromotionFlag -> IO PromotionFlag
forall (m :: * -> *) a. Monad m => a -> m a
return PromotionFlag
NotPromoted
         Word8
1 -> PromotionFlag -> IO PromotionFlag
forall (m :: * -> *) a. Monad m => a -> m a
return PromotionFlag
IsPromoted
         Word8
_ -> String -> IO PromotionFlag
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Binary(IsPromoted): fail)"

{-
************************************************************************
*                                                                      *
\subsection[FunctionOrData]{FunctionOrData}
*                                                                      *
************************************************************************
-}

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

instance Outputable FunctionOrData where
    ppr :: FunctionOrData -> SDoc
ppr FunctionOrData
IsFunction = String -> SDoc
text String
"(function)"
    ppr FunctionOrData
IsData     = String -> SDoc
text String
"(data)"

instance Binary FunctionOrData where
    put_ :: BinHandle -> FunctionOrData -> IO ()
put_ BinHandle
bh FunctionOrData
IsFunction = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh FunctionOrData
IsData     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    get :: BinHandle -> IO FunctionOrData
get BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
          Word8
0 -> FunctionOrData -> IO FunctionOrData
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionOrData
IsFunction
          Word8
1 -> FunctionOrData -> IO FunctionOrData
forall (m :: * -> *) a. Monad m => a -> m a
return FunctionOrData
IsData
          Word8
_ -> String -> IO FunctionOrData
forall a. String -> a
panic String
"Binary FunctionOrData"

{-
************************************************************************
*                                                                      *
                Rules
*                                                                      *
************************************************************************
-}

type RuleName = FastString

pprRuleName :: RuleName -> SDoc
pprRuleName :: RuleName -> SDoc
pprRuleName RuleName
rn = SDoc -> SDoc
doubleQuotes (RuleName -> SDoc
ftext RuleName
rn)


{-
************************************************************************
*                                                                      *
\subsection[Top-level/local]{Top-level/not-top level flag}
*                                                                      *
************************************************************************
-}

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

isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool

isNotTopLevel :: TopLevelFlag -> Bool
isNotTopLevel TopLevelFlag
NotTopLevel = Bool
True
isNotTopLevel TopLevelFlag
TopLevel    = Bool
False

isTopLevel :: TopLevelFlag -> Bool
isTopLevel TopLevelFlag
TopLevel     = Bool
True
isTopLevel TopLevelFlag
NotTopLevel  = Bool
False

instance Outputable TopLevelFlag where
  ppr :: TopLevelFlag -> SDoc
ppr TopLevelFlag
TopLevel    = String -> SDoc
text String
"<TopLevel>"
  ppr TopLevelFlag
NotTopLevel = String -> SDoc
text String
"<NotTopLevel>"

{-
************************************************************************
*                                                                      *
                Boxity flag
*                                                                      *
************************************************************************
-}

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

isBoxed :: Boxity -> Bool
isBoxed :: Boxity -> Bool
isBoxed Boxity
Boxed   = Bool
True
isBoxed Boxity
Unboxed = Bool
False

instance Outputable Boxity where
  ppr :: Boxity -> SDoc
ppr Boxity
Boxed   = String -> SDoc
text String
"Boxed"
  ppr Boxity
Unboxed = String -> SDoc
text String
"Unboxed"

{-
************************************************************************
*                                                                      *
                Recursive/Non-Recursive flag
*                                                                      *
************************************************************************
-}

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

isRec :: RecFlag -> Bool
isRec :: RecFlag -> Bool
isRec RecFlag
Recursive    = Bool
True
isRec RecFlag
NonRecursive = Bool
False

isNonRec :: RecFlag -> Bool
isNonRec :: RecFlag -> Bool
isNonRec RecFlag
Recursive    = Bool
False
isNonRec RecFlag
NonRecursive = Bool
True

boolToRecFlag :: Bool -> RecFlag
boolToRecFlag :: Bool -> RecFlag
boolToRecFlag Bool
True  = RecFlag
Recursive
boolToRecFlag Bool
False = RecFlag
NonRecursive

instance Outputable RecFlag where
  ppr :: RecFlag -> SDoc
ppr RecFlag
Recursive    = String -> SDoc
text String
"Recursive"
  ppr RecFlag
NonRecursive = String -> SDoc
text String
"NonRecursive"

instance Binary RecFlag where
    put_ :: BinHandle -> RecFlag -> IO ()
put_ BinHandle
bh RecFlag
Recursive =
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh RecFlag
NonRecursive =
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    get :: BinHandle -> IO RecFlag
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> RecFlag -> IO RecFlag
forall (m :: * -> *) a. Monad m => a -> m a
return RecFlag
Recursive
              Word8
_ -> RecFlag -> IO RecFlag
forall (m :: * -> *) a. Monad m => a -> m a
return RecFlag
NonRecursive

{-
************************************************************************
*                                                                      *
                Code origin
*                                                                      *
************************************************************************
-}

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

isGenerated :: Origin -> Bool
isGenerated :: Origin -> Bool
isGenerated Origin
Generated = Bool
True
isGenerated Origin
FromSource = Bool
False

instance Outputable Origin where
  ppr :: Origin -> SDoc
ppr Origin
FromSource  = String -> SDoc
text String
"FromSource"
  ppr Origin
Generated   = String -> SDoc
text String
"Generated"

{-
************************************************************************
*                                                                      *
                Instance overlap flag
*                                                                      *
************************************************************************
-}

-- | The semantics allowed for overlapping instances for a particular
-- instance. See Note [Safe Haskell isSafeOverlap] (in "GHC.Core.InstEnv") for a
-- explanation of the `isSafeOverlap` field.
--
-- - 'GHC.Parser.Annotation.AnnKeywordId' :
--      'GHC.Parser.Annotation.AnnOpen' @'\{-\# OVERLAPPABLE'@ or
--                              @'\{-\# OVERLAPPING'@ or
--                              @'\{-\# OVERLAPS'@ or
--                              @'\{-\# INCOHERENT'@,
--      'GHC.Parser.Annotation.AnnClose' @`\#-\}`@,

-- For details on above see note [exact print annotations] in "GHC.Parser.Annotation"
data OverlapFlag = OverlapFlag
  { OverlapFlag -> OverlapMode
overlapMode   :: OverlapMode
  , OverlapFlag -> Bool
isSafeOverlap :: Bool
  } deriving (OverlapFlag -> OverlapFlag -> Bool
(OverlapFlag -> OverlapFlag -> Bool)
-> (OverlapFlag -> OverlapFlag -> Bool) -> Eq OverlapFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverlapFlag -> OverlapFlag -> Bool
$c/= :: OverlapFlag -> OverlapFlag -> Bool
== :: OverlapFlag -> OverlapFlag -> Bool
$c== :: OverlapFlag -> OverlapFlag -> Bool
Eq, Typeable OverlapFlag
Typeable OverlapFlag
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OverlapFlag -> c OverlapFlag)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OverlapFlag)
-> (OverlapFlag -> Constr)
-> (OverlapFlag -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OverlapFlag))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OverlapFlag))
-> ((forall b. Data b => b -> b) -> OverlapFlag -> OverlapFlag)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r)
-> (forall u. (forall d. Data d => d -> u) -> OverlapFlag -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OverlapFlag -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag)
-> Data OverlapFlag
OverlapFlag -> DataType
OverlapFlag -> Constr
(forall b. Data b => b -> b) -> OverlapFlag -> OverlapFlag
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) -> OverlapFlag -> u
forall u. (forall d. Data d => d -> u) -> OverlapFlag -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverlapFlag
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverlapFlag -> c OverlapFlag
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverlapFlag)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OverlapFlag)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverlapFlag -> m OverlapFlag
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OverlapFlag -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OverlapFlag -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OverlapFlag -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OverlapFlag -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapFlag -> r
gmapT :: (forall b. Data b => b -> b) -> OverlapFlag -> OverlapFlag
$cgmapT :: (forall b. Data b => b -> b) -> OverlapFlag -> OverlapFlag
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OverlapFlag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OverlapFlag)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverlapFlag)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverlapFlag)
dataTypeOf :: OverlapFlag -> DataType
$cdataTypeOf :: OverlapFlag -> DataType
toConstr :: OverlapFlag -> Constr
$ctoConstr :: OverlapFlag -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverlapFlag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverlapFlag
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverlapFlag -> c OverlapFlag
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverlapFlag -> c OverlapFlag
Data)

setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
setOverlapModeMaybe :: OverlapFlag -> Maybe OverlapMode -> OverlapFlag
setOverlapModeMaybe OverlapFlag
f Maybe OverlapMode
Nothing  = OverlapFlag
f
setOverlapModeMaybe OverlapFlag
f (Just OverlapMode
m) = OverlapFlag
f { overlapMode :: OverlapMode
overlapMode = OverlapMode
m }

hasIncoherentFlag :: OverlapMode -> Bool
hasIncoherentFlag :: OverlapMode -> Bool
hasIncoherentFlag OverlapMode
mode =
  case OverlapMode
mode of
    Incoherent   SourceText
_ -> Bool
True
    OverlapMode
_              -> Bool
False

hasOverlappableFlag :: OverlapMode -> Bool
hasOverlappableFlag :: OverlapMode -> Bool
hasOverlappableFlag OverlapMode
mode =
  case OverlapMode
mode of
    Overlappable SourceText
_ -> Bool
True
    Overlaps     SourceText
_ -> Bool
True
    Incoherent   SourceText
_ -> Bool
True
    OverlapMode
_              -> Bool
False

hasOverlappingFlag :: OverlapMode -> Bool
hasOverlappingFlag :: OverlapMode -> Bool
hasOverlappingFlag OverlapMode
mode =
  case OverlapMode
mode of
    Overlapping  SourceText
_ -> Bool
True
    Overlaps     SourceText
_ -> Bool
True
    Incoherent   SourceText
_ -> Bool
True
    OverlapMode
_              -> Bool
False

data OverlapMode  -- See Note [Rules for instance lookup] in GHC.Core.InstEnv
  = NoOverlap SourceText
                  -- See Note [Pragma source text]
    -- ^ This instance must not overlap another `NoOverlap` instance.
    -- However, it may be overlapped by `Overlapping` instances,
    -- and it may overlap `Overlappable` instances.


  | Overlappable SourceText
                  -- See Note [Pragma source text]
    -- ^ Silently ignore this instance if you find a
    -- more specific one that matches the constraint
    -- you are trying to resolve
    --
    -- Example: constraint (Foo [Int])
    --   instance                      Foo [Int]
    --   instance {-# OVERLAPPABLE #-} Foo [a]
    --
    -- Since the second instance has the Overlappable flag,
    -- the first instance will be chosen (otherwise
    -- its ambiguous which to choose)


  | Overlapping SourceText
                  -- See Note [Pragma source text]
    -- ^ Silently ignore any more general instances that may be
    --   used to solve the constraint.
    --
    -- Example: constraint (Foo [Int])
    --   instance {-# OVERLAPPING #-} Foo [Int]
    --   instance                     Foo [a]
    --
    -- Since the first instance has the Overlapping flag,
    -- the second---more general---instance will be ignored (otherwise
    -- it is ambiguous which to choose)


  | Overlaps SourceText
                  -- See Note [Pragma source text]
    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.

  | Incoherent SourceText
                  -- See Note [Pragma source text]
    -- ^ Behave like Overlappable and Overlapping, and in addition pick
    -- an arbitrary one if there are multiple matching candidates, and
    -- don't worry about later instantiation
    --
    -- Example: constraint (Foo [b])
    -- instance {-# INCOHERENT -} Foo [Int]
    -- instance                   Foo [a]
    -- Without the Incoherent flag, we'd complain that
    -- instantiating 'b' would change which instance
    -- was chosen. See also note [Incoherent instances] in "GHC.Core.InstEnv"

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


instance Outputable OverlapFlag where
   ppr :: OverlapFlag -> SDoc
ppr OverlapFlag
flag = OverlapMode -> SDoc
forall a. Outputable a => a -> SDoc
ppr (OverlapFlag -> OverlapMode
overlapMode OverlapFlag
flag) SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
pprSafeOverlap (OverlapFlag -> Bool
isSafeOverlap OverlapFlag
flag)

instance Outputable OverlapMode where
   ppr :: OverlapMode -> SDoc
ppr (NoOverlap    SourceText
_) = SDoc
empty
   ppr (Overlappable SourceText
_) = String -> SDoc
text String
"[overlappable]"
   ppr (Overlapping  SourceText
_) = String -> SDoc
text String
"[overlapping]"
   ppr (Overlaps     SourceText
_) = String -> SDoc
text String
"[overlap ok]"
   ppr (Incoherent   SourceText
_) = String -> SDoc
text String
"[incoherent]"

instance Binary OverlapMode where
    put_ :: BinHandle -> OverlapMode -> IO ()
put_ BinHandle
bh (NoOverlap    SourceText
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
s
    put_ BinHandle
bh (Overlaps     SourceText
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
s
    put_ BinHandle
bh (Incoherent   SourceText
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
s
    put_ BinHandle
bh (Overlapping  SourceText
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
s
    put_ BinHandle
bh (Overlappable SourceText
s) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
s
    get :: BinHandle -> IO OverlapMode
get BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            Word8
0 -> (BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall (m :: * -> *) a. Monad m => a -> m a
return (OverlapMode -> IO OverlapMode) -> OverlapMode -> IO OverlapMode
forall a b. (a -> b) -> a -> b
$ SourceText -> OverlapMode
NoOverlap SourceText
s
            Word8
1 -> (BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall (m :: * -> *) a. Monad m => a -> m a
return (OverlapMode -> IO OverlapMode) -> OverlapMode -> IO OverlapMode
forall a b. (a -> b) -> a -> b
$ SourceText -> OverlapMode
Overlaps SourceText
s
            Word8
2 -> (BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall (m :: * -> *) a. Monad m => a -> m a
return (OverlapMode -> IO OverlapMode) -> OverlapMode -> IO OverlapMode
forall a b. (a -> b) -> a -> b
$ SourceText -> OverlapMode
Incoherent SourceText
s
            Word8
3 -> (BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall (m :: * -> *) a. Monad m => a -> m a
return (OverlapMode -> IO OverlapMode) -> OverlapMode -> IO OverlapMode
forall a b. (a -> b) -> a -> b
$ SourceText -> OverlapMode
Overlapping SourceText
s
            Word8
4 -> (BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall (m :: * -> *) a. Monad m => a -> m a
return (OverlapMode -> IO OverlapMode) -> OverlapMode -> IO OverlapMode
forall a b. (a -> b) -> a -> b
$ SourceText -> OverlapMode
Overlappable SourceText
s
            Word8
_ -> String -> IO OverlapMode
forall a. String -> a
panic (String
"get OverlapMode" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
h)


instance Binary OverlapFlag where
    put_ :: BinHandle -> OverlapFlag -> IO ()
put_ BinHandle
bh OverlapFlag
flag = do BinHandle -> OverlapMode -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (OverlapFlag -> OverlapMode
overlapMode OverlapFlag
flag)
                      BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (OverlapFlag -> Bool
isSafeOverlap OverlapFlag
flag)
    get :: BinHandle -> IO OverlapFlag
get BinHandle
bh = do
        OverlapMode
h <- BinHandle -> IO OverlapMode
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Bool
b <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        OverlapFlag -> IO OverlapFlag
forall (m :: * -> *) a. Monad m => a -> m a
return OverlapFlag { overlapMode :: OverlapMode
overlapMode = OverlapMode
h, isSafeOverlap :: Bool
isSafeOverlap = Bool
b }

pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap Bool
True  = String -> SDoc
text String
"[safe]"
pprSafeOverlap Bool
False = SDoc
empty

{-
************************************************************************
*                                                                      *
                Precedence
*                                                                      *
************************************************************************
-}

-- | A general-purpose pretty-printing precedence type.
newtype PprPrec = PprPrec Int deriving (PprPrec -> PprPrec -> Bool
(PprPrec -> PprPrec -> Bool)
-> (PprPrec -> PprPrec -> Bool) -> Eq PprPrec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PprPrec -> PprPrec -> Bool
$c/= :: PprPrec -> PprPrec -> Bool
== :: PprPrec -> PprPrec -> Bool
$c== :: PprPrec -> PprPrec -> Bool
Eq, Eq PprPrec
Eq PprPrec
-> (PprPrec -> PprPrec -> Ordering)
-> (PprPrec -> PprPrec -> Bool)
-> (PprPrec -> PprPrec -> Bool)
-> (PprPrec -> PprPrec -> Bool)
-> (PprPrec -> PprPrec -> Bool)
-> (PprPrec -> PprPrec -> PprPrec)
-> (PprPrec -> PprPrec -> PprPrec)
-> Ord PprPrec
PprPrec -> PprPrec -> Bool
PprPrec -> PprPrec -> Ordering
PprPrec -> PprPrec -> PprPrec
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
min :: PprPrec -> PprPrec -> PprPrec
$cmin :: PprPrec -> PprPrec -> PprPrec
max :: PprPrec -> PprPrec -> PprPrec
$cmax :: PprPrec -> PprPrec -> PprPrec
>= :: PprPrec -> PprPrec -> Bool
$c>= :: PprPrec -> PprPrec -> Bool
> :: PprPrec -> PprPrec -> Bool
$c> :: PprPrec -> PprPrec -> Bool
<= :: PprPrec -> PprPrec -> Bool
$c<= :: PprPrec -> PprPrec -> Bool
< :: PprPrec -> PprPrec -> Bool
$c< :: PprPrec -> PprPrec -> Bool
compare :: PprPrec -> PprPrec -> Ordering
$ccompare :: PprPrec -> PprPrec -> Ordering
Ord, Int -> PprPrec -> String -> String
[PprPrec] -> String -> String
PprPrec -> String
(Int -> PprPrec -> String -> String)
-> (PprPrec -> String)
-> ([PprPrec] -> String -> String)
-> Show PprPrec
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PprPrec] -> String -> String
$cshowList :: [PprPrec] -> String -> String
show :: PprPrec -> String
$cshow :: PprPrec -> String
showsPrec :: Int -> PprPrec -> String -> String
$cshowsPrec :: Int -> PprPrec -> String -> String
Show)
-- See Note [Precedence in types]

topPrec, sigPrec, funPrec, opPrec, starPrec, appPrec :: PprPrec
topPrec :: PprPrec
topPrec = Int -> PprPrec
PprPrec Int
0 -- No parens
sigPrec :: PprPrec
sigPrec = Int -> PprPrec
PprPrec Int
1 -- Explicit type signatures
funPrec :: PprPrec
funPrec = Int -> PprPrec
PprPrec Int
2 -- Function args; no parens for constructor apps
                    -- See [Type operator precedence] for why both
                    -- funPrec and opPrec exist.
opPrec :: PprPrec
opPrec  = Int -> PprPrec
PprPrec Int
2 -- Infix operator
starPrec :: PprPrec
starPrec = Int -> PprPrec
PprPrec Int
3 -- Star syntax for the type of types, i.e. the * in (* -> *)
                     -- See Note [Star kind precedence]
appPrec :: PprPrec
appPrec  = Int -> PprPrec
PprPrec Int
4 -- Constructor args; no parens for atomic

maybeParen :: PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen :: PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
inner_prec SDoc
pretty
  | PprPrec
ctxt_prec PprPrec -> PprPrec -> Bool
forall a. Ord a => a -> a -> Bool
< PprPrec
inner_prec = SDoc
pretty
  | Bool
otherwise              = SDoc -> SDoc
parens SDoc
pretty

{- Note [Precedence in types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Many pretty-printing functions have type
    ppr_ty :: PprPrec -> Type -> SDoc

The PprPrec gives the binding strength of the context.  For example, in
   T ty1 ty2
we will pretty-print 'ty1' and 'ty2' with the call
  (ppr_ty appPrec ty)
to indicate that the context is that of an argument of a TyConApp.

We use this consistently for Type and HsType.

Note [Type operator precedence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We don't keep the fixity of type operators in the operator. So the
pretty printer follows the following precedence order:

   TyConPrec         Type constructor application
   TyOpPrec/FunPrec  Operator application and function arrow

We have funPrec and opPrec to represent the precedence of function
arrow and type operators respectively, but currently we implement
funPrec == opPrec, so that we don't distinguish the two. Reason:
it's hard to parse a type like
    a ~ b => c * d -> e - f

By treating opPrec = funPrec we end up with more parens
    (a ~ b) => (c * d) -> (e - f)

But the two are different constructors of PprPrec so we could make
(->) bind more or less tightly if we wanted.

Note [Star kind precedence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
We parenthesize the (*) kind to avoid two issues:

1. Printing invalid or incorrect code.
   For example, instead of  type F @(*) x = x
         GHC used to print  type F @*   x = x
   However, (@*) is a type operator, not a kind application.

2. Printing kinds that are correct but hard to read.
   Should  Either * Int  be read as  Either (*) Int
                              or as  (*) Either Int  ?
   This depends on whether -XStarIsType is enabled, but it would be
   easier if we didn't have to check for the flag when reading the code.

At the same time, we cannot parenthesize (*) blindly.
Consider this Haskell98 kind:          ((* -> *) -> *) -> *
With parentheses, it is less readable: (((*) -> (*)) -> (*)) -> (*)

The solution is to assign a special precedence to (*), 'starPrec', which is
higher than 'funPrec' but lower than 'appPrec':

   F * * *   becomes  F (*) (*) (*)
   F A * B   becomes  F A (*) B
   Proxy *   becomes  Proxy (*)
   a * -> *  becomes  a (*) -> *
-}

{-
************************************************************************
*                                                                      *
                Tuples
*                                                                      *
************************************************************************
-}

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

instance Outputable TupleSort where
  ppr :: TupleSort -> SDoc
ppr TupleSort
ts = String -> SDoc
text (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$
    case TupleSort
ts of
      TupleSort
BoxedTuple      -> String
"BoxedTuple"
      TupleSort
UnboxedTuple    -> String
"UnboxedTuple"
      TupleSort
ConstraintTuple -> String
"ConstraintTuple"

instance Binary TupleSort where
    put_ :: BinHandle -> TupleSort -> IO ()
put_ BinHandle
bh TupleSort
BoxedTuple      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh TupleSort
UnboxedTuple    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh TupleSort
ConstraintTuple = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    get :: BinHandle -> IO TupleSort
get BinHandle
bh = do
      Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
      case Word8
h of
        Word8
0 -> TupleSort -> IO TupleSort
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
BoxedTuple
        Word8
1 -> TupleSort -> IO TupleSort
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
UnboxedTuple
        Word8
_ -> TupleSort -> IO TupleSort
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
ConstraintTuple


tupleSortBoxity :: TupleSort -> Boxity
tupleSortBoxity :: TupleSort -> Boxity
tupleSortBoxity TupleSort
BoxedTuple      = Boxity
Boxed
tupleSortBoxity TupleSort
UnboxedTuple    = Boxity
Unboxed
tupleSortBoxity TupleSort
ConstraintTuple = Boxity
Boxed

boxityTupleSort :: Boxity -> TupleSort
boxityTupleSort :: Boxity -> TupleSort
boxityTupleSort Boxity
Boxed   = TupleSort
BoxedTuple
boxityTupleSort Boxity
Unboxed = TupleSort
UnboxedTuple

tupleParens :: TupleSort -> SDoc -> SDoc
tupleParens :: TupleSort -> SDoc -> SDoc
tupleParens TupleSort
BoxedTuple      SDoc
p = SDoc -> SDoc
parens SDoc
p
tupleParens TupleSort
UnboxedTuple    SDoc
p = String -> SDoc
text String
"(#" SDoc -> SDoc -> SDoc
<+> SDoc
p SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"#)")
tupleParens TupleSort
ConstraintTuple SDoc
p   -- In debug-style write (% Eq a, Ord b %)
  = SDoc -> SDoc -> SDoc
ifPprDebug (String -> SDoc
text String
"(%" SDoc -> SDoc -> SDoc
<+> SDoc
p SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"%)"))
               (SDoc -> SDoc
parens SDoc
p)

{-
************************************************************************
*                                                                      *
                Sums
*                                                                      *
************************************************************************
-}

sumParens :: SDoc -> SDoc
sumParens :: SDoc -> SDoc
sumParens SDoc
p = PtrString -> SDoc
ptext (String -> PtrString
sLit String
"(#") SDoc -> SDoc -> SDoc
<+> SDoc
p SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"#)")

-- | Pretty print an alternative in an unboxed sum e.g. "| a | |".
pprAlternative :: (a -> SDoc) -- ^ The pretty printing function to use
               -> a           -- ^ The things to be pretty printed
               -> ConTag      -- ^ Alternative (one-based)
               -> Arity       -- ^ Arity
               -> SDoc        -- ^ 'SDoc' where the alternative havs been pretty
                              -- printed and finally packed into a paragraph.
pprAlternative :: forall a. (a -> SDoc) -> a -> Int -> Int -> SDoc
pprAlternative a -> SDoc
pp a
x Int
alt Int
arity =
    [SDoc] -> SDoc
fsep (Int -> SDoc -> [SDoc]
forall a. Int -> a -> [a]
replicate (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) SDoc
vbar [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [a -> SDoc
pp a
x] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ Int -> SDoc -> [SDoc]
forall a. Int -> a -> [a]
replicate (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alt) SDoc
vbar)

{-
************************************************************************
*                                                                      *
\subsection[Generic]{Generic flag}
*                                                                      *
************************************************************************

This is the "Embedding-Projection pair" datatype, it contains
two pieces of code (normally either RenamedExpr's or Id's)
If we have a such a pair (EP from to), the idea is that 'from' and 'to'
represents functions of type

        from :: T -> Tring
        to   :: Tring -> T

And we should have

        to (from x) = x

T and Tring are arbitrary, but typically T is the 'main' type while
Tring is the 'representation' type.  (This just helps us remember
whether to use 'from' or 'to'.
-}

-- | Embedding Projection pair
data EP a = EP { forall a. EP a -> a
fromEP :: a,   -- :: T -> Tring
                 forall a. EP a -> a
toEP   :: a }  -- :: Tring -> T

{-
Embedding-projection pairs are used in several places:

First of all, each type constructor has an EP associated with it, the
code in EP converts (datatype T) from T to Tring and back again.

Secondly, when we are filling in Generic methods (in the typechecker,
tcMethodBinds), we are constructing bimaps by induction on the structure
of the type of the method signature.


************************************************************************
*                                                                      *
\subsection{Occurrence information}
*                                                                      *
************************************************************************

This data type is used exclusively by the simplifier, but it appears in a
SubstResult, which is currently defined in GHC.Types.Var.Env, which is pretty
near the base of the module hierarchy.  So it seemed simpler to put the defn of
OccInfo here, safely at the bottom
-}

-- | identifier Occurrence Information
data OccInfo
  = ManyOccs        { OccInfo -> TailCallInfo
occ_tail    :: !TailCallInfo }
                        -- ^ There are many occurrences, or unknown occurrences

  | IAmDead             -- ^ Marks unused variables.  Sometimes useful for
                        -- lambda and case-bound variables.

  | OneOcc          { OccInfo -> InsideLam
occ_in_lam  :: !InsideLam
                    , OccInfo -> Int
occ_n_br    :: {-# UNPACK #-} !BranchCount
                    , OccInfo -> InterestingCxt
occ_int_cxt :: !InterestingCxt
                    , occ_tail    :: !TailCallInfo }
                        -- ^ Occurs exactly once (per branch), not inside a rule

  -- | This identifier breaks a loop of mutually recursive functions. The field
  -- marks whether it is only a loop breaker due to a reference in a rule
  | IAmALoopBreaker { OccInfo -> Bool
occ_rules_only :: !RulesOnly
                    , occ_tail       :: !TailCallInfo }
                        -- Note [LoopBreaker OccInfo]
  deriving (OccInfo -> OccInfo -> Bool
(OccInfo -> OccInfo -> Bool)
-> (OccInfo -> OccInfo -> Bool) -> Eq OccInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OccInfo -> OccInfo -> Bool
$c/= :: OccInfo -> OccInfo -> Bool
== :: OccInfo -> OccInfo -> Bool
$c== :: OccInfo -> OccInfo -> Bool
Eq)

type RulesOnly = Bool

type BranchCount = Int
  -- For OneOcc, the BranchCount says how many syntactic occurrences there are
  -- At the moment we really only check for 1 or >1, but in principle
  --   we could pay attention to how *many* occurrences there are
  --   (notably in postInlineUnconditionally).
  -- But meanwhile, Ints are very efficiently represented.

oneBranch :: BranchCount
oneBranch :: Int
oneBranch = Int
1

{-
Note [LoopBreaker OccInfo]
~~~~~~~~~~~~~~~~~~~~~~~~~~
   IAmALoopBreaker True  <=> A "weak" or rules-only loop breaker
                             Do not preInlineUnconditionally

   IAmALoopBreaker False <=> A "strong" loop breaker
                             Do not inline at all

See OccurAnal Note [Weak loop breakers]
-}

noOccInfo :: OccInfo
noOccInfo :: OccInfo
noOccInfo = ManyOccs { occ_tail :: TailCallInfo
occ_tail = TailCallInfo
NoTailCallInfo }

isNoOccInfo :: OccInfo -> Bool
isNoOccInfo :: OccInfo -> Bool
isNoOccInfo ManyOccs { occ_tail :: OccInfo -> TailCallInfo
occ_tail = TailCallInfo
NoTailCallInfo } = Bool
True
isNoOccInfo OccInfo
_ = Bool
False

isManyOccs :: OccInfo -> Bool
isManyOccs :: OccInfo -> Bool
isManyOccs ManyOccs{} = Bool
True
isManyOccs OccInfo
_          = Bool
False

seqOccInfo :: OccInfo -> ()
seqOccInfo :: OccInfo -> ()
seqOccInfo OccInfo
occ = OccInfo
occ OccInfo -> () -> ()
`seq` ()

-----------------
-- | Interesting Context
data InterestingCxt
  = IsInteresting
    -- ^ Function: is applied
    --   Data value: scrutinised by a case with at least one non-DEFAULT branch
  | NotInteresting
  deriving (InterestingCxt -> InterestingCxt -> Bool
(InterestingCxt -> InterestingCxt -> Bool)
-> (InterestingCxt -> InterestingCxt -> Bool) -> Eq InterestingCxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InterestingCxt -> InterestingCxt -> Bool
$c/= :: InterestingCxt -> InterestingCxt -> Bool
== :: InterestingCxt -> InterestingCxt -> Bool
$c== :: InterestingCxt -> InterestingCxt -> Bool
Eq)

-- | If there is any 'interesting' identifier occurrence, then the
-- aggregated occurrence info of that identifier is considered interesting.
instance Semi.Semigroup InterestingCxt where
  InterestingCxt
NotInteresting <> :: InterestingCxt -> InterestingCxt -> InterestingCxt
<> InterestingCxt
x = InterestingCxt
x
  InterestingCxt
IsInteresting  <> InterestingCxt
_ = InterestingCxt
IsInteresting

instance Monoid InterestingCxt where
  mempty :: InterestingCxt
mempty = InterestingCxt
NotInteresting
  mappend :: InterestingCxt -> InterestingCxt -> InterestingCxt
mappend = InterestingCxt -> InterestingCxt -> InterestingCxt
forall a. Semigroup a => a -> a -> a
(Semi.<>)

-----------------
-- | Inside Lambda
data InsideLam
  = IsInsideLam
    -- ^ Occurs inside a non-linear lambda
    -- Substituting a redex for this occurrence is
    -- dangerous because it might duplicate work.
  | NotInsideLam
  deriving (InsideLam -> InsideLam -> Bool
(InsideLam -> InsideLam -> Bool)
-> (InsideLam -> InsideLam -> Bool) -> Eq InsideLam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsideLam -> InsideLam -> Bool
$c/= :: InsideLam -> InsideLam -> Bool
== :: InsideLam -> InsideLam -> Bool
$c== :: InsideLam -> InsideLam -> Bool
Eq)

-- | If any occurrence of an identifier is inside a lambda, then the
-- occurrence info of that identifier marks it as occurring inside a lambda
instance Semi.Semigroup InsideLam where
  InsideLam
NotInsideLam <> :: InsideLam -> InsideLam -> InsideLam
<> InsideLam
x = InsideLam
x
  InsideLam
IsInsideLam  <> InsideLam
_ = InsideLam
IsInsideLam

instance Monoid InsideLam where
  mempty :: InsideLam
mempty = InsideLam
NotInsideLam
  mappend :: InsideLam -> InsideLam -> InsideLam
mappend = InsideLam -> InsideLam -> InsideLam
forall a. Semigroup a => a -> a -> a
(Semi.<>)

-----------------
data TailCallInfo = AlwaysTailCalled JoinArity -- See Note [TailCallInfo]
                  | NoTailCallInfo
  deriving (TailCallInfo -> TailCallInfo -> Bool
(TailCallInfo -> TailCallInfo -> Bool)
-> (TailCallInfo -> TailCallInfo -> Bool) -> Eq TailCallInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TailCallInfo -> TailCallInfo -> Bool
$c/= :: TailCallInfo -> TailCallInfo -> Bool
== :: TailCallInfo -> TailCallInfo -> Bool
$c== :: TailCallInfo -> TailCallInfo -> Bool
Eq)

tailCallInfo :: OccInfo -> TailCallInfo
tailCallInfo :: OccInfo -> TailCallInfo
tailCallInfo OccInfo
IAmDead   = TailCallInfo
NoTailCallInfo
tailCallInfo OccInfo
other     = OccInfo -> TailCallInfo
occ_tail OccInfo
other

zapOccTailCallInfo :: OccInfo -> OccInfo
zapOccTailCallInfo :: OccInfo -> OccInfo
zapOccTailCallInfo OccInfo
IAmDead   = OccInfo
IAmDead
zapOccTailCallInfo OccInfo
occ       = OccInfo
occ { occ_tail :: TailCallInfo
occ_tail = TailCallInfo
NoTailCallInfo }

isAlwaysTailCalled :: OccInfo -> Bool
isAlwaysTailCalled :: OccInfo -> Bool
isAlwaysTailCalled OccInfo
occ
  = case OccInfo -> TailCallInfo
tailCallInfo OccInfo
occ of AlwaysTailCalled{} -> Bool
True
                             TailCallInfo
NoTailCallInfo     -> Bool
False

instance Outputable TailCallInfo where
  ppr :: TailCallInfo -> SDoc
ppr (AlwaysTailCalled Int
ar) = [SDoc] -> SDoc
sep [ String -> SDoc
text String
"Tail", Int -> SDoc
int Int
ar ]
  ppr TailCallInfo
_                     = SDoc
empty

-----------------
strongLoopBreaker, weakLoopBreaker :: OccInfo
strongLoopBreaker :: OccInfo
strongLoopBreaker = Bool -> TailCallInfo -> OccInfo
IAmALoopBreaker Bool
False TailCallInfo
NoTailCallInfo
weakLoopBreaker :: OccInfo
weakLoopBreaker   = Bool -> TailCallInfo -> OccInfo
IAmALoopBreaker Bool
True  TailCallInfo
NoTailCallInfo

isWeakLoopBreaker :: OccInfo -> Bool
isWeakLoopBreaker :: OccInfo -> Bool
isWeakLoopBreaker (IAmALoopBreaker{}) = Bool
True
isWeakLoopBreaker OccInfo
_                   = Bool
False

isStrongLoopBreaker :: OccInfo -> Bool
isStrongLoopBreaker :: OccInfo -> Bool
isStrongLoopBreaker (IAmALoopBreaker { occ_rules_only :: OccInfo -> Bool
occ_rules_only = Bool
False }) = Bool
True
  -- Loop-breaker that breaks a non-rule cycle
isStrongLoopBreaker OccInfo
_                                            = Bool
False

isDeadOcc :: OccInfo -> Bool
isDeadOcc :: OccInfo -> Bool
isDeadOcc OccInfo
IAmDead = Bool
True
isDeadOcc OccInfo
_       = Bool
False

isOneOcc :: OccInfo -> Bool
isOneOcc :: OccInfo -> Bool
isOneOcc (OneOcc {}) = Bool
True
isOneOcc OccInfo
_           = Bool
False

zapFragileOcc :: OccInfo -> OccInfo
-- Keep only the most robust data: deadness, loop-breaker-hood
zapFragileOcc :: OccInfo -> OccInfo
zapFragileOcc (OneOcc {}) = OccInfo
noOccInfo
zapFragileOcc OccInfo
occ         = OccInfo -> OccInfo
zapOccTailCallInfo OccInfo
occ

instance Outputable OccInfo where
  -- only used for debugging; never parsed.  KSW 1999-07
  ppr :: OccInfo -> SDoc
ppr (ManyOccs TailCallInfo
tails)     = TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tails
  ppr OccInfo
IAmDead              = String -> SDoc
text String
"Dead"
  ppr (IAmALoopBreaker Bool
rule_only TailCallInfo
tails)
        = String -> SDoc
text String
"LoopBreaker" SDoc -> SDoc -> SDoc
<> SDoc
pp_ro SDoc -> SDoc -> SDoc
<> TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tails
        where
          pp_ro :: SDoc
pp_ro | Bool
rule_only = Char -> SDoc
char Char
'!'
                | Bool
otherwise = SDoc
empty
  ppr (OneOcc InsideLam
inside_lam Int
one_branch InterestingCxt
int_cxt TailCallInfo
tail_info)
        = String -> SDoc
text String
"Once" SDoc -> SDoc -> SDoc
<> InsideLam -> SDoc
pp_lam InsideLam
inside_lam SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
one_branch SDoc -> SDoc -> SDoc
<> InterestingCxt -> SDoc
pp_args InterestingCxt
int_cxt SDoc -> SDoc -> SDoc
<> SDoc
pp_tail
        where
          pp_lam :: InsideLam -> SDoc
pp_lam InsideLam
IsInsideLam     = Char -> SDoc
char Char
'L'
          pp_lam InsideLam
NotInsideLam    = SDoc
empty
          pp_args :: InterestingCxt -> SDoc
pp_args InterestingCxt
IsInteresting  = Char -> SDoc
char Char
'!'
          pp_args InterestingCxt
NotInteresting = SDoc
empty
          pp_tail :: SDoc
pp_tail                = TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tail_info

pprShortTailCallInfo :: TailCallInfo -> SDoc
pprShortTailCallInfo :: TailCallInfo -> SDoc
pprShortTailCallInfo (AlwaysTailCalled Int
ar) = Char -> SDoc
char Char
'T' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (Int -> SDoc
int Int
ar)
pprShortTailCallInfo TailCallInfo
NoTailCallInfo        = SDoc
empty

{-
Note [TailCallInfo]
~~~~~~~~~~~~~~~~~~~
The occurrence analyser determines what can be made into a join point, but it
doesn't change the binder into a JoinId because then it would be inconsistent
with the occurrences. Thus it's left to the simplifier (or to simpleOptExpr) to
change the IdDetails.

The AlwaysTailCalled marker actually means slightly more than simply that the
function is always tail-called. See Note [Invariants on join points].

This info is quite fragile and should not be relied upon unless the occurrence
analyser has *just* run. Use 'Id.isJoinId_maybe' for the permanent state of
the join-point-hood of a binder; a join id itself will not be marked
AlwaysTailCalled.

Note that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that
being tail-called would mean that the variable could only appear once per branch
(thus getting a `OneOcc { }` occurrence info), but a join
point can also be invoked from other join points, not just from case branches:

  let j1 x = ...
      j2 y = ... j1 z {- tail call -} ...
  in case w of
       A -> j1 v
       B -> j2 u
       C -> j2 q

Here both 'j1' and 'j2' will get marked AlwaysTailCalled, but j1 will get
ManyOccs and j2 will get `OneOcc { occ_n_br = 2 }`.

************************************************************************
*                                                                      *
                Default method specification
*                                                                      *
************************************************************************

The DefMethSpec enumeration just indicates what sort of default method
is used for a class. It is generated from source code, and present in
interface files; it is converted to Class.DefMethInfo before begin put in a
Class object.
-}

-- | Default Method Specification
data DefMethSpec ty
  = VanillaDM     -- Default method given with polymorphic code
  | GenericDM ty  -- Default method given with code of this type

instance Outputable (DefMethSpec ty) where
  ppr :: DefMethSpec ty -> SDoc
ppr DefMethSpec ty
VanillaDM      = String -> SDoc
text String
"{- Has default method -}"
  ppr (GenericDM {}) = String -> SDoc
text String
"{- Has generic default method -}"

{-
************************************************************************
*                                                                      *
\subsection{Success flag}
*                                                                      *
************************************************************************
-}

data SuccessFlag = Succeeded | Failed

instance Outputable SuccessFlag where
    ppr :: SuccessFlag -> SDoc
ppr SuccessFlag
Succeeded = String -> SDoc
text String
"Succeeded"
    ppr SuccessFlag
Failed    = String -> SDoc
text String
"Failed"

successIf :: Bool -> SuccessFlag
successIf :: Bool -> SuccessFlag
successIf Bool
True  = SuccessFlag
Succeeded
successIf Bool
False = SuccessFlag
Failed

succeeded, failed :: SuccessFlag -> Bool
succeeded :: SuccessFlag -> Bool
succeeded SuccessFlag
Succeeded = Bool
True
succeeded SuccessFlag
Failed    = Bool
False

failed :: SuccessFlag -> Bool
failed SuccessFlag
Succeeded = Bool
False
failed SuccessFlag
Failed    = Bool
True

{-
************************************************************************
*                                                                      *
\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
-}

-- | Phase Number
type PhaseNum = Int  -- Compilation phase
                     -- Phases decrease towards zero
                     -- Zero is the last phase

data CompilerPhase
  = InitialPhase    -- The first phase -- number = infinity!
  | Phase PhaseNum  -- User-specificable 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
/= :: CompilerPhase -> CompilerPhase -> Bool
$c/= :: CompilerPhase -> CompilerPhase -> Bool
== :: CompilerPhase -> CompilerPhase -> Bool
$c== :: CompilerPhase -> CompilerPhase -> Bool
Eq

instance Outputable CompilerPhase where
   ppr :: CompilerPhase -> SDoc
ppr (Phase Int
n)    = Int -> SDoc
int Int
n
   ppr CompilerPhase
InitialPhase = String -> SDoc
text String
"InitialPhase"
   ppr CompilerPhase
FinalPhase   = String -> SDoc
text String
"FinalPhase"

-- See note [Pragma source text]
data Activation
  = AlwaysActive
  | ActiveBefore SourceText PhaseNum  -- Active only *strictly before* this phase
  | ActiveAfter  SourceText PhaseNum  -- Active in this phase and later
  | FinalActive                       -- Active in final phase only
  | NeverActive
  deriving( Activation -> Activation -> Bool
(Activation -> Activation -> Bool)
-> (Activation -> Activation -> Bool) -> Eq Activation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Activation -> Activation -> Bool
$c/= :: Activation -> Activation -> Bool
== :: Activation -> Activation -> Bool
$c== :: Activation -> Activation -> Bool
Eq, Typeable Activation
Typeable Activation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Activation -> c Activation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Activation)
-> (Activation -> Constr)
-> (Activation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Activation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Activation))
-> ((forall b. Data b => b -> b) -> Activation -> Activation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Activation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Activation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Activation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Activation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Activation -> m Activation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Activation -> m Activation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Activation -> m Activation)
-> Data Activation
Activation -> DataType
Activation -> Constr
(forall b. Data b => b -> b) -> Activation -> Activation
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) -> Activation -> u
forall u. (forall d. Data d => d -> u) -> Activation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Activation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Activation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Activation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Activation -> c Activation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Activation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Activation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Activation -> m Activation
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Activation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Activation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Activation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Activation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Activation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Activation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Activation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Activation -> r
gmapT :: (forall b. Data b => b -> b) -> Activation -> Activation
$cgmapT :: (forall b. Data b => b -> b) -> Activation -> Activation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Activation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Activation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Activation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Activation)
dataTypeOf :: Activation -> DataType
$cdataTypeOf :: Activation -> DataType
toConstr :: Activation -> Constr
$ctoConstr :: Activation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Activation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Activation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Activation -> c Activation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Activation -> c Activation
Data )
    -- Eq used in comparing rules in GHC.Hs.Decls

activateAfterInitial :: Activation
-- Active in the first phase after the initial phase
-- Currently we have just phases [2,1,0,FinalPhase,FinalPhase,...]
-- Where FinalPhase means GHC's internal simplification steps
-- after all rules have run
activateAfterInitial :: Activation
activateAfterInitial = SourceText -> Int -> Activation
ActiveAfter SourceText
NoSourceText Int
2

activateDuringFinal :: Activation
-- Active in the final simplification phase (which is repeated)
activateDuringFinal :: Activation
activateDuringFinal = Activation
FinalActive

isActive :: CompilerPhase -> Activation -> Bool
isActive :: CompilerPhase -> Activation -> Bool
isActive CompilerPhase
InitialPhase Activation
act = Activation -> Bool
activeInInitialPhase Activation
act
isActive (Phase Int
p)    Activation
act = Int -> Activation -> Bool
activeInPhase Int
p Activation
act
isActive CompilerPhase
FinalPhase   Activation
act = Activation -> Bool
activeInFinalPhase Activation
act

activeInInitialPhase :: Activation -> Bool
activeInInitialPhase :: Activation -> Bool
activeInInitialPhase Activation
AlwaysActive      = Bool
True
activeInInitialPhase (ActiveBefore {}) = Bool
True
activeInInitialPhase Activation
_                 = Bool
False

activeInPhase :: PhaseNum -> Activation -> Bool
activeInPhase :: Int -> Activation -> Bool
activeInPhase Int
_ Activation
AlwaysActive       = Bool
True
activeInPhase Int
_ Activation
NeverActive        = Bool
False
activeInPhase Int
_ Activation
FinalActive        = Bool
False
activeInPhase Int
p (ActiveAfter  SourceText
_ Int
n) = Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
activeInPhase Int
p (ActiveBefore SourceText
_ Int
n) = Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
n

activeInFinalPhase :: Activation -> Bool
activeInFinalPhase :: Activation -> Bool
activeInFinalPhase Activation
AlwaysActive     = Bool
True
activeInFinalPhase Activation
FinalActive      = Bool
True
activeInFinalPhase (ActiveAfter {}) = Bool
True
activeInFinalPhase Activation
_                = Bool
False

isNeverActive, isAlwaysActive :: Activation -> Bool
isNeverActive :: Activation -> Bool
isNeverActive Activation
NeverActive = Bool
True
isNeverActive Activation
_           = Bool
False

isAlwaysActive :: Activation -> Bool
isAlwaysActive Activation
AlwaysActive = Bool
True
isAlwaysActive Activation
_            = Bool
False

competesWith :: Activation -> Activation -> Bool
-- See Note [Activation competition]
competesWith :: Activation -> Activation -> Bool
competesWith Activation
AlwaysActive      Activation
_                = Bool
True

competesWith Activation
NeverActive       Activation
_                = Bool
False
competesWith Activation
_                 Activation
NeverActive      = Bool
False

competesWith Activation
FinalActive       Activation
FinalActive      = Bool
True
competesWith Activation
FinalActive       Activation
_                = Bool
False

competesWith (ActiveBefore {})  Activation
AlwaysActive      = Bool
True
competesWith (ActiveBefore {})  Activation
FinalActive       = Bool
False
competesWith (ActiveBefore {})  (ActiveBefore {}) = Bool
True
competesWith (ActiveBefore SourceText
_ Int
a) (ActiveAfter SourceText
_ Int
b) = Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
b

competesWith (ActiveAfter {})  Activation
AlwaysActive      = Bool
False
competesWith (ActiveAfter {})  Activation
FinalActive       = Bool
True
competesWith (ActiveAfter {})  (ActiveBefore {}) = Bool
False
competesWith (ActiveAfter SourceText
_ Int
a) (ActiveAfter SourceText
_ Int
b) = Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b

{- 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.
-}


{- *********************************************************************
*                                                                      *
                 InlinePragma, InlineSpec, RuleMatchInfo
*                                                                      *
********************************************************************* -}


data InlinePragma            -- Note [InlinePragma]
  = InlinePragma
      { InlinePragma -> SourceText
inl_src    :: SourceText -- Note [Pragma source text]
      , InlinePragma -> InlineSpec
inl_inline :: InlineSpec -- See Note [inl_inline and inl_act]

      , InlinePragma -> Maybe Int
inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
                                     --            explicit (non-type, non-dictionary) args
                                     --   That is, inl_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

      , InlinePragma -> Activation
inl_act    :: Activation     -- Says during which phases inlining is allowed
                                     -- See Note [inl_inline and inl_act]

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

-- | Rule Match Information
data RuleMatchInfo = ConLike                    -- See Note [CONLIKE pragma]
                   | FunLike
                   deriving( RuleMatchInfo -> RuleMatchInfo -> Bool
(RuleMatchInfo -> RuleMatchInfo -> Bool)
-> (RuleMatchInfo -> RuleMatchInfo -> Bool) -> Eq RuleMatchInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RuleMatchInfo -> RuleMatchInfo -> Bool
$c/= :: RuleMatchInfo -> RuleMatchInfo -> Bool
== :: RuleMatchInfo -> RuleMatchInfo -> Bool
$c== :: RuleMatchInfo -> RuleMatchInfo -> Bool
Eq, Typeable RuleMatchInfo
Typeable RuleMatchInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RuleMatchInfo -> c RuleMatchInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RuleMatchInfo)
-> (RuleMatchInfo -> Constr)
-> (RuleMatchInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RuleMatchInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c RuleMatchInfo))
-> ((forall b. Data b => b -> b) -> RuleMatchInfo -> RuleMatchInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> RuleMatchInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RuleMatchInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo)
-> Data RuleMatchInfo
RuleMatchInfo -> DataType
RuleMatchInfo -> Constr
(forall b. Data b => b -> b) -> RuleMatchInfo -> RuleMatchInfo
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) -> RuleMatchInfo -> u
forall u. (forall d. Data d => d -> u) -> RuleMatchInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleMatchInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleMatchInfo -> c RuleMatchInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RuleMatchInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RuleMatchInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RuleMatchInfo -> m RuleMatchInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RuleMatchInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RuleMatchInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RuleMatchInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RuleMatchInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RuleMatchInfo -> r
gmapT :: (forall b. Data b => b -> b) -> RuleMatchInfo -> RuleMatchInfo
$cgmapT :: (forall b. Data b => b -> b) -> RuleMatchInfo -> RuleMatchInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RuleMatchInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RuleMatchInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RuleMatchInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RuleMatchInfo)
dataTypeOf :: RuleMatchInfo -> DataType
$cdataTypeOf :: RuleMatchInfo -> DataType
toConstr :: RuleMatchInfo -> Constr
$ctoConstr :: RuleMatchInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleMatchInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RuleMatchInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleMatchInfo -> c RuleMatchInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RuleMatchInfo -> c RuleMatchInfo
Data, Int -> RuleMatchInfo -> String -> String
[RuleMatchInfo] -> String -> String
RuleMatchInfo -> String
(Int -> RuleMatchInfo -> String -> String)
-> (RuleMatchInfo -> String)
-> ([RuleMatchInfo] -> String -> String)
-> Show RuleMatchInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [RuleMatchInfo] -> String -> String
$cshowList :: [RuleMatchInfo] -> String -> String
show :: RuleMatchInfo -> String
$cshow :: RuleMatchInfo -> String
showsPrec :: Int -> RuleMatchInfo -> String -> String
$cshowsPrec :: Int -> RuleMatchInfo -> String -> String
Show )
        -- Show needed for GHC.Parser.Lexer

-- | Inline Specification
data InlineSpec   -- What the user's INLINE pragma looked like
  = Inline           -- User wrote INLINE
  | Inlinable        -- User wrote INLINABLE
  | NoInline         -- User wrote NOINLINE
  | NoUserInlinePrag -- User did not write any of INLINE/INLINABLE/NOINLINE
                     -- e.g. in `defaultInlinePragma` or when created by CSE
  deriving( InlineSpec -> InlineSpec -> Bool
(InlineSpec -> InlineSpec -> Bool)
-> (InlineSpec -> InlineSpec -> Bool) -> Eq InlineSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineSpec -> InlineSpec -> Bool
$c/= :: InlineSpec -> InlineSpec -> Bool
== :: InlineSpec -> InlineSpec -> Bool
$c== :: InlineSpec -> InlineSpec -> Bool
Eq, Typeable InlineSpec
Typeable InlineSpec
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> InlineSpec -> c InlineSpec)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c InlineSpec)
-> (InlineSpec -> Constr)
-> (InlineSpec -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c InlineSpec))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c InlineSpec))
-> ((forall b. Data b => b -> b) -> InlineSpec -> InlineSpec)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> InlineSpec -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> InlineSpec -> r)
-> (forall u. (forall d. Data d => d -> u) -> InlineSpec -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> InlineSpec -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec)
-> Data InlineSpec
InlineSpec -> DataType
InlineSpec -> Constr
(forall b. Data b => b -> b) -> InlineSpec -> InlineSpec
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) -> InlineSpec -> u
forall u. (forall d. Data d => d -> u) -> InlineSpec -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSpec -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSpec -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InlineSpec
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InlineSpec -> c InlineSpec
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InlineSpec)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InlineSpec)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> InlineSpec -> m InlineSpec
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InlineSpec -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> InlineSpec -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InlineSpec -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InlineSpec -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSpec -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSpec -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSpec -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InlineSpec -> r
gmapT :: (forall b. Data b => b -> b) -> InlineSpec -> InlineSpec
$cgmapT :: (forall b. Data b => b -> b) -> InlineSpec -> InlineSpec
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InlineSpec)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c InlineSpec)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InlineSpec)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InlineSpec)
dataTypeOf :: InlineSpec -> DataType
$cdataTypeOf :: InlineSpec -> DataType
toConstr :: InlineSpec -> Constr
$ctoConstr :: InlineSpec -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InlineSpec
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InlineSpec
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InlineSpec -> c InlineSpec
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InlineSpec -> c InlineSpec
Data, Int -> InlineSpec -> String -> String
[InlineSpec] -> String -> String
InlineSpec -> String
(Int -> InlineSpec -> String -> String)
-> (InlineSpec -> String)
-> ([InlineSpec] -> String -> String)
-> Show InlineSpec
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InlineSpec] -> String -> String
$cshowList :: [InlineSpec] -> String -> String
show :: InlineSpec -> String
$cshow :: InlineSpec -> String
showsPrec :: Int -> InlineSpec -> String -> String
$cshowsPrec :: Int -> InlineSpec -> String -> String
Show )
        -- Show needed for GHC.Parser.Lexer

{- Note [InlinePragma]
~~~~~~~~~~~~~~~~~~~~~~
This data type mirrors what you can write in an INLINE or NOINLINE pragma in
the source program.

If you write nothing at all, you get defaultInlinePragma:
   inl_inline = NoUserInlinePrag
   inl_act    = AlwaysActive
   inl_rule   = FunLike

It's not possible to get that combination by *writing* something, so
if an Id has defaultInlinePragma it means the user didn't specify anything.

If inl_inline = Inline or Inlineable, then the Id should have an InlineRule unfolding.

If you want to know where InlinePragmas take effect: Look in GHC.HsToCore.Binds.makeCorePair

Note [inl_inline and inl_act]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* inl_inline says what the user wrote: did they say INLINE, NOINLINE,
  INLINABLE, or nothing at all

* inl_act says in what phases the unfolding is active or inactive
  E.g  If you write INLINE[1]    then inl_act will be set to ActiveAfter 1
       If you write NOINLINE[1]  then inl_act will be set to ActiveBefore 1
       If you write NOINLINE[~1] then inl_act will be set to ActiveAfter 1
  So note that inl_act does not say what pragma you wrote: it just
  expresses its consequences

* inl_act just says when the unfolding is active; it doesn't say what
  to inline.  If you say INLINE f, then f's inl_act will be AlwaysActive,
  but in addition f will get a "stable unfolding" with UnfoldingGuidance
  that tells the inliner to be pretty eager about it.

Note [CONLIKE pragma]
~~~~~~~~~~~~~~~~~~~~~
The ConLike constructor of a RuleMatchInfo is aimed at the following.
Consider first
    {-# RULE "r/cons" forall a as. r (a:as) = f (a+1) #-}
    g b bs = let x = b:bs in ..x...x...(r x)...
Now, the rule applies to the (r x) term, because GHC "looks through"
the definition of 'x' to see that it is (b:bs).

Now consider
    {-# RULE "r/f" forall v. r (f v) = f (v+1) #-}
    g v = let x = f v in ..x...x...(r x)...
Normally the (r x) would *not* match the rule, because GHC would be
scared about duplicating the redex (f v), so it does not "look
through" the bindings.

However the CONLIKE modifier says to treat 'f' like a constructor in
this situation, and "look through" the unfolding for x.  So (r x)
fires, yielding (f (v+1)).

This is all controlled with a user-visible pragma:
     {-# NOINLINE CONLIKE [1] f #-}

The main effects of CONLIKE are:

    - The occurrence analyser (OccAnal) and simplifier (Simplify) treat
      CONLIKE thing like constructors, by ANF-ing them

    - New function GHC.Core.Utils.exprIsExpandable is like exprIsCheap, but
      additionally spots applications of CONLIKE functions

    - A CoreUnfolding has a field that caches exprIsExpandable

    - The rule matcher consults this field.  See
      Note [Expanding variables] in GHC.Core.Rules.
-}

isConLike :: RuleMatchInfo -> Bool
isConLike :: RuleMatchInfo -> Bool
isConLike RuleMatchInfo
ConLike = Bool
True
isConLike RuleMatchInfo
_       = Bool
False

isFunLike :: RuleMatchInfo -> Bool
isFunLike :: RuleMatchInfo -> Bool
isFunLike RuleMatchInfo
FunLike = Bool
True
isFunLike RuleMatchInfo
_       = Bool
False

noUserInlineSpec :: InlineSpec -> Bool
noUserInlineSpec :: InlineSpec -> Bool
noUserInlineSpec InlineSpec
NoUserInlinePrag = Bool
True
noUserInlineSpec InlineSpec
_                = Bool
False

defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma
  :: InlinePragma
defaultInlinePragma :: InlinePragma
defaultInlinePragma = InlinePragma { inl_src :: SourceText
inl_src = String -> SourceText
SourceText String
"{-# INLINE"
                                   , inl_act :: Activation
inl_act = Activation
AlwaysActive
                                   , inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
FunLike
                                   , inl_inline :: InlineSpec
inl_inline = InlineSpec
NoUserInlinePrag
                                   , inl_sat :: Maybe Int
inl_sat = Maybe Int
forall a. Maybe a
Nothing }

alwaysInlinePragma :: InlinePragma
alwaysInlinePragma = InlinePragma
defaultInlinePragma { inl_inline :: InlineSpec
inl_inline = InlineSpec
Inline }
neverInlinePragma :: InlinePragma
neverInlinePragma  = InlinePragma
defaultInlinePragma { inl_act :: Activation
inl_act    = Activation
NeverActive }

inlinePragmaSpec :: InlinePragma -> InlineSpec
inlinePragmaSpec :: InlinePragma -> InlineSpec
inlinePragmaSpec = InlinePragma -> InlineSpec
inl_inline

-- 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 :: InlinePragma
dfunInlinePragma   = InlinePragma
defaultInlinePragma { inl_act :: Activation
inl_act  = Activation
AlwaysActive
                                         , inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
ConLike }

isDefaultInlinePragma :: InlinePragma -> Bool
isDefaultInlinePragma :: InlinePragma -> Bool
isDefaultInlinePragma (InlinePragma { inl_act :: InlinePragma -> Activation
inl_act = Activation
activation
                                    , inl_rule :: InlinePragma -> RuleMatchInfo
inl_rule = RuleMatchInfo
match_info
                                    , inl_inline :: InlinePragma -> InlineSpec
inl_inline = InlineSpec
inline })
  = InlineSpec -> Bool
noUserInlineSpec InlineSpec
inline Bool -> Bool -> Bool
&& Activation -> Bool
isAlwaysActive Activation
activation Bool -> Bool -> Bool
&& RuleMatchInfo -> Bool
isFunLike RuleMatchInfo
match_info

isInlinePragma :: InlinePragma -> Bool
isInlinePragma :: InlinePragma -> Bool
isInlinePragma InlinePragma
prag = case InlinePragma -> InlineSpec
inl_inline InlinePragma
prag of
                        InlineSpec
Inline -> Bool
True
                        InlineSpec
_      -> Bool
False

isInlinablePragma :: InlinePragma -> Bool
isInlinablePragma :: InlinePragma -> Bool
isInlinablePragma InlinePragma
prag = case InlinePragma -> InlineSpec
inl_inline InlinePragma
prag of
                           InlineSpec
Inlinable -> Bool
True
                           InlineSpec
_         -> Bool
False

isAnyInlinePragma :: InlinePragma -> Bool
-- INLINE or INLINABLE
isAnyInlinePragma :: InlinePragma -> Bool
isAnyInlinePragma InlinePragma
prag = case InlinePragma -> InlineSpec
inl_inline InlinePragma
prag of
                        InlineSpec
Inline    -> Bool
True
                        InlineSpec
Inlinable -> Bool
True
                        InlineSpec
_         -> Bool
False

inlinePragmaSat :: InlinePragma -> Maybe Arity
inlinePragmaSat :: InlinePragma -> Maybe Int
inlinePragmaSat = InlinePragma -> Maybe Int
inl_sat

inlinePragmaActivation :: InlinePragma -> Activation
inlinePragmaActivation :: InlinePragma -> Activation
inlinePragmaActivation (InlinePragma { inl_act :: InlinePragma -> Activation
inl_act = Activation
activation }) = Activation
activation

inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
inlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo
inlinePragmaRuleMatchInfo (InlinePragma { inl_rule :: InlinePragma -> RuleMatchInfo
inl_rule = RuleMatchInfo
info }) = RuleMatchInfo
info

setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
setInlinePragmaActivation :: InlinePragma -> Activation -> InlinePragma
setInlinePragmaActivation InlinePragma
prag Activation
activation = InlinePragma
prag { inl_act :: Activation
inl_act = Activation
activation }

setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
setInlinePragmaRuleMatchInfo :: InlinePragma -> RuleMatchInfo -> InlinePragma
setInlinePragmaRuleMatchInfo InlinePragma
prag RuleMatchInfo
info = InlinePragma
prag { inl_rule :: RuleMatchInfo
inl_rule = RuleMatchInfo
info }

instance Outputable Activation where
   ppr :: Activation -> SDoc
ppr Activation
AlwaysActive       = SDoc
empty
   ppr Activation
NeverActive        = SDoc -> SDoc
brackets (String -> SDoc
text String
"~")
   ppr (ActiveBefore SourceText
_ Int
n) = SDoc -> SDoc
brackets (Char -> SDoc
char Char
'~' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
n)
   ppr (ActiveAfter  SourceText
_ Int
n) = SDoc -> SDoc
brackets (Int -> SDoc
int Int
n)
   ppr Activation
FinalActive        = String -> SDoc
text String
"[final]"

instance Binary Activation where
    put_ :: BinHandle -> Activation -> IO ()
put_ BinHandle
bh Activation
NeverActive =
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh Activation
FinalActive =
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh Activation
AlwaysActive =
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    put_ BinHandle
bh (ActiveBefore SourceText
src Int
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
            BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
src
            BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
aa
    put_ BinHandle
bh (ActiveAfter SourceText
src Int
ab) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
            BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
src
            BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
ab
    get :: BinHandle -> IO Activation
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> Activation -> IO Activation
forall (m :: * -> *) a. Monad m => a -> m a
return Activation
NeverActive
              Word8
1 -> Activation -> IO Activation
forall (m :: * -> *) a. Monad m => a -> m a
return Activation
FinalActive
              Word8
2 -> Activation -> IO Activation
forall (m :: * -> *) a. Monad m => a -> m a
return Activation
AlwaysActive
              Word8
3 -> do SourceText
src <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      Int
aa <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      Activation -> IO Activation
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText -> Int -> Activation
ActiveBefore SourceText
src Int
aa)
              Word8
_ -> do SourceText
src <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      Int
ab <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      Activation -> IO Activation
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText -> Int -> Activation
ActiveAfter SourceText
src Int
ab)


instance Outputable RuleMatchInfo where
   ppr :: RuleMatchInfo -> SDoc
ppr RuleMatchInfo
ConLike = String -> SDoc
text String
"CONLIKE"
   ppr RuleMatchInfo
FunLike = String -> SDoc
text String
"FUNLIKE"

instance Binary RuleMatchInfo where
    put_ :: BinHandle -> RuleMatchInfo -> IO ()
put_ BinHandle
bh RuleMatchInfo
FunLike = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh RuleMatchInfo
ConLike = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    get :: BinHandle -> IO RuleMatchInfo
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            if Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 then RuleMatchInfo -> IO RuleMatchInfo
forall (m :: * -> *) a. Monad m => a -> m a
return RuleMatchInfo
ConLike
                      else RuleMatchInfo -> IO RuleMatchInfo
forall (m :: * -> *) a. Monad m => a -> m a
return RuleMatchInfo
FunLike

instance Outputable InlineSpec where
   ppr :: InlineSpec -> SDoc
ppr InlineSpec
Inline           = String -> SDoc
text String
"INLINE"
   ppr InlineSpec
NoInline         = String -> SDoc
text String
"NOINLINE"
   ppr InlineSpec
Inlinable        = String -> SDoc
text String
"INLINABLE"
   ppr InlineSpec
NoUserInlinePrag = SDoc
empty

instance Binary InlineSpec where
    put_ :: BinHandle -> InlineSpec -> IO ()
put_ BinHandle
bh InlineSpec
NoUserInlinePrag = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh InlineSpec
Inline           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
    put_ BinHandle
bh InlineSpec
Inlinable        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
    put_ BinHandle
bh InlineSpec
NoInline         = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3

    get :: BinHandle -> IO InlineSpec
get BinHandle
bh = do Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
                case Word8
h of
                  Word8
0 -> InlineSpec -> IO InlineSpec
forall (m :: * -> *) a. Monad m => a -> m a
return InlineSpec
NoUserInlinePrag
                  Word8
1 -> InlineSpec -> IO InlineSpec
forall (m :: * -> *) a. Monad m => a -> m a
return InlineSpec
Inline
                  Word8
2 -> InlineSpec -> IO InlineSpec
forall (m :: * -> *) a. Monad m => a -> m a
return InlineSpec
Inlinable
                  Word8
_ -> InlineSpec -> IO InlineSpec
forall (m :: * -> *) a. Monad m => a -> m a
return InlineSpec
NoInline


instance Outputable InlinePragma where
  ppr :: InlinePragma -> SDoc
ppr = InlinePragma -> SDoc
pprInline

instance Binary InlinePragma where
    put_ :: BinHandle -> InlinePragma -> IO ()
put_ BinHandle
bh (InlinePragma SourceText
s InlineSpec
a Maybe Int
b Activation
c RuleMatchInfo
d) = do
            BinHandle -> SourceText -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SourceText
s
            BinHandle -> InlineSpec -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh InlineSpec
a
            BinHandle -> Maybe Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe Int
b
            BinHandle -> Activation -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Activation
c
            BinHandle -> RuleMatchInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh RuleMatchInfo
d

    get :: BinHandle -> IO InlinePragma
get BinHandle
bh = do
           SourceText
s <- BinHandle -> IO SourceText
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           InlineSpec
a <- BinHandle -> IO InlineSpec
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           Maybe Int
b <- BinHandle -> IO (Maybe Int)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           Activation
c <- BinHandle -> IO Activation
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           RuleMatchInfo
d <- BinHandle -> IO RuleMatchInfo
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           InlinePragma -> IO InlinePragma
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText
-> InlineSpec
-> Maybe Int
-> Activation
-> RuleMatchInfo
-> InlinePragma
InlinePragma SourceText
s InlineSpec
a Maybe Int
b Activation
c RuleMatchInfo
d)


pprInline :: InlinePragma -> SDoc
pprInline :: InlinePragma -> SDoc
pprInline = Bool -> InlinePragma -> SDoc
pprInline' Bool
True

pprInlineDebug :: InlinePragma -> SDoc
pprInlineDebug :: InlinePragma -> SDoc
pprInlineDebug = Bool -> InlinePragma -> SDoc
pprInline' Bool
False

pprInline' :: Bool           -- True <=> do not display the inl_inline field
           -> InlinePragma
           -> SDoc
pprInline' :: Bool -> InlinePragma -> SDoc
pprInline' Bool
emptyInline (InlinePragma { inl_inline :: InlinePragma -> InlineSpec
inl_inline = InlineSpec
inline, inl_act :: InlinePragma -> Activation
inl_act = Activation
activation
                                    , inl_rule :: InlinePragma -> RuleMatchInfo
inl_rule = RuleMatchInfo
info, inl_sat :: InlinePragma -> Maybe Int
inl_sat = Maybe Int
mb_arity })
    = InlineSpec -> SDoc
pp_inl InlineSpec
inline SDoc -> SDoc -> SDoc
<> InlineSpec -> Activation -> SDoc
pp_act InlineSpec
inline Activation
activation SDoc -> SDoc -> SDoc
<+> SDoc
pp_sat SDoc -> SDoc -> SDoc
<+> SDoc
pp_info
    where
      pp_inl :: InlineSpec -> SDoc
pp_inl InlineSpec
x = if Bool
emptyInline then SDoc
empty else InlineSpec -> SDoc
forall a. Outputable a => a -> SDoc
ppr InlineSpec
x

      pp_act :: InlineSpec -> Activation -> SDoc
pp_act InlineSpec
Inline   Activation
AlwaysActive = SDoc
empty
      pp_act InlineSpec
NoInline Activation
NeverActive  = SDoc
empty
      pp_act InlineSpec
_        Activation
act          = Activation -> SDoc
forall a. Outputable a => a -> SDoc
ppr Activation
act

      pp_sat :: SDoc
pp_sat | Just Int
ar <- Maybe Int
mb_arity = SDoc -> SDoc
parens (String -> SDoc
text String
"sat-args=" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
ar)
             | Bool
otherwise           = SDoc
empty
      pp_info :: SDoc
pp_info | RuleMatchInfo -> Bool
isFunLike RuleMatchInfo
info = SDoc
empty
              | Bool
otherwise      = RuleMatchInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr RuleMatchInfo
info



{-
************************************************************************
*                                                                      *
    IntWithInf
*                                                                      *
************************************************************************

Represents an integer or positive infinity

-}

-- | An integer or infinity
data IntWithInf = Int {-# UNPACK #-} !Int
                | Infinity
  deriving IntWithInf -> IntWithInf -> Bool
(IntWithInf -> IntWithInf -> Bool)
-> (IntWithInf -> IntWithInf -> Bool) -> Eq IntWithInf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IntWithInf -> IntWithInf -> Bool
$c/= :: IntWithInf -> IntWithInf -> Bool
== :: IntWithInf -> IntWithInf -> Bool
$c== :: IntWithInf -> IntWithInf -> Bool
Eq

-- | A representation of infinity
infinity :: IntWithInf
infinity :: IntWithInf
infinity = IntWithInf
Infinity

instance Ord IntWithInf where
  compare :: IntWithInf -> IntWithInf -> Ordering
compare IntWithInf
Infinity IntWithInf
Infinity = Ordering
EQ
  compare (Int Int
_)  IntWithInf
Infinity = Ordering
LT
  compare IntWithInf
Infinity (Int Int
_)  = Ordering
GT
  compare (Int Int
a)  (Int Int
b)  = Int
a Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
b

instance Outputable IntWithInf where
  ppr :: IntWithInf -> SDoc
ppr IntWithInf
Infinity = Char -> SDoc
char Char
'∞'
  ppr (Int Int
n)  = Int -> SDoc
int Int
n

instance Num IntWithInf where
  + :: IntWithInf -> IntWithInf -> IntWithInf
(+) = IntWithInf -> IntWithInf -> IntWithInf
plusWithInf
  * :: IntWithInf -> IntWithInf -> IntWithInf
(*) = IntWithInf -> IntWithInf -> IntWithInf
mulWithInf

  abs :: IntWithInf -> IntWithInf
abs IntWithInf
Infinity = IntWithInf
Infinity
  abs (Int Int
n)  = Int -> IntWithInf
Int (Int -> Int
forall a. Num a => a -> a
abs Int
n)

  signum :: IntWithInf -> IntWithInf
signum IntWithInf
Infinity = Int -> IntWithInf
Int Int
1
  signum (Int Int
n)  = Int -> IntWithInf
Int (Int -> Int
forall a. Num a => a -> a
signum Int
n)

  fromInteger :: Integer -> IntWithInf
fromInteger = Int -> IntWithInf
Int (Int -> IntWithInf) -> (Integer -> Int) -> Integer -> IntWithInf
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger

  (-) = String -> IntWithInf -> IntWithInf -> IntWithInf
forall a. String -> a
panic String
"subtracting IntWithInfs"

intGtLimit :: Int -> IntWithInf -> Bool
intGtLimit :: Int -> IntWithInf -> Bool
intGtLimit Int
_ IntWithInf
Infinity = Bool
False
intGtLimit Int
n (Int Int
m)  = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
m

-- | Add two 'IntWithInf's
plusWithInf :: IntWithInf -> IntWithInf -> IntWithInf
plusWithInf :: IntWithInf -> IntWithInf -> IntWithInf
plusWithInf IntWithInf
Infinity IntWithInf
_        = IntWithInf
Infinity
plusWithInf IntWithInf
_        IntWithInf
Infinity = IntWithInf
Infinity
plusWithInf (Int Int
a)  (Int Int
b)  = Int -> IntWithInf
Int (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b)

-- | Multiply two 'IntWithInf's
mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
mulWithInf IntWithInf
Infinity IntWithInf
_        = IntWithInf
Infinity
mulWithInf IntWithInf
_        IntWithInf
Infinity = IntWithInf
Infinity
mulWithInf (Int Int
a)  (Int Int
b)  = Int -> IntWithInf
Int (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b)

-- | Turn a positive number into an 'IntWithInf', where 0 represents infinity
treatZeroAsInf :: Int -> IntWithInf
treatZeroAsInf :: Int -> IntWithInf
treatZeroAsInf Int
0 = IntWithInf
Infinity
treatZeroAsInf Int
n = Int -> IntWithInf
Int Int
n

-- | Inject any integer into an 'IntWithInf'
mkIntWithInf :: Int -> IntWithInf
mkIntWithInf :: Int -> IntWithInf
mkIntWithInf = Int -> IntWithInf
Int

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

{- *********************************************************************
*                                                                      *
                        Types vs Kinds
*                                                                      *
********************************************************************* -}

-- | Flag to see whether we're type-checking terms or kind-checking types
data TypeOrKind = TypeLevel | KindLevel
  deriving TypeOrKind -> TypeOrKind -> Bool
(TypeOrKind -> TypeOrKind -> Bool)
-> (TypeOrKind -> TypeOrKind -> Bool) -> Eq TypeOrKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TypeOrKind -> TypeOrKind -> Bool
$c/= :: TypeOrKind -> TypeOrKind -> Bool
== :: TypeOrKind -> TypeOrKind -> Bool
$c== :: TypeOrKind -> TypeOrKind -> Bool
Eq

instance Outputable TypeOrKind where
  ppr :: TypeOrKind -> SDoc
ppr TypeOrKind
TypeLevel = String -> SDoc
text String
"TypeLevel"
  ppr TypeOrKind
KindLevel = String -> SDoc
text String
"KindLevel"

isTypeLevel :: TypeOrKind -> Bool
isTypeLevel :: TypeOrKind -> Bool
isTypeLevel TypeOrKind
TypeLevel = Bool
True
isTypeLevel TypeOrKind
KindLevel = Bool
False

isKindLevel :: TypeOrKind -> Bool
isKindLevel :: TypeOrKind -> Bool
isKindLevel TypeOrKind
TypeLevel = Bool
False
isKindLevel TypeOrKind
KindLevel = Bool
True