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

{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable PromotionFlag, Binary PromotionFlag, Outputable Boxity, Binay Boxity
{-# LANGUAGE DerivingVia #-}

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

        ConTag, ConTagZ, fIRST_TAG,

        Arity, VisArity, RepArity, JoinArity, FullArgCount,
        JoinPointHood(..), isJoinPoint,

        Alignment, mkAlignment, alignmentOf, alignmentBytes,

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

        RecFlag(..), isRec, isNonRec, boolToRecFlag,
        Origin(..), isGenerated, DoPmc(..), requiresPMC,
        GenReason(..), isDoExpansionGenerated, doExpansionFlavour,
        doExpansionOrigin,

        RuleName, pprRuleName,

        TopLevelFlag(..), isTopLevel, isNotTopLevel,

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

        Boxity(..), isBoxed,

        CbvMark(..), isMarkedCbv,

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

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

        UnboxedTupleOrSum(..), unboxedTupleOrSumExtension,
        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, notSwapped, isSwapped, pickSwap,

        UnfoldingSource(..), isStableSource, isStableUserSource,
        isStableSystemSource, isCompulsorySource,

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

        IntWithInf, infinity, treatZeroAsInf, mkIntWithInf,
        intGtLimit, subWithInf, mulWithInf,

        TypeOrKind(..), isTypeLevel, isKindLevel,

        Levity(..), mightBeLifted, mightBeUnlifted,
        TypeOrConstraint(..),

        TyConFlavour(..), TypeOrData(..), NewOrData(..), tyConFlavourAssoc_maybe,

        NonStandardDefaultingStrategy(..),
        DefaultingStrategy(..), defaultNonStandardTyVars,

        ForeignSrcLang (..),

        ImportLevel(..), convImportLevel, convImportLevelSpec, allImportLevels,
   ) 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.Arity
import GHC.Types.SourceText
import qualified GHC.LanguageExtensions as LangExt
import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted)
import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag)
import {-# SOURCE #-} Language.Haskell.Syntax.Expr (HsDoFlavour)
import Control.DeepSeq ( NFData(..) )
import Data.Data
import Data.Maybe
import qualified Data.Semigroup as Semi

import Language.Haskell.Syntax.ImpExp

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

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
forall doc. IsLine doc => String -> doc
text String
"Left"
  ppr LeftOrRight
CRight   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Right"

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

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

instance NFData LeftOrRight where
  rnf :: LeftOrRight -> ()
rnf LeftOrRight
CLeft  = ()
  rnf LeftOrRight
CRight = ()

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

-- | 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
$c== :: Alignment -> Alignment -> Bool
== :: Alignment -> Alignment -> Bool
$c/= :: Alignment -> Alignment -> Bool
/= :: 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
$ccompare :: Alignment -> Alignment -> Ordering
compare :: Alignment -> Alignment -> Ordering
$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
>= :: Alignment -> Alignment -> Bool
$cmax :: Alignment -> Alignment -> Alignment
max :: Alignment -> Alignment -> Alignment
$cmin :: Alignment -> Alignment -> Alignment
min :: Alignment -> Alignment -> Alignment
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. HasCallStack => 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 C(1,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 C(1,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
$c== :: OneShotInfo -> OneShotInfo -> Bool
== :: OneShotInfo -> OneShotInfo -> Bool
$c/= :: OneShotInfo -> OneShotInfo -> Bool
/= :: 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 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoOS"
pprOneShotInfo OneShotInfo
OneShotLam    = String -> SDoc
forall doc. IsLine doc => String -> doc
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
  deriving( SwapFlag -> SwapFlag -> Bool
(SwapFlag -> SwapFlag -> Bool)
-> (SwapFlag -> SwapFlag -> Bool) -> Eq SwapFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwapFlag -> SwapFlag -> Bool
== :: SwapFlag -> SwapFlag -> Bool
$c/= :: SwapFlag -> SwapFlag -> Bool
/= :: SwapFlag -> SwapFlag -> Bool
Eq )

instance Outputable SwapFlag where
  ppr :: SwapFlag -> SDoc
ppr SwapFlag
IsSwapped  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Is-swapped"
  ppr SwapFlag
NotSwapped = String -> SDoc
forall doc. IsLine doc => String -> doc
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

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

pickSwap :: SwapFlag -> a -> a -> a
pickSwap :: forall a. SwapFlag -> a -> a -> a
pickSwap SwapFlag
NotSwapped a
a a
_ = a
a
pickSwap SwapFlag
IsSwapped  a
_ a
b = a
b

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

instance Outputable PromotionFlag where
  ppr :: PromotionFlag -> SDoc
ppr PromotionFlag
NotPromoted = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NotPromoted"
  ppr PromotionFlag
IsPromoted  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"IsPromoted"

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

   get :: ReadBinHandle -> IO PromotionFlag
get ReadBinHandle
bh = do
       n <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
       case n of
         Word8
0 -> PromotionFlag -> IO PromotionFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PromotionFlag
NotPromoted
         Word8
1 -> PromotionFlag -> IO PromotionFlag
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return PromotionFlag
IsPromoted
         Word8
_ -> String -> IO PromotionFlag
forall a. HasCallStack => String -> IO a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
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
$c== :: FunctionOrData -> FunctionOrData -> Bool
== :: FunctionOrData -> FunctionOrData -> Bool
$c/= :: FunctionOrData -> FunctionOrData -> Bool
/= :: 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
$ccompare :: FunctionOrData -> FunctionOrData -> Ordering
compare :: FunctionOrData -> FunctionOrData -> Ordering
$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
>= :: FunctionOrData -> FunctionOrData -> Bool
$cmax :: FunctionOrData -> FunctionOrData -> FunctionOrData
max :: FunctionOrData -> FunctionOrData -> FunctionOrData
$cmin :: FunctionOrData -> FunctionOrData -> FunctionOrData
min :: FunctionOrData -> FunctionOrData -> FunctionOrData
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 -> Constr
FunctionOrData -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionOrData -> c FunctionOrData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FunctionOrData -> c FunctionOrData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionOrData
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FunctionOrData
$ctoConstr :: FunctionOrData -> Constr
toConstr :: FunctionOrData -> Constr
$cdataTypeOf :: FunctionOrData -> DataType
dataTypeOf :: FunctionOrData -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionOrData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FunctionOrData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionOrData)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FunctionOrData)
$cgmapT :: (forall b. Data b => b -> b) -> FunctionOrData -> FunctionOrData
gmapT :: (forall b. Data b => b -> b) -> FunctionOrData -> FunctionOrData
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionOrData -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FunctionOrData -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionOrData -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FunctionOrData -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionOrData -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FunctionOrData -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionOrData -> m FunctionOrData
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FunctionOrData -> m FunctionOrData
Data)

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

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

instance NFData FunctionOrData where
  rnf :: FunctionOrData -> ()
rnf FunctionOrData
IsFunction = ()
  rnf FunctionOrData
IsData = ()

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

type RuleName = FastString

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

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

instance Outputable Boxity where
  ppr :: Boxity -> SDoc
ppr Boxity
Boxed   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Boxed"
  ppr Boxity
Unboxed = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unboxed"

instance Binary Boxity where -- implemented via isBoxed-isomorphism to Bool
  put_ :: WriteBinHandle -> Boxity -> IO ()
put_ WriteBinHandle
bh = WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (Bool -> IO ()) -> (Boxity -> Bool) -> Boxity -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boxity -> Bool
isBoxed
  get :: ReadBinHandle -> IO Boxity
get ReadBinHandle
bh  = do
    b <- ReadBinHandle -> IO Bool
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
    pure $ if b then Boxed else Unboxed

{-
************************************************************************
*                                                                      *
                Call by value flag
*                                                                      *
************************************************************************
-}

-- | Should an argument be passed evaluated *and* tagged.
data CbvMark = MarkedCbv | NotMarkedCbv
    deriving CbvMark -> CbvMark -> Bool
(CbvMark -> CbvMark -> Bool)
-> (CbvMark -> CbvMark -> Bool) -> Eq CbvMark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CbvMark -> CbvMark -> Bool
== :: CbvMark -> CbvMark -> Bool
$c/= :: CbvMark -> CbvMark -> Bool
/= :: CbvMark -> CbvMark -> Bool
Eq

instance Outputable CbvMark where
  ppr :: CbvMark -> SDoc
ppr CbvMark
MarkedCbv    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"!"
  ppr CbvMark
NotMarkedCbv = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~"

instance Binary CbvMark where
    put_ :: WriteBinHandle -> CbvMark -> IO ()
put_ WriteBinHandle
bh CbvMark
NotMarkedCbv = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh CbvMark
MarkedCbv    = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    get :: ReadBinHandle -> IO CbvMark
get ReadBinHandle
bh =
      do h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
         case h of
           Word8
0 -> CbvMark -> IO CbvMark
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CbvMark
NotMarkedCbv
           Word8
1 -> CbvMark -> IO CbvMark
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CbvMark
MarkedCbv
           Word8
_ -> String -> IO CbvMark
forall a. HasCallStack => String -> a
panic String
"Invalid binary format"

instance NFData CbvMark where
  rnf :: CbvMark -> ()
rnf CbvMark
MarkedCbv    = ()
  rnf CbvMark
NotMarkedCbv = ()


isMarkedCbv :: CbvMark -> Bool
isMarkedCbv :: CbvMark -> Bool
isMarkedCbv CbvMark
MarkedCbv = Bool
True
isMarkedCbv CbvMark
NotMarkedCbv = Bool
False


{-
************************************************************************
*                                                                      *
                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
$c== :: RecFlag -> RecFlag -> Bool
== :: RecFlag -> RecFlag -> Bool
$c/= :: RecFlag -> RecFlag -> Bool
/= :: 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 -> Constr
RecFlag -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFlag -> c RecFlag
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RecFlag -> c RecFlag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFlag
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RecFlag
$ctoConstr :: RecFlag -> Constr
toConstr :: RecFlag -> Constr
$cdataTypeOf :: RecFlag -> DataType
dataTypeOf :: RecFlag -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFlag)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RecFlag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RecFlag)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RecFlag)
$cgmapT :: (forall b. Data b => b -> b) -> RecFlag -> RecFlag
gmapT :: (forall b. Data b => b -> b) -> RecFlag -> RecFlag
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFlag -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecFlag -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RecFlag -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RecFlag -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RecFlag -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RecFlag -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecFlag -> m RecFlag
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RecFlag -> m 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
forall doc. IsLine doc => String -> doc
text String
"Recursive"
  ppr RecFlag
NonRecursive = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NonRecursive"

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

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

-- | Was this piece of code user-written or generated by the compiler?
--
-- See Note [Generated code and pattern-match checking].
data Origin = FromSource
            | Generated GenReason DoPmc
            deriving( Origin -> Origin -> Bool
(Origin -> Origin -> Bool)
-> (Origin -> Origin -> Bool) -> Eq Origin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Origin -> Origin -> Bool
== :: Origin -> Origin -> Bool
$c/= :: Origin -> Origin -> Bool
/= :: 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 -> Constr
Origin -> DataType
(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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Origin -> c Origin
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Origin -> c Origin
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Origin
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Origin
$ctoConstr :: Origin -> Constr
toConstr :: Origin -> Constr
$cdataTypeOf :: Origin -> DataType
dataTypeOf :: Origin -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Origin)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Origin)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Origin)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Origin)
$cgmapT :: (forall b. Data b => b -> b) -> Origin -> Origin
gmapT :: (forall b. Data b => b -> b) -> Origin -> Origin
$cgmapQl :: 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
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Origin -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Origin -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Origin -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Origin -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Origin -> u
$cgmapM :: forall (m :: * -> *).
Monad 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
$cgmapMp :: 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
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Origin -> m Origin
Data )

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

-- | This metadata stores the information as to why was the piece of code generated
--   It is useful for generating the right error context
-- See Part 3 in Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
data GenReason = DoExpansion HsDoFlavour
               | OtherExpansion
               deriving (GenReason -> GenReason -> Bool
(GenReason -> GenReason -> Bool)
-> (GenReason -> GenReason -> Bool) -> Eq GenReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenReason -> GenReason -> Bool
== :: GenReason -> GenReason -> Bool
$c/= :: GenReason -> GenReason -> Bool
/= :: GenReason -> GenReason -> Bool
Eq, Typeable GenReason
Typeable GenReason =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GenReason -> c GenReason)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GenReason)
-> (GenReason -> Constr)
-> (GenReason -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GenReason))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenReason))
-> ((forall b. Data b => b -> b) -> GenReason -> GenReason)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GenReason -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GenReason -> r)
-> (forall u. (forall d. Data d => d -> u) -> GenReason -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GenReason -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> GenReason -> m GenReason)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GenReason -> m GenReason)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> GenReason -> m GenReason)
-> Data GenReason
GenReason -> Constr
GenReason -> DataType
(forall b. Data b => b -> b) -> GenReason -> GenReason
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) -> GenReason -> u
forall u. (forall d. Data d => d -> u) -> GenReason -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenReason -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenReason -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenReason
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenReason -> c GenReason
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenReason)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenReason)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenReason -> c GenReason
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenReason -> c GenReason
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenReason
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenReason
$ctoConstr :: GenReason -> Constr
toConstr :: GenReason -> Constr
$cdataTypeOf :: GenReason -> DataType
dataTypeOf :: GenReason -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenReason)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenReason)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenReason)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c GenReason)
$cgmapT :: (forall b. Data b => b -> b) -> GenReason -> GenReason
gmapT :: (forall b. Data b => b -> b) -> GenReason -> GenReason
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenReason -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenReason -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenReason -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenReason -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GenReason -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> GenReason -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GenReason -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GenReason -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GenReason -> m GenReason
Data)

instance Outputable GenReason where
  ppr :: GenReason -> SDoc
ppr DoExpansion{}  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DoExpansion"
  ppr GenReason
OtherExpansion = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OtherExpansion"

doExpansionFlavour :: Origin -> Maybe HsDoFlavour
doExpansionFlavour :: Origin -> Maybe HsDoFlavour
doExpansionFlavour (Generated (DoExpansion HsDoFlavour
f) DoPmc
_) = HsDoFlavour -> Maybe HsDoFlavour
forall a. a -> Maybe a
Just HsDoFlavour
f
doExpansionFlavour Origin
_ = Maybe HsDoFlavour
forall a. Maybe a
Nothing

-- See Part 3 in Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
isDoExpansionGenerated :: Origin -> Bool
isDoExpansionGenerated :: Origin -> Bool
isDoExpansionGenerated = Maybe HsDoFlavour -> Bool
forall a. Maybe a -> Bool
isJust (Maybe HsDoFlavour -> Bool)
-> (Origin -> Maybe HsDoFlavour) -> Origin -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Origin -> Maybe HsDoFlavour
doExpansionFlavour

-- See Part 3 in Note [Expanding HsDo with XXExprGhcRn] in `GHC.Tc.Gen.Do`
doExpansionOrigin :: HsDoFlavour -> Origin
doExpansionOrigin :: HsDoFlavour -> Origin
doExpansionOrigin HsDoFlavour
f = GenReason -> DoPmc -> Origin
Generated (HsDoFlavour -> GenReason
DoExpansion HsDoFlavour
f) DoPmc
DoPmc
                    -- It is important that we perfrom PMC
                    -- on the expressions generated by do statements
                    -- to get the right pattern match checker warnings
                    -- See `GHC.HsToCore.Pmc.pmcMatches`

instance Outputable Origin where
  ppr :: Origin -> SDoc
ppr Origin
FromSource             = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"FromSource"
  ppr (Generated GenReason
reason DoPmc
pmc) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Generated" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> GenReason -> SDoc
forall a. Outputable a => a -> SDoc
ppr GenReason
reason SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> DoPmc -> SDoc
forall a. Outputable a => a -> SDoc
ppr DoPmc
pmc

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

instance Outputable DoPmc where
  ppr :: DoPmc -> SDoc
ppr DoPmc
SkipPmc     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SkipPmc"
  ppr DoPmc
DoPmc       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DoPmc"

-- | Does this 'Origin' require us to run pattern-match checking,
-- or should we skip these checks?
--
-- See Note [Generated code and pattern-match checking].
requiresPMC :: Origin -> Bool
requiresPMC :: Origin -> Bool
requiresPMC (Generated GenReason
_ DoPmc
SkipPmc) = Bool
False
requiresPMC Origin
_ = Bool
True

{- Note [Generated code and pattern-match checking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Some parts of the compiler generate code that is then typechecked. For example:

  - the XXExprGhcRn mechanism described in Note [Rebindable syntax and XXExprGhcRn]
    in GHC.Hs.Expr,
  - the deriving mechanism.

It is usually the case that we want to avoid generating error messages that
refer to generated code. The way this is handled is that we mark certain
parts of the AST as being generated (using the Origin datatype); this is then
used to set the tcl_in_gen_code flag in TcLclEnv, as explained in
Note [Error contexts in generated code] in GHC.Tc.Utils.Monad.

Being in generated code is usually taken to mean we should also skip doing
pattern-match checking, but not always. For example, when desugaring a record
update (as described in Note [Record Updates] in GHC.Tc.Gen.Expr), we still want
to do pattern-match checking, in order to report incomplete record updates
(failing to do so lead to #23250). So, for a 'Generated' 'Origin', we keep track
of whether we should do pattern-match checks; see the calls of the requiresPMC
function (e.g. isMatchContextPmChecked and needToRunPmCheck in GHC.HsToCore.Pmc.Utils).
-}

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

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

hasIncoherentFlag :: OverlapMode -> Bool
hasIncoherentFlag :: OverlapMode -> Bool
hasIncoherentFlag OverlapMode
mode =
  case OverlapMode
mode of
    Incoherent   SourceText
_ -> Bool
True
    NonCanonical 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
    NonCanonical 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
    NonCanonical SourceText
_ -> Bool
True
    OverlapMode
_              -> Bool
False

hasNonCanonicalFlag :: OverlapMode -> Bool
hasNonCanonicalFlag :: OverlapMode -> Bool
hasNonCanonicalFlag = \case
  NonCanonical{} -> 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"

  | NonCanonical SourceText
    -- ^ Behave like Incoherent, but the instance choice is observable
    -- by the program behaviour. See Note [Coherence and specialisation: overview].
    --
    -- We don't have surface syntax for the distinction between
    -- Incoherent and NonCanonical instances; instead, the flag
    -- `-f{no-}specialise-incoherents` (on by default) controls
    -- whether `INCOHERENT` instances are regarded as Incoherent or
    -- NonCanonical.

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

instance NFData OverlapFlag where
  rnf :: OverlapFlag -> ()
rnf (OverlapFlag OverlapMode
mode Bool
safe) = OverlapMode -> ()
forall a. NFData a => a -> ()
rnf OverlapMode
mode () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
safe

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

instance NFData OverlapMode where
  rnf :: OverlapMode -> ()
rnf (NoOverlap SourceText
s) = SourceText -> ()
forall a. NFData a => a -> ()
rnf SourceText
s
  rnf (Overlappable SourceText
s) = SourceText -> ()
forall a. NFData a => a -> ()
rnf SourceText
s
  rnf (Overlapping SourceText
s) = SourceText -> ()
forall a. NFData a => a -> ()
rnf SourceText
s
  rnf (Overlaps SourceText
s) = SourceText -> ()
forall a. NFData a => a -> ()
rnf SourceText
s
  rnf (Incoherent SourceText
s) = SourceText -> ()
forall a. NFData a => a -> ()
rnf SourceText
s
  rnf (NonCanonical SourceText
s) = SourceText -> ()
forall a. NFData a => a -> ()
rnf SourceText
s

instance Binary OverlapMode where
    put_ :: WriteBinHandle -> OverlapMode -> IO ()
put_ WriteBinHandle
bh (NoOverlap    SourceText
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SourceText
s
    put_ WriteBinHandle
bh (Overlaps     SourceText
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SourceText
s
    put_ WriteBinHandle
bh (Incoherent   SourceText
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SourceText
s
    put_ WriteBinHandle
bh (Overlapping  SourceText
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SourceText
s
    put_ WriteBinHandle
bh (Overlappable SourceText
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
4 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SourceText
s
    put_ WriteBinHandle
bh (NonCanonical SourceText
s) = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
5 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WriteBinHandle -> SourceText -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh SourceText
s
    get :: ReadBinHandle -> IO OverlapMode
get ReadBinHandle
bh = do
        h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
        case h of
            Word8
0 -> (ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall a. a -> IO a
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 -> (ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall a. a -> IO a
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 -> (ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall a. a -> IO a
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 -> (ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall a. a -> IO a
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 -> (ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall a. a -> IO a
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
5 -> (ReadBinHandle -> IO SourceText
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh) IO SourceText -> (SourceText -> IO OverlapMode) -> IO OverlapMode
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourceText
s -> OverlapMode -> IO OverlapMode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (OverlapMode -> IO OverlapMode) -> OverlapMode -> IO OverlapMode
forall a b. (a -> b) -> a -> b
$ SourceText -> OverlapMode
NonCanonical SourceText
s
            Word8
_ -> String -> IO OverlapMode
forall a. HasCallStack => 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_ :: WriteBinHandle -> OverlapFlag -> IO ()
put_ WriteBinHandle
bh OverlapFlag
flag = do WriteBinHandle -> OverlapMode -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (OverlapFlag -> OverlapMode
overlapMode OverlapFlag
flag)
                      WriteBinHandle -> Bool -> IO ()
forall a. Binary a => WriteBinHandle -> a -> IO ()
put_ WriteBinHandle
bh (OverlapFlag -> Bool
isSafeOverlap OverlapFlag
flag)
    get :: ReadBinHandle -> IO OverlapFlag
get ReadBinHandle
bh = do
        h <- ReadBinHandle -> IO OverlapMode
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh
        b <- get bh
        return OverlapFlag { overlapMode = h, isSafeOverlap = b }

pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap Bool
True  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[safe]"
pprSafeOverlap Bool
False = SDoc
forall doc. IsOutput doc => doc
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
$c== :: PprPrec -> PprPrec -> Bool
== :: PprPrec -> PprPrec -> Bool
$c/= :: PprPrec -> PprPrec -> Bool
/= :: 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
$ccompare :: PprPrec -> PprPrec -> Ordering
compare :: PprPrec -> PprPrec -> Ordering
$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
>= :: PprPrec -> PprPrec -> Bool
$cmax :: PprPrec -> PprPrec -> PprPrec
max :: PprPrec -> PprPrec -> PprPrec
$cmin :: PprPrec -> PprPrec -> PprPrec
min :: PprPrec -> PprPrec -> PprPrec
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
$cshowsPrec :: Int -> PprPrec -> String -> String
showsPrec :: Int -> PprPrec -> String -> String
$cshow :: PprPrec -> String
show :: PprPrec -> String
$cshowList :: [PprPrec] -> String -> String
showList :: [PprPrec] -> String -> String
Show)
-- See Note [Precedence in types]

topPrec, sigPrec, funPrec, opPrec, starPrec, appPrec, maxPrec :: 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
maxPrec :: PprPrec
maxPrec  = PprPrec
appPrec   -- Maximum precendence

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

instance Outputable TupleSort where
  ppr :: TupleSort -> SDoc
ppr TupleSort
ts = String -> SDoc
forall doc. IsLine doc => String -> doc
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_ :: WriteBinHandle -> TupleSort -> IO ()
put_ WriteBinHandle
bh TupleSort
BoxedTuple      = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh TupleSort
UnboxedTuple    = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    put_ WriteBinHandle
bh TupleSort
ConstraintTuple = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    get :: ReadBinHandle -> IO TupleSort
get ReadBinHandle
bh = do
      h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
      case h of
        Word8
0 -> TupleSort -> IO TupleSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
BoxedTuple
        Word8
1 -> TupleSort -> IO TupleSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
UnboxedTuple
        Word8
_ -> TupleSort -> IO TupleSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TupleSort
ConstraintTuple

instance NFData TupleSort where
  rnf :: TupleSort -> ()
rnf TupleSort
BoxedTuple      = ()
  rnf TupleSort
UnboxedTuple    = ()
  rnf 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
forall doc. IsLine doc => doc -> doc
parens SDoc
p
tupleParens TupleSort
UnboxedTuple    SDoc
p = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(#" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
p SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"#)"
tupleParens TupleSort
ConstraintTuple SDoc
p   -- In debug-style write (% Eq a, Ord b %)
  = SDoc -> SDoc -> SDoc
forall doc. IsOutput doc => doc -> doc -> doc
ifPprDebug (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(%" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
p SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%)")
               (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
p)

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

sumParens :: SDoc -> SDoc
sumParens :: SDoc -> SDoc
sumParens SDoc
p = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(#" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
p SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text 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
forall doc. IsLine doc => [doc] -> doc
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
forall doc. IsLine doc => doc
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
forall doc. IsLine doc => doc
vbar)

-- | Are we dealing with an unboxed tuple or an unboxed sum?
--
-- Used when validity checking, see 'check_ubx_tuple_or_sum'.
data UnboxedTupleOrSum
  = UnboxedTupleType
  | UnboxedSumType
  deriving UnboxedTupleOrSum -> UnboxedTupleOrSum -> Bool
(UnboxedTupleOrSum -> UnboxedTupleOrSum -> Bool)
-> (UnboxedTupleOrSum -> UnboxedTupleOrSum -> Bool)
-> Eq UnboxedTupleOrSum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnboxedTupleOrSum -> UnboxedTupleOrSum -> Bool
== :: UnboxedTupleOrSum -> UnboxedTupleOrSum -> Bool
$c/= :: UnboxedTupleOrSum -> UnboxedTupleOrSum -> Bool
/= :: UnboxedTupleOrSum -> UnboxedTupleOrSum -> Bool
Eq

instance Outputable UnboxedTupleOrSum where
  ppr :: UnboxedTupleOrSum -> SDoc
ppr UnboxedTupleOrSum
UnboxedTupleType = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnboxedTupleType"
  ppr UnboxedTupleOrSum
UnboxedSumType   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"UnboxedSumType"

unboxedTupleOrSumExtension :: UnboxedTupleOrSum -> LangExt.Extension
unboxedTupleOrSumExtension :: UnboxedTupleOrSum -> Extension
unboxedTupleOrSumExtension UnboxedTupleOrSum
UnboxedTupleType = Extension
LangExt.UnboxedTuples
unboxedTupleOrSumExtension UnboxedTupleOrSum
UnboxedSumType   = Extension
LangExt.UnboxedSums

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

Note [OccInfo]
~~~~~~~~~~~~~
The OccInfo 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.

Note that `OneOcc` doesn't meant that it occurs /syntactially/ only once; it
means that it is /used/ only once. It might occur syntactically many times.
For example, in (case x of A -> y; B -> y; C -> True),
* `y` is used only once
* but it occurs syntactically twice

-}

-- | identifier Occurrence Information
data OccInfo -- See Note [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
$c== :: OccInfo -> OccInfo -> Bool
== :: OccInfo -> OccInfo -> Bool
$c/= :: OccInfo -> OccInfo -> Bool
/= :: 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 -> () -> ()
forall a b. a -> b -> b
`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
$c== :: InterestingCxt -> InterestingCxt -> Bool
== :: InterestingCxt -> InterestingCxt -> Bool
$c/= :: InterestingCxt -> InterestingCxt -> Bool
/= :: 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
$c== :: InsideLam -> InsideLam -> Bool
== :: InsideLam -> InsideLam -> Bool
$c/= :: InsideLam -> InsideLam -> Bool
/= :: 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 {-# UNPACK #-} !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
$c== :: TailCallInfo -> TailCallInfo -> Bool
== :: TailCallInfo -> TailCallInfo -> Bool
$c/= :: TailCallInfo -> TailCallInfo -> Bool
/= :: 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 = 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
forall doc. IsLine doc => [doc] -> doc
sep [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Tail", Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
ar ]
  ppr TailCallInfo
_                     = SDoc
forall doc. IsOutput doc => doc
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)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Many" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tails)
  ppr OccInfo
IAmDead              = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Dead"
  ppr (IAmALoopBreaker Bool
rule_only TailCallInfo
tails)
        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LoopBreaker" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_ro SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tails
        where
          pp_ro :: SDoc
pp_ro | Bool
rule_only = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'!'
                | Bool
otherwise = SDoc
forall doc. IsOutput doc => doc
empty
  ppr (OneOcc InsideLam
inside_lam Int
one_branch InterestingCxt
int_cxt TailCallInfo
tail_info)
        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Once" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> InsideLam -> SDoc
forall {doc}. IsLine doc => InsideLam -> doc
pp_lam InsideLam
inside_lam SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
one_branch SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> InterestingCxt -> SDoc
forall {doc}. IsLine doc => InterestingCxt -> doc
pp_args InterestingCxt
int_cxt SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_tail
        where
          pp_lam :: InsideLam -> doc
pp_lam InsideLam
IsInsideLam     = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'L'
          pp_lam InsideLam
NotInsideLam    = doc
forall doc. IsOutput doc => doc
empty
          pp_args :: InterestingCxt -> doc
pp_args InterestingCxt
IsInteresting  = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'!'
          pp_args InterestingCxt
NotInteresting = doc
forall doc. IsOutput doc => doc
empty
          pp_tail :: SDoc
pp_tail                = TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tail_info

pprShortTailCallInfo :: TailCallInfo -> SDoc
pprShortTailCallInfo :: TailCallInfo -> SDoc
pprShortTailCallInfo (AlwaysTailCalled Int
ar) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'T' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
ar)
pprShortTailCallInfo TailCallInfo
NoTailCallInfo        = SDoc
forall doc. IsOutput doc => doc
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.idJoinPointHood' 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
forall doc. IsLine doc => String -> doc
text String
"{- Has default method -}"
  ppr (GenericDM {}) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"{- Has generic default method -}"

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

data SuccessFlag = Succeeded | Failed

instance Semigroup SuccessFlag where
  SuccessFlag
Failed <> :: SuccessFlag -> SuccessFlag -> SuccessFlag
<> SuccessFlag
_ = SuccessFlag
Failed
  SuccessFlag
_ <> SuccessFlag
Failed = SuccessFlag
Failed
  SuccessFlag
_ <> SuccessFlag
_      = SuccessFlag
Succeeded


instance Outputable SuccessFlag where
    ppr :: SuccessFlag -> SDoc
ppr SuccessFlag
Succeeded = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Succeeded"
    ppr SuccessFlag
Failed    = String -> SDoc
forall doc. IsLine doc => String -> doc
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

{- *********************************************************************
*                                                                      *
                 UnfoldingSource
*                                                                      *
********************************************************************* -}

data UnfoldingSource
  = -- See also Note [Historical note: unfoldings for wrappers]
    VanillaSrc         -- The current rhs of the function
                       -- Replace uf_tmpl each time around

  -- See Note [Stable unfoldings] in GHC.Core
  | StableUserSrc   -- From a user-specified INLINE or INLINABLE pragma
  | StableSystemSrc -- From a wrapper, or system-generated unfolding

  | CompulsorySrc   -- Something that *has* no binding, so you *must* inline it
                    -- Only a few primop-like things have this property
                    -- (see "GHC.Types.Id.Make", calls to mkCompulsoryUnfolding).
                    -- Inline absolutely always, however boring the context.

isStableUserSource :: UnfoldingSource -> Bool
isStableUserSource :: UnfoldingSource -> Bool
isStableUserSource UnfoldingSource
StableUserSrc = Bool
True
isStableUserSource UnfoldingSource
_             = Bool
False

isStableSystemSource :: UnfoldingSource -> Bool
isStableSystemSource :: UnfoldingSource -> Bool
isStableSystemSource UnfoldingSource
StableSystemSrc = Bool
True
isStableSystemSource UnfoldingSource
_               = Bool
False

isCompulsorySource :: UnfoldingSource -> Bool
isCompulsorySource :: UnfoldingSource -> Bool
isCompulsorySource UnfoldingSource
CompulsorySrc = Bool
True
isCompulsorySource UnfoldingSource
_             = Bool
False

isStableSource :: UnfoldingSource -> Bool
isStableSource :: UnfoldingSource -> Bool
isStableSource UnfoldingSource
CompulsorySrc   = Bool
True
isStableSource UnfoldingSource
StableSystemSrc = Bool
True
isStableSource UnfoldingSource
StableUserSrc   = Bool
True
isStableSource UnfoldingSource
VanillaSrc      = Bool
False

instance Binary UnfoldingSource where
    put_ :: WriteBinHandle -> UnfoldingSource -> IO ()
put_ WriteBinHandle
bh UnfoldingSource
CompulsorySrc   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    put_ WriteBinHandle
bh UnfoldingSource
StableUserSrc   = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
    put_ WriteBinHandle
bh UnfoldingSource
StableSystemSrc = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
2
    put_ WriteBinHandle
bh UnfoldingSource
VanillaSrc      = WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
3
    get :: ReadBinHandle -> IO UnfoldingSource
get ReadBinHandle
bh = do
        h <- ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh
        case h of
            Word8
0 -> UnfoldingSource -> IO UnfoldingSource
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnfoldingSource
CompulsorySrc
            Word8
1 -> UnfoldingSource -> IO UnfoldingSource
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnfoldingSource
StableUserSrc
            Word8
2 -> UnfoldingSource -> IO UnfoldingSource
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnfoldingSource
StableSystemSrc
            Word8
_ -> UnfoldingSource -> IO UnfoldingSource
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UnfoldingSource
VanillaSrc

instance NFData UnfoldingSource where
  rnf :: UnfoldingSource -> ()
rnf = \case
    UnfoldingSource
CompulsorySrc -> ()
    UnfoldingSource
StableUserSrc -> ()
    UnfoldingSource
StableSystemSrc -> ()
    UnfoldingSource
VanillaSrc -> ()

instance Outputable UnfoldingSource where
  ppr :: UnfoldingSource -> SDoc
ppr UnfoldingSource
CompulsorySrc     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Compulsory"
  ppr UnfoldingSource
StableUserSrc     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StableUser"
  ppr UnfoldingSource
StableSystemSrc   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"StableSystem"
  ppr UnfoldingSource
VanillaSrc        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<vanilla>"

{-
************************************************************************
*                                                                      *
    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
$c== :: IntWithInf -> IntWithInf -> Bool
== :: IntWithInf -> IntWithInf -> Bool
$c/= :: IntWithInf -> IntWithInf -> Bool
/= :: 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
forall doc. IsLine doc => Char -> doc
char Char
'∞'
  ppr (Int Int
n)  = Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n

instance Num IntWithInf where
  + :: IntWithInf -> IntWithInf -> IntWithInf
(+) = IntWithInf -> IntWithInf -> IntWithInf
plusWithInf2
  * :: IntWithInf -> IntWithInf -> IntWithInf
(*) = IntWithInf -> IntWithInf -> IntWithInf
mulWithInf2

  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 -> 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. HasCallStack => 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
plusWithInf2 :: IntWithInf -> IntWithInf -> IntWithInf
plusWithInf2 :: IntWithInf -> IntWithInf -> IntWithInf
plusWithInf2 IntWithInf
Infinity IntWithInf
_        = IntWithInf
Infinity
plusWithInf2 IntWithInf
_        IntWithInf
Infinity = IntWithInf
Infinity
plusWithInf2 (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
mulWithInf2 :: IntWithInf -> IntWithInf -> IntWithInf
mulWithInf2 :: IntWithInf -> IntWithInf -> IntWithInf
mulWithInf2 IntWithInf
Infinity IntWithInf
_        = IntWithInf
Infinity
mulWithInf2 IntWithInf
_        IntWithInf
Infinity = IntWithInf
Infinity
mulWithInf2 (Int Int
a)  (Int Int
b)  = Int -> IntWithInf
Int (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b)

-- | Multiply an 'IntWithInfo` by an 'Int'
mulWithInf :: IntWithInf -> Int -> IntWithInf
mulWithInf :: IntWithInf -> Int -> IntWithInf
mulWithInf IntWithInf
Infinity Int
_ = IntWithInf
Infinity
mulWithInf (Int Int
a)  Int
b = Int -> IntWithInf
Int (Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
b)

-- | Subtract an 'Int' from an 'IntWithInf'
subWithInf :: IntWithInf -> Int -> IntWithInf
subWithInf :: IntWithInf -> Int -> IntWithInf
subWithInf IntWithInf
Infinity Int
_ = IntWithInf
Infinity
subWithInf (Int Int
a)  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 -> IntWithInf
Int

{- *********************************************************************
*                                                                      *
                        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
$c== :: TypeOrKind -> TypeOrKind -> Bool
== :: TypeOrKind -> TypeOrKind -> Bool
$c/= :: TypeOrKind -> TypeOrKind -> Bool
/= :: TypeOrKind -> TypeOrKind -> Bool
Eq

instance Outputable TypeOrKind where
  ppr :: TypeOrKind -> SDoc
ppr TypeOrKind
TypeLevel = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TypeLevel"
  ppr TypeOrKind
KindLevel = String -> SDoc
forall doc. IsLine doc => String -> doc
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

{- *********************************************************************
*                                                                      *
                 Levity and TypeOrConstraint
*                                                                      *
********************************************************************* -}

{- The types `Levity` and `TypeOrConstraint` are internal to GHC.
   They have the same shape as the eponymous types in the library
      ghc-prim:GHC.Types
   but they aren't the same types -- after all, they are defined in a
   different module.
-}

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

instance Outputable Levity where
  ppr :: Levity -> SDoc
ppr Levity
Lifted   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Lifted"
  ppr Levity
Unlifted = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Unlifted"

instance Binary Levity where
  put_ :: WriteBinHandle -> Levity -> IO ()
put_ WriteBinHandle
bh = \case
    Levity
Lifted   -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    Levity
Unlifted -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
  get :: ReadBinHandle -> IO Levity
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh IO Word8 -> (Word8 -> IO Levity) -> IO Levity
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> Levity -> IO Levity
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Levity
Lifted
    Word8
_ -> Levity -> IO Levity
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Levity
Unlifted

mightBeLifted :: Maybe Levity -> Bool
mightBeLifted :: Maybe Levity -> Bool
mightBeLifted (Just Levity
Unlifted) = Bool
False
mightBeLifted Maybe Levity
_               = Bool
True

mightBeUnlifted :: Maybe Levity -> Bool
mightBeUnlifted :: Maybe Levity -> Bool
mightBeUnlifted (Just Levity
Lifted) = Bool
False
mightBeUnlifted Maybe Levity
_             = Bool
True

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

instance Binary TypeOrConstraint where
  put_ :: WriteBinHandle -> TypeOrConstraint -> IO ()
put_ WriteBinHandle
bh = \case
    TypeOrConstraint
TypeLike -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
0
    TypeOrConstraint
ConstraintLike -> WriteBinHandle -> Word8 -> IO ()
putByte WriteBinHandle
bh Word8
1
  get :: ReadBinHandle -> IO TypeOrConstraint
get ReadBinHandle
bh = ReadBinHandle -> IO Word8
getByte ReadBinHandle
bh IO Word8 -> (Word8 -> IO TypeOrConstraint) -> IO TypeOrConstraint
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> TypeOrConstraint -> IO TypeOrConstraint
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeOrConstraint
TypeLike
    Word8
1 -> TypeOrConstraint -> IO TypeOrConstraint
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeOrConstraint
ConstraintLike
    Word8
_ -> String -> IO TypeOrConstraint
forall a. HasCallStack => String -> a
panic String
"TypeOrConstraint.get: invalid value"

instance NFData TypeOrConstraint where
  rnf :: TypeOrConstraint -> ()
rnf = \case
    TypeOrConstraint
TypeLike -> ()
    TypeOrConstraint
ConstraintLike -> ()

{- *********************************************************************
*                                                                      *
                          TyConFlavour
*                                                                      *
********************************************************************* -}

-- | Paints a picture of what a 'TyCon' represents, in broad strokes.
-- This is used towards more informative error messages.
data TyConFlavour tc
  = ClassFlavour
  | TupleFlavour Boxity
  | SumFlavour
  | DataTypeFlavour
  | NewtypeFlavour
  | AbstractTypeFlavour
  | OpenFamilyFlavour TypeOrData (Maybe tc) -- Just tc <=> (tc == associated class)
  | ClosedTypeFamilyFlavour
  | TypeSynonymFlavour
  | BuiltInTypeFlavour -- ^ e.g., the @(->)@ 'TyCon'.
  | PromotedDataConFlavour
  deriving (TyConFlavour tc -> TyConFlavour tc -> Bool
(TyConFlavour tc -> TyConFlavour tc -> Bool)
-> (TyConFlavour tc -> TyConFlavour tc -> Bool)
-> Eq (TyConFlavour tc)
forall tc. Eq tc => TyConFlavour tc -> TyConFlavour tc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tc. Eq tc => TyConFlavour tc -> TyConFlavour tc -> Bool
== :: TyConFlavour tc -> TyConFlavour tc -> Bool
$c/= :: forall tc. Eq tc => TyConFlavour tc -> TyConFlavour tc -> Bool
/= :: TyConFlavour tc -> TyConFlavour tc -> Bool
Eq, Typeable (TyConFlavour tc)
Typeable (TyConFlavour tc) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TyConFlavour tc -> c (TyConFlavour tc))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (TyConFlavour tc))
-> (TyConFlavour tc -> Constr)
-> (TyConFlavour tc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (TyConFlavour tc)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (TyConFlavour tc)))
-> ((forall b. Data b => b -> b)
    -> TyConFlavour tc -> TyConFlavour tc)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TyConFlavour tc -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TyConFlavour tc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TyConFlavour tc -> m (TyConFlavour tc))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TyConFlavour tc -> m (TyConFlavour tc))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TyConFlavour tc -> m (TyConFlavour tc))
-> Data (TyConFlavour tc)
TyConFlavour tc -> Constr
TyConFlavour tc -> DataType
(forall b. Data b => b -> b) -> TyConFlavour tc -> TyConFlavour tc
forall tc. Data tc => Typeable (TyConFlavour tc)
forall tc. Data tc => TyConFlavour tc -> Constr
forall tc. Data tc => TyConFlavour tc -> DataType
forall tc.
Data tc =>
(forall b. Data b => b -> b) -> TyConFlavour tc -> TyConFlavour tc
forall tc u.
Data tc =>
Int -> (forall d. Data d => d -> u) -> TyConFlavour tc -> u
forall tc u.
Data tc =>
(forall d. Data d => d -> u) -> TyConFlavour tc -> [u]
forall tc r r'.
Data tc =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
forall tc r r'.
Data tc =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
forall tc (m :: * -> *).
(Data tc, Monad m) =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
forall tc (m :: * -> *).
(Data tc, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
forall tc (c :: * -> *).
Data tc =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TyConFlavour tc)
forall tc (c :: * -> *).
Data tc =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TyConFlavour tc -> c (TyConFlavour tc)
forall tc (t :: * -> *) (c :: * -> *).
(Data tc, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TyConFlavour tc))
forall tc (t :: * -> * -> *) (c :: * -> *).
(Data tc, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TyConFlavour tc))
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) -> TyConFlavour tc -> u
forall u. (forall d. Data d => d -> u) -> TyConFlavour tc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TyConFlavour tc)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TyConFlavour tc -> c (TyConFlavour tc)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TyConFlavour tc))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TyConFlavour tc))
$cgfoldl :: forall tc (c :: * -> *).
Data tc =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TyConFlavour tc -> c (TyConFlavour tc)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TyConFlavour tc -> c (TyConFlavour tc)
$cgunfold :: forall tc (c :: * -> *).
Data tc =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TyConFlavour tc)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (TyConFlavour tc)
$ctoConstr :: forall tc. Data tc => TyConFlavour tc -> Constr
toConstr :: TyConFlavour tc -> Constr
$cdataTypeOf :: forall tc. Data tc => TyConFlavour tc -> DataType
dataTypeOf :: TyConFlavour tc -> DataType
$cdataCast1 :: forall tc (t :: * -> *) (c :: * -> *).
(Data tc, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (TyConFlavour tc))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (TyConFlavour tc))
$cdataCast2 :: forall tc (t :: * -> * -> *) (c :: * -> *).
(Data tc, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TyConFlavour tc))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (TyConFlavour tc))
$cgmapT :: forall tc.
Data tc =>
(forall b. Data b => b -> b) -> TyConFlavour tc -> TyConFlavour tc
gmapT :: (forall b. Data b => b -> b) -> TyConFlavour tc -> TyConFlavour tc
$cgmapQl :: forall tc r r'.
Data tc =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
$cgmapQr :: forall tc r r'.
Data tc =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TyConFlavour tc -> r
$cgmapQ :: forall tc u.
Data tc =>
(forall d. Data d => d -> u) -> TyConFlavour tc -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TyConFlavour tc -> [u]
$cgmapQi :: forall tc u.
Data tc =>
Int -> (forall d. Data d => d -> u) -> TyConFlavour tc -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TyConFlavour tc -> u
$cgmapM :: forall tc (m :: * -> *).
(Data tc, Monad m) =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
$cgmapMp :: forall tc (m :: * -> *).
(Data tc, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
$cgmapMo :: forall tc (m :: * -> *).
(Data tc, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TyConFlavour tc -> m (TyConFlavour tc)
Data, (forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b)
-> (forall a b. a -> TyConFlavour b -> TyConFlavour a)
-> Functor TyConFlavour
forall a b. a -> TyConFlavour b -> TyConFlavour a
forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b
fmap :: forall a b. (a -> b) -> TyConFlavour a -> TyConFlavour b
$c<$ :: forall a b. a -> TyConFlavour b -> TyConFlavour a
<$ :: forall a b. a -> TyConFlavour b -> TyConFlavour a
Functor)

instance Outputable (TyConFlavour tc) where
  ppr :: TyConFlavour tc -> SDoc
ppr = String -> SDoc
forall doc. IsLine doc => String -> doc
text (String -> SDoc)
-> (TyConFlavour tc -> String) -> TyConFlavour tc -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyConFlavour tc -> String
forall {a}. TyConFlavour a -> String
go
    where
      go :: TyConFlavour a -> String
go TyConFlavour a
ClassFlavour = String
"class"
      go (TupleFlavour Boxity
boxed) | Boxity -> Bool
isBoxed Boxity
boxed = String
"tuple"
                              | Bool
otherwise     = String
"unboxed tuple"
      go TyConFlavour a
SumFlavour              = String
"unboxed sum"
      go TyConFlavour a
DataTypeFlavour         = String
"data type"
      go TyConFlavour a
NewtypeFlavour          = String
"newtype"
      go TyConFlavour a
AbstractTypeFlavour     = String
"abstract type"
      go (OpenFamilyFlavour TypeOrData
type_or_data Maybe a
mb_par)
        = String
assoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t_or_d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" family"
        where
          assoc :: String
assoc = if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
mb_par then String
"associated " else String
""
          t_or_d :: String
t_or_d = case TypeOrData
type_or_data of
            TypeOrData
IAmType -> String
"type"
            IAmData NewOrData
new_or_data ->
              case NewOrData
new_or_data of
                NewOrData
DataType -> String
"data"
                NewOrData
NewType  -> String
"newtype"
      go TyConFlavour a
ClosedTypeFamilyFlavour = String
"type family"
      go TyConFlavour a
TypeSynonymFlavour      = String
"type synonym"
      go TyConFlavour a
BuiltInTypeFlavour      = String
"built-in type"
      go TyConFlavour a
PromotedDataConFlavour  = String
"promoted data constructor"


-- | Get the enclosing class TyCon (if there is one) for the given TyConFlavour
tyConFlavourAssoc_maybe :: TyConFlavour tc -> Maybe tc
tyConFlavourAssoc_maybe :: forall tc. TyConFlavour tc -> Maybe tc
tyConFlavourAssoc_maybe (OpenFamilyFlavour TypeOrData
_ Maybe tc
mb_parent) = Maybe tc
mb_parent
tyConFlavourAssoc_maybe TyConFlavour tc
_                               = Maybe tc
forall a. Maybe a
Nothing

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

-- | When we only care whether a data-type declaration is `data` or `newtype`,
-- but not what constructors it has.
data NewOrData
  = NewType                     -- ^ @newtype Blah ...@
  | DataType                    -- ^ @data Blah ...@
  deriving ( NewOrData -> NewOrData -> Bool
(NewOrData -> NewOrData -> Bool)
-> (NewOrData -> NewOrData -> Bool) -> Eq NewOrData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewOrData -> NewOrData -> Bool
== :: NewOrData -> NewOrData -> Bool
$c/= :: NewOrData -> NewOrData -> Bool
/= :: NewOrData -> NewOrData -> Bool
Eq, Typeable NewOrData
Typeable NewOrData =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> NewOrData -> c NewOrData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NewOrData)
-> (NewOrData -> Constr)
-> (NewOrData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NewOrData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewOrData))
-> ((forall b. Data b => b -> b) -> NewOrData -> NewOrData)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NewOrData -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NewOrData -> r)
-> (forall u. (forall d. Data d => d -> u) -> NewOrData -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NewOrData -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NewOrData -> m NewOrData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NewOrData -> m NewOrData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NewOrData -> m NewOrData)
-> Data NewOrData
NewOrData -> Constr
NewOrData -> DataType
(forall b. Data b => b -> b) -> NewOrData -> NewOrData
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) -> NewOrData -> u
forall u. (forall d. Data d => d -> u) -> NewOrData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewOrData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewOrData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewOrData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewOrData -> c NewOrData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewOrData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewOrData)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewOrData -> c NewOrData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewOrData -> c NewOrData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewOrData
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewOrData
$ctoConstr :: NewOrData -> Constr
toConstr :: NewOrData -> Constr
$cdataTypeOf :: NewOrData -> DataType
dataTypeOf :: NewOrData -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewOrData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewOrData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewOrData)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewOrData)
$cgmapT :: (forall b. Data b => b -> b) -> NewOrData -> NewOrData
gmapT :: (forall b. Data b => b -> b) -> NewOrData -> NewOrData
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewOrData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewOrData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewOrData -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewOrData -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NewOrData -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NewOrData -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NewOrData -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NewOrData -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewOrData -> m NewOrData
Data )                -- Needed because Demand derives Eq

instance Outputable TypeOrData where
  ppr :: TypeOrData -> SDoc
ppr (IAmData NewOrData
newOrData) = NewOrData -> SDoc
forall a. Outputable a => a -> SDoc
ppr NewOrData
newOrData
  ppr TypeOrData
IAmType = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"type"

instance Outputable NewOrData where
 ppr :: NewOrData -> SDoc
ppr = \case
    NewOrData
NewType  -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"newtype"
    NewOrData
DataType -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"data"

{- *********************************************************************
*                                                                      *
                        Defaulting options
*                                                                      *
********************************************************************* -}

{- Note [Type variable defaulting options]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Here is an overview of the current type variable defaulting mechanisms,
in the order in which they happen.

GHC.Tc.Utils.TcMType.defaultTyVar

  This is a built-in defaulting mechanism for the following type variables:

    (1) kind variables with -XNoPolyKinds,
    (2) type variables of kind 'RuntimeRep' default to 'LiftedRep',
        of kind 'Levity' to 'Lifted', and of kind 'Multiplicity' to 'Many'.

  It is used in many situations:

    - inferring a type (e.g. a declaration with no type signature or a
      partial type signature), in 'GHC.Tc.Solver.simplifyInfer',
    - simplifying top-level constraints in 'GHC.Tc.Solver.simplifyTop',
    - kind checking a CUSK in 'GHC.Tc.Gen.kcCheckDeclHeader_cusk',
    - 'GHC.Tc.TyCl.generaliseTcTyCon',
    - type checking type family and data family instances,
      in 'GHC.Tc.TyCl.tcTyFamInstEqnGuts' and 'GHC.Tc.TyCl.Instance.tcDataFamInstHeader'
      respectively,
    - type-checking rules in 'GHC.Tc.Gen.tcRule',
    - kind generalisation in 'GHC.Tc.Gen.HsType.kindGeneralizeSome'
      and 'GHC.Tc.Gen.HsType.kindGeneralizeAll'.

  Different situations call for a different defaulting strategy,
  so 'defaultTyVar' takes a strategy parameter which determines which
  type variables to default.
  Currently, this strategy is set as follows:

    - Kind variables:
      - with -XNoPolyKinds, these must be defaulted. This includes kind variables
        of kind 'RuntimeRep', 'Levity' and 'Multiplicity'.
        Test case: T20584.
      - with -XPolyKinds, behave as if they were type variables (see below).
    - Type variables of kind 'RuntimeRep', 'Levity' or 'Multiplicity'
      - in type and data families instances, these are not defaulted.
        Test case: T17536.
      - otherwise: default variables of these three kinds. This ensures
        that in a program such as

          foo :: forall a. a -> a
          foo x = x

        we continue to infer `a :: Type`.

  Note that the strategy is set in two steps: callers of 'defaultTyVars' only
  specify whether to default type variables of "non-standard" kinds
  (that is, of kinds 'RuntimeRep'/'Levity'/'Multiplicity'). Then 'defaultTyVars'
  determines which variables are type variables and which are kind variables,
  and if the user has asked for -XNoPolyKinds we default the kind variables.

GHC.Tc.Solver.defaultTyVarTcS

  This is a built-in defaulting mechanism that happens after
  the constraint solver has run, in 'GHC.Tc.Solver.simplifyTopWanteds'.

  It only defaults type (and kind) variables of kind 'RuntimeRep',
  'Levity', 'Multiplicity'.

  It is not configurable, neither by options nor by the user.

GHC.Tc.Solver.applyDefaultingRules

  This is typeclass defaulting, and includes defaulting plugins.
  It happens right after 'defaultTyVarTcS' in 'GHC.Tc.Solver.simplifyTopWanteds'.
  It is user configurable, using default declarations (/plugins).

GHC.Iface.Type.defaultIfaceTyVarsOfKind

  This is a built-in defaulting mechanism that only applies when pretty-printing.
  It defaults 'RuntimeRep'/'Levity' variables unless -fprint-explicit-runtime-reps is enabled,
  and 'Multiplicity' variables unless -XLinearTypes is enabled.

-}

-- | Specify whether to default type variables of kind 'RuntimeRep'/'Levity'/'Multiplicity'.
data NonStandardDefaultingStrategy
  -- | Default type variables of the given kinds:
  --
  --   - default 'RuntimeRep' variables to 'LiftedRep'
  --   - default 'Levity' variables to 'Lifted'
  --   - default 'Multiplicity' variables to 'Many'
  = DefaultNonStandardTyVars
  -- | Try not to default type variables of the kinds 'RuntimeRep'/'Levity'/'Multiplicity'.
  --
  -- Note that these might get defaulted anyway, if they are kind variables
  -- and `-XNoPolyKinds` is enabled.
  | TryNotToDefaultNonStandardTyVars

-- | Specify whether to default kind variables, and type variables
-- of kind 'RuntimeRep'/'Levity'/'Multiplicity'.
data DefaultingStrategy
  -- | Default kind variables:
  --
  --   - default kind variables of kind 'Type' to 'Type',
  --   - default 'RuntimeRep'/'Levity'/'Multiplicity' kind variables
  --     to 'LiftedRep'/'Lifted'/'Many', respectively.
  --
  -- When this strategy is used, it means that we have determined that
  -- the variables we are considering defaulting are all kind variables.
  --
  -- Usually, we pass this option when -XNoPolyKinds is enabled.
  = DefaultKindVars
  -- | Default (or don't default) non-standard variables, of kinds
  -- 'RuntimeRep', 'Levity' and 'Multiplicity'.
  | NonStandardDefaulting NonStandardDefaultingStrategy

defaultNonStandardTyVars :: DefaultingStrategy -> Bool
defaultNonStandardTyVars :: DefaultingStrategy -> Bool
defaultNonStandardTyVars DefaultingStrategy
DefaultKindVars                                          = Bool
True
defaultNonStandardTyVars (NonStandardDefaulting NonStandardDefaultingStrategy
DefaultNonStandardTyVars)         = Bool
True
defaultNonStandardTyVars (NonStandardDefaulting NonStandardDefaultingStrategy
TryNotToDefaultNonStandardTyVars) = Bool
False

instance Outputable NonStandardDefaultingStrategy where
  ppr :: NonStandardDefaultingStrategy -> SDoc
ppr NonStandardDefaultingStrategy
DefaultNonStandardTyVars         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DefaultOnlyNonStandardTyVars"
  ppr NonStandardDefaultingStrategy
TryNotToDefaultNonStandardTyVars = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"TryNotToDefaultNonStandardTyVars"

instance Outputable DefaultingStrategy where
  ppr :: DefaultingStrategy -> SDoc
ppr DefaultingStrategy
DefaultKindVars            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"DefaultKindVars"
  ppr (NonStandardDefaulting NonStandardDefaultingStrategy
ns) = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NonStandardDefaulting" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> NonStandardDefaultingStrategy -> SDoc
forall a. Outputable a => a -> SDoc
ppr NonStandardDefaultingStrategy
ns

-- | ImportLevel

data ImportLevel = NormalLevel | SpliceLevel | QuoteLevel deriving (ImportLevel -> ImportLevel -> Bool
(ImportLevel -> ImportLevel -> Bool)
-> (ImportLevel -> ImportLevel -> Bool) -> Eq ImportLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImportLevel -> ImportLevel -> Bool
== :: ImportLevel -> ImportLevel -> Bool
$c/= :: ImportLevel -> ImportLevel -> Bool
/= :: ImportLevel -> ImportLevel -> Bool
Eq, Eq ImportLevel
Eq ImportLevel =>
(ImportLevel -> ImportLevel -> Ordering)
-> (ImportLevel -> ImportLevel -> Bool)
-> (ImportLevel -> ImportLevel -> Bool)
-> (ImportLevel -> ImportLevel -> Bool)
-> (ImportLevel -> ImportLevel -> Bool)
-> (ImportLevel -> ImportLevel -> ImportLevel)
-> (ImportLevel -> ImportLevel -> ImportLevel)
-> Ord ImportLevel
ImportLevel -> ImportLevel -> Bool
ImportLevel -> ImportLevel -> Ordering
ImportLevel -> ImportLevel -> ImportLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ImportLevel -> ImportLevel -> Ordering
compare :: ImportLevel -> ImportLevel -> Ordering
$c< :: ImportLevel -> ImportLevel -> Bool
< :: ImportLevel -> ImportLevel -> Bool
$c<= :: ImportLevel -> ImportLevel -> Bool
<= :: ImportLevel -> ImportLevel -> Bool
$c> :: ImportLevel -> ImportLevel -> Bool
> :: ImportLevel -> ImportLevel -> Bool
$c>= :: ImportLevel -> ImportLevel -> Bool
>= :: ImportLevel -> ImportLevel -> Bool
$cmax :: ImportLevel -> ImportLevel -> ImportLevel
max :: ImportLevel -> ImportLevel -> ImportLevel
$cmin :: ImportLevel -> ImportLevel -> ImportLevel
min :: ImportLevel -> ImportLevel -> ImportLevel
Ord, Typeable ImportLevel
Typeable ImportLevel =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ImportLevel -> c ImportLevel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ImportLevel)
-> (ImportLevel -> Constr)
-> (ImportLevel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ImportLevel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ImportLevel))
-> ((forall b. Data b => b -> b) -> ImportLevel -> ImportLevel)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ImportLevel -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ImportLevel -> r)
-> (forall u. (forall d. Data d => d -> u) -> ImportLevel -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ImportLevel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel)
-> Data ImportLevel
ImportLevel -> Constr
ImportLevel -> DataType
(forall b. Data b => b -> b) -> ImportLevel -> ImportLevel
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) -> ImportLevel -> u
forall u. (forall d. Data d => d -> u) -> ImportLevel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportLevel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportLevel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImportLevel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportLevel -> c ImportLevel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImportLevel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImportLevel)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportLevel -> c ImportLevel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ImportLevel -> c ImportLevel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImportLevel
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ImportLevel
$ctoConstr :: ImportLevel -> Constr
toConstr :: ImportLevel -> Constr
$cdataTypeOf :: ImportLevel -> DataType
dataTypeOf :: ImportLevel -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImportLevel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ImportLevel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImportLevel)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ImportLevel)
$cgmapT :: (forall b. Data b => b -> b) -> ImportLevel -> ImportLevel
gmapT :: (forall b. Data b => b -> b) -> ImportLevel -> ImportLevel
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportLevel -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ImportLevel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportLevel -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ImportLevel -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ImportLevel -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ImportLevel -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImportLevel -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ImportLevel -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ImportLevel -> m ImportLevel
Data, Int -> ImportLevel -> String -> String
[ImportLevel] -> String -> String
ImportLevel -> String
(Int -> ImportLevel -> String -> String)
-> (ImportLevel -> String)
-> ([ImportLevel] -> String -> String)
-> Show ImportLevel
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ImportLevel -> String -> String
showsPrec :: Int -> ImportLevel -> String -> String
$cshow :: ImportLevel -> String
show :: ImportLevel -> String
$cshowList :: [ImportLevel] -> String -> String
showList :: [ImportLevel] -> String -> String
Show, Int -> ImportLevel
ImportLevel -> Int
ImportLevel -> [ImportLevel]
ImportLevel -> ImportLevel
ImportLevel -> ImportLevel -> [ImportLevel]
ImportLevel -> ImportLevel -> ImportLevel -> [ImportLevel]
(ImportLevel -> ImportLevel)
-> (ImportLevel -> ImportLevel)
-> (Int -> ImportLevel)
-> (ImportLevel -> Int)
-> (ImportLevel -> [ImportLevel])
-> (ImportLevel -> ImportLevel -> [ImportLevel])
-> (ImportLevel -> ImportLevel -> [ImportLevel])
-> (ImportLevel -> ImportLevel -> ImportLevel -> [ImportLevel])
-> Enum ImportLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ImportLevel -> ImportLevel
succ :: ImportLevel -> ImportLevel
$cpred :: ImportLevel -> ImportLevel
pred :: ImportLevel -> ImportLevel
$ctoEnum :: Int -> ImportLevel
toEnum :: Int -> ImportLevel
$cfromEnum :: ImportLevel -> Int
fromEnum :: ImportLevel -> Int
$cenumFrom :: ImportLevel -> [ImportLevel]
enumFrom :: ImportLevel -> [ImportLevel]
$cenumFromThen :: ImportLevel -> ImportLevel -> [ImportLevel]
enumFromThen :: ImportLevel -> ImportLevel -> [ImportLevel]
$cenumFromTo :: ImportLevel -> ImportLevel -> [ImportLevel]
enumFromTo :: ImportLevel -> ImportLevel -> [ImportLevel]
$cenumFromThenTo :: ImportLevel -> ImportLevel -> ImportLevel -> [ImportLevel]
enumFromThenTo :: ImportLevel -> ImportLevel -> ImportLevel -> [ImportLevel]
Enum, ImportLevel
ImportLevel -> ImportLevel -> Bounded ImportLevel
forall a. a -> a -> Bounded a
$cminBound :: ImportLevel
minBound :: ImportLevel
$cmaxBound :: ImportLevel
maxBound :: ImportLevel
Bounded)

instance Outputable ImportLevel where
  ppr :: ImportLevel -> SDoc
ppr ImportLevel
NormalLevel = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"normal"
  ppr ImportLevel
SpliceLevel = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"splice"
  ppr ImportLevel
QuoteLevel = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"quote"

deriving via (EnumBinary ImportLevel) instance Binary ImportLevel

allImportLevels :: [ImportLevel]
allImportLevels :: [ImportLevel]
allImportLevels = [ImportLevel
forall a. Bounded a => a
minBound..ImportLevel
forall a. Bounded a => a
maxBound]

convImportLevel :: ImportDeclLevelStyle -> ImportLevel
convImportLevel :: ImportDeclLevelStyle -> ImportLevel
convImportLevel (LevelStylePre ImportDeclLevel
level) = ImportDeclLevel -> ImportLevel
convImportLevelSpec ImportDeclLevel
level
convImportLevel (LevelStylePost ImportDeclLevel
level) = ImportDeclLevel -> ImportLevel
convImportLevelSpec ImportDeclLevel
level
convImportLevel ImportDeclLevelStyle
NotLevelled = ImportLevel
NormalLevel

convImportLevelSpec :: ImportDeclLevel -> ImportLevel
convImportLevelSpec :: ImportDeclLevel -> ImportLevel
convImportLevelSpec ImportDeclLevel
ImportDeclQuote = ImportLevel
QuoteLevel
convImportLevelSpec ImportDeclLevel
ImportDeclSplice = ImportLevel
SpliceLevel