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

\section[BasicTypes]{Miscellanous types}

This module defines a miscellaneously collection of very simple
types that

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

{-# LANGUAGE DeriveDataTypeable #-}

module BasicTypes(
        Version, bumpVersion, initialVersion,

        LeftOrRight(..),
        pickLR,

        ConTag, ConTagZ, fIRST_TAG,

        Arity, RepArity, JoinArity,

        Alignment,

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

        WarningTxt(..), pprWarningTxtForMsg, StringLiteral(..),

        Fixity(..), FixityDirection(..),
        defaultFixity, maxPrecedence, minPrecedence,
        negateFixity, funTyFixity,
        compareFixity,
        LexicalFixity(..),

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

        RuleName, pprRuleName,

        TopLevelFlag(..), isTopLevel, isNotTopLevel,

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

        Boxity(..), isBoxed,

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

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

        sumParens, pprAlternative,

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

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

        InsideLam, insideLam, notInsideLam,
        OneBranch, oneBranch, notOneBranch,
        InterestingCxt,
        TailCallInfo(..), tailCallInfo, zapOccTailCallInfo,
        isAlwaysTailCalled,

        EP(..),

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

        CompilerPhase(..), PhaseNum,

        Activation(..), isActive, isActiveIn, competesWith,
        isNeverActive, isAlwaysActive, isEarlyActive,
        activeAfterInitial, activeDuringFinal,

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

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

        IntegralLit(..), FractionalLit(..),
        negateIntegralLit, negateFractionalLit,
        mkIntegralLit, mkFractionalLit,
        integralFractionalLit,

        SourceText(..), pprWithSourceText,

        IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit,

        SpliceExplicitFlag(..)
   ) where

import GhcPrelude

import FastString
import Outputable
import SrcLoc ( Located,unLoc )
import Data.Data hiding (Fixity, Prefix, Infix)
import Data.Function (on)

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

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

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

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

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

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

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

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

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

-- | Constructor Tag
--
-- Type of the tags associated with each constructor possibility or superclass
-- selector
type ConTag = Int

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

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

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

type Alignment = Int -- align to next N-byte boundary (N must be a power of 2).

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

-- | 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.
data OneShotInfo
  = NoOneShotInfo -- ^ No information
  | OneShotLam    -- ^ The lambda is applied at most once.
  deriving (OneShotInfo -> OneShotInfo -> Bool
(OneShotInfo -> OneShotInfo -> Bool)
-> (OneShotInfo -> OneShotInfo -> Bool) -> Eq OneShotInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OneShotInfo -> OneShotInfo -> Bool
$c/= :: OneShotInfo -> OneShotInfo -> Bool
== :: OneShotInfo -> OneShotInfo -> Bool
$c== :: OneShotInfo -> OneShotInfo -> Bool
Eq)

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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


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

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

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

{-
************************************************************************
*                                                                      *
\subsection[Version]{Module and identifier version numbers}
*                                                                      *
************************************************************************
-}

type Version = Int

bumpVersion :: Version -> Version
bumpVersion :: Int -> Int
bumpVersion v :: Int
v = Int
vInt -> Int -> Int
forall a. Num a => a -> a -> a
+1

initialVersion :: Version
initialVersion :: Int
initialVersion = 1

{-
************************************************************************
*                                                                      *
                Deprecations
*                                                                      *
************************************************************************
-}

-- | A String Literal in the source, including its original raw format for use by
-- source to source manipulation tools.
data StringLiteral = StringLiteral
                       { StringLiteral -> SourceText
sl_st :: SourceText, -- literal raw source.
                                              -- See not [Literal source text]
                         StringLiteral -> FastString
sl_fs :: FastString  -- literal string value
                       } deriving Typeable StringLiteral
DataType
Constr
Typeable StringLiteral =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> StringLiteral -> c StringLiteral)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StringLiteral)
-> (StringLiteral -> Constr)
-> (StringLiteral -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StringLiteral))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c StringLiteral))
-> ((forall b. Data b => b -> b) -> StringLiteral -> StringLiteral)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StringLiteral -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StringLiteral -> r)
-> (forall u. (forall d. Data d => d -> u) -> StringLiteral -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StringLiteral -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral)
-> Data StringLiteral
StringLiteral -> DataType
StringLiteral -> Constr
(forall b. Data b => b -> b) -> StringLiteral -> StringLiteral
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StringLiteral -> c StringLiteral
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteral
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) -> StringLiteral -> u
forall u. (forall d. Data d => d -> u) -> StringLiteral -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteral
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StringLiteral -> c StringLiteral
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StringLiteral)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteral)
$cStringLiteral :: Constr
$tStringLiteral :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
gmapMp :: (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
gmapM :: (forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StringLiteral -> m StringLiteral
gmapQi :: Int -> (forall d. Data d => d -> u) -> StringLiteral -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StringLiteral -> u
gmapQ :: (forall d. Data d => d -> u) -> StringLiteral -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StringLiteral -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StringLiteral -> r
gmapT :: (forall b. Data b => b -> b) -> StringLiteral -> StringLiteral
$cgmapT :: (forall b. Data b => b -> b) -> StringLiteral -> StringLiteral
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteral)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c StringLiteral)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c StringLiteral)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StringLiteral)
dataTypeOf :: StringLiteral -> DataType
$cdataTypeOf :: StringLiteral -> DataType
toConstr :: StringLiteral -> Constr
$ctoConstr :: StringLiteral -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteral
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StringLiteral
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StringLiteral -> c StringLiteral
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StringLiteral -> c StringLiteral
$cp1Data :: Typeable StringLiteral
Data

instance Eq StringLiteral where
  (StringLiteral _ a :: FastString
a) == :: StringLiteral -> StringLiteral -> Bool
== (StringLiteral _ b :: FastString
b) = FastString
a FastString -> FastString -> Bool
forall a. Eq a => a -> a -> Bool
== FastString
b

instance Outputable StringLiteral where
  ppr :: StringLiteral -> SDoc
ppr sl :: StringLiteral
sl = SourceText -> SDoc -> SDoc
pprWithSourceText (StringLiteral -> SourceText
sl_st StringLiteral
sl) (FastString -> SDoc
ftext (FastString -> SDoc) -> FastString -> SDoc
forall a b. (a -> b) -> a -> b
$ StringLiteral -> FastString
sl_fs StringLiteral
sl)

-- | Warning Text
--
-- reason/explanation from a WARNING or DEPRECATED pragma
data WarningTxt = WarningTxt (Located SourceText)
                             [Located StringLiteral]
                | DeprecatedTxt (Located SourceText)
                                [Located StringLiteral]
    deriving (WarningTxt -> WarningTxt -> Bool
(WarningTxt -> WarningTxt -> Bool)
-> (WarningTxt -> WarningTxt -> Bool) -> Eq WarningTxt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WarningTxt -> WarningTxt -> Bool
$c/= :: WarningTxt -> WarningTxt -> Bool
== :: WarningTxt -> WarningTxt -> Bool
$c== :: WarningTxt -> WarningTxt -> Bool
Eq, Typeable WarningTxt
DataType
Constr
Typeable WarningTxt =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> WarningTxt -> c WarningTxt)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c WarningTxt)
-> (WarningTxt -> Constr)
-> (WarningTxt -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c WarningTxt))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c WarningTxt))
-> ((forall b. Data b => b -> b) -> WarningTxt -> WarningTxt)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> WarningTxt -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> WarningTxt -> r)
-> (forall u. (forall d. Data d => d -> u) -> WarningTxt -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> WarningTxt -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt)
-> Data WarningTxt
WarningTxt -> DataType
WarningTxt -> Constr
(forall b. Data b => b -> b) -> WarningTxt -> WarningTxt
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningTxt -> c WarningTxt
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningTxt
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) -> WarningTxt -> u
forall u. (forall d. Data d => d -> u) -> WarningTxt -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WarningTxt -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WarningTxt -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningTxt
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningTxt -> c WarningTxt
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WarningTxt)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WarningTxt)
$cDeprecatedTxt :: Constr
$cWarningTxt :: Constr
$tWarningTxt :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
gmapMp :: (forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
gmapM :: (forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> WarningTxt -> m WarningTxt
gmapQi :: Int -> (forall d. Data d => d -> u) -> WarningTxt -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> WarningTxt -> u
gmapQ :: (forall d. Data d => d -> u) -> WarningTxt -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> WarningTxt -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WarningTxt -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> WarningTxt -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WarningTxt -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> WarningTxt -> r
gmapT :: (forall b. Data b => b -> b) -> WarningTxt -> WarningTxt
$cgmapT :: (forall b. Data b => b -> b) -> WarningTxt -> WarningTxt
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WarningTxt)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c WarningTxt)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c WarningTxt)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c WarningTxt)
dataTypeOf :: WarningTxt -> DataType
$cdataTypeOf :: WarningTxt -> DataType
toConstr :: WarningTxt -> Constr
$ctoConstr :: WarningTxt -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningTxt
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c WarningTxt
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningTxt -> c WarningTxt
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> WarningTxt -> c WarningTxt
$cp1Data :: Typeable WarningTxt
Data)

instance Outputable WarningTxt where
    ppr :: WarningTxt -> SDoc
ppr (WarningTxt    lsrc :: Located SourceText
lsrc ws :: [Located StringLiteral]
ws)
      = case Located SourceText -> SrcSpanLess (Located SourceText)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located SourceText
lsrc of
          NoSourceText   -> [Located StringLiteral] -> SDoc
pp_ws [Located StringLiteral]
ws
          SourceText src -> String -> SDoc
text String
src SDoc -> SDoc -> SDoc
<+> [Located StringLiteral] -> SDoc
pp_ws [Located StringLiteral]
ws SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "#-}"

    ppr (DeprecatedTxt lsrc :: Located SourceText
lsrc  ds :: [Located StringLiteral]
ds)
      = case Located SourceText -> SrcSpanLess (Located SourceText)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located SourceText
lsrc of
          NoSourceText   -> [Located StringLiteral] -> SDoc
pp_ws [Located StringLiteral]
ds
          SourceText src -> String -> SDoc
text String
src SDoc -> SDoc -> SDoc
<+> [Located StringLiteral] -> SDoc
pp_ws [Located StringLiteral]
ds SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "#-}"

pp_ws :: [Located StringLiteral] -> SDoc
pp_ws :: [Located StringLiteral] -> SDoc
pp_ws [l :: Located StringLiteral
l] = StringLiteral -> SDoc
forall a. Outputable a => a -> SDoc
ppr (StringLiteral -> SDoc) -> StringLiteral -> SDoc
forall a b. (a -> b) -> a -> b
$ Located StringLiteral -> SrcSpanLess (Located StringLiteral)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located StringLiteral
l
pp_ws ws :: [Located StringLiteral]
ws
  = String -> SDoc
text "["
    SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
vcat (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((Located StringLiteral -> SDoc)
-> [Located StringLiteral] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (StringLiteral -> SDoc
forall a. Outputable a => a -> SDoc
ppr (StringLiteral -> SDoc)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located StringLiteral]
ws))
    SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "]"


pprWarningTxtForMsg :: WarningTxt -> SDoc
pprWarningTxtForMsg :: WarningTxt -> SDoc
pprWarningTxtForMsg (WarningTxt    _ ws :: [Located StringLiteral]
ws)
                     = SDoc -> SDoc
doubleQuotes ([SDoc] -> SDoc
vcat ((Located StringLiteral -> SDoc)
-> [Located StringLiteral] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> SDoc
ftext (FastString -> SDoc)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located StringLiteral]
ws))
pprWarningTxtForMsg (DeprecatedTxt _ ds :: [Located StringLiteral]
ds)
                     = String -> SDoc
text "Deprecated:" SDoc -> SDoc -> SDoc
<+>
                       SDoc -> SDoc
doubleQuotes ([SDoc] -> SDoc
vcat ((Located StringLiteral -> SDoc)
-> [Located StringLiteral] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString -> SDoc
ftext (FastString -> SDoc)
-> (Located StringLiteral -> FastString)
-> Located StringLiteral
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringLiteral -> FastString
sl_fs (StringLiteral -> FastString)
-> (Located StringLiteral -> StringLiteral)
-> Located StringLiteral
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located StringLiteral -> StringLiteral
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located StringLiteral]
ds))

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

type RuleName = FastString

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

{-
************************************************************************
*                                                                      *
\subsection[Fixity]{Fixity info}
*                                                                      *
************************************************************************
-}

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

instance Outputable Fixity where
    ppr :: Fixity -> SDoc
ppr (Fixity _ prec :: Int
prec dir :: FixityDirection
dir) = [SDoc] -> SDoc
hcat [FixityDirection -> SDoc
forall a. Outputable a => a -> SDoc
ppr FixityDirection
dir, SDoc
space, Int -> SDoc
int Int
prec]

instance Eq Fixity where -- Used to determine if two fixities conflict
  (Fixity _ p1 :: Int
p1 dir1 :: FixityDirection
dir1) == :: Fixity -> Fixity -> Bool
== (Fixity _ p2 :: Int
p2 dir2 :: FixityDirection
dir2) = Int
p1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
p2 Bool -> Bool -> Bool
&& FixityDirection
dir1 FixityDirection -> FixityDirection -> Bool
forall a. Eq a => a -> a -> Bool
== FixityDirection
dir2

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

instance Outputable FixityDirection where
    ppr :: FixityDirection -> SDoc
ppr InfixL = String -> SDoc
text "infixl"
    ppr InfixR = String -> SDoc
text "infixr"
    ppr InfixN = String -> SDoc
text "infix"

------------------------
maxPrecedence, minPrecedence :: Int
maxPrecedence :: Int
maxPrecedence = 9
minPrecedence :: Int
minPrecedence = 0

defaultFixity :: Fixity
defaultFixity :: Fixity
defaultFixity = SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText Int
maxPrecedence FixityDirection
InfixL

negateFixity, funTyFixity :: Fixity
-- Wired-in fixities
negateFixity :: Fixity
negateFixity = SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText 6 FixityDirection
InfixL  -- Fixity of unary negate
funTyFixity :: Fixity
funTyFixity  = SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText (-1) FixityDirection
InfixR  -- Fixity of '->', see #15235

{-
Consider

\begin{verbatim}
        a `op1` b `op2` c
\end{verbatim}
@(compareFixity op1 op2)@ tells which way to arrange application, or
whether there's an error.
-}

compareFixity :: Fixity -> Fixity
              -> (Bool,         -- Error please
                  Bool)         -- Associate to the right: a op1 (b op2 c)
compareFixity :: Fixity -> Fixity -> (Bool, Bool)
compareFixity (Fixity _ prec1 :: Int
prec1 dir1 :: FixityDirection
dir1) (Fixity _ prec2 :: Int
prec2 dir2 :: FixityDirection
dir2)
  = case Int
prec1 Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
prec2 of
        GT -> (Bool, Bool)
left
        LT -> (Bool, Bool)
right
        EQ -> case (FixityDirection
dir1, FixityDirection
dir2) of
                        (InfixR, InfixR) -> (Bool, Bool)
right
                        (InfixL, InfixL) -> (Bool, Bool)
left
                        _                -> (Bool, Bool)
error_please
  where
    right :: (Bool, Bool)
right        = (Bool
False, Bool
True)
    left :: (Bool, Bool)
left         = (Bool
False, Bool
False)
    error_please :: (Bool, Bool)
error_please = (Bool
True,  Bool
False)

-- |Captures the fixity of declarations as they are parsed. This is not
-- necessarily the same as the fixity declaration, as the normal fixity may be
-- overridden using parens or backticks.
data LexicalFixity = Prefix | Infix deriving (Typeable LexicalFixity
DataType
Constr
Typeable LexicalFixity =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> LexicalFixity -> c LexicalFixity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LexicalFixity)
-> (LexicalFixity -> Constr)
-> (LexicalFixity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LexicalFixity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LexicalFixity))
-> ((forall b. Data b => b -> b) -> LexicalFixity -> LexicalFixity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r)
-> (forall u. (forall d. Data d => d -> u) -> LexicalFixity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LexicalFixity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity)
-> Data LexicalFixity
LexicalFixity -> DataType
LexicalFixity -> Constr
(forall b. Data b => b -> b) -> LexicalFixity -> LexicalFixity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LexicalFixity -> c LexicalFixity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LexicalFixity
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) -> LexicalFixity -> u
forall u. (forall d. Data d => d -> u) -> LexicalFixity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LexicalFixity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LexicalFixity -> c LexicalFixity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LexicalFixity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LexicalFixity)
$cInfix :: Constr
$cPrefix :: Constr
$tLexicalFixity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
gmapMp :: (forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
gmapM :: (forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LexicalFixity -> m LexicalFixity
gmapQi :: Int -> (forall d. Data d => d -> u) -> LexicalFixity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LexicalFixity -> u
gmapQ :: (forall d. Data d => d -> u) -> LexicalFixity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LexicalFixity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LexicalFixity -> r
gmapT :: (forall b. Data b => b -> b) -> LexicalFixity -> LexicalFixity
$cgmapT :: (forall b. Data b => b -> b) -> LexicalFixity -> LexicalFixity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LexicalFixity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LexicalFixity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LexicalFixity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LexicalFixity)
dataTypeOf :: LexicalFixity -> DataType
$cdataTypeOf :: LexicalFixity -> DataType
toConstr :: LexicalFixity -> Constr
$ctoConstr :: LexicalFixity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LexicalFixity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LexicalFixity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LexicalFixity -> c LexicalFixity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LexicalFixity -> c LexicalFixity
$cp1Data :: Typeable LexicalFixity
Data,LexicalFixity -> LexicalFixity -> Bool
(LexicalFixity -> LexicalFixity -> Bool)
-> (LexicalFixity -> LexicalFixity -> Bool) -> Eq LexicalFixity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LexicalFixity -> LexicalFixity -> Bool
$c/= :: LexicalFixity -> LexicalFixity -> Bool
== :: LexicalFixity -> LexicalFixity -> Bool
$c== :: LexicalFixity -> LexicalFixity -> Bool
Eq)

instance Outputable LexicalFixity where
  ppr :: LexicalFixity -> SDoc
ppr Prefix = String -> SDoc
text "Prefix"
  ppr Infix  = String -> SDoc
text "Infix"

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

data TopLevelFlag
  = TopLevel
  | NotTopLevel

isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

data OverlapMode  -- See Note [Rules for instance lookup] in 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 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 InstEnv

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


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

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

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

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

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

topPrec, sigPrec, funPrec, opPrec, appPrec :: PprPrec
topPrec :: PprPrec
topPrec = Int -> PprPrec
PprPrec 0 -- No parens
sigPrec :: PprPrec
sigPrec = Int -> PprPrec
PprPrec 1 -- Explicit type signatures
funPrec :: PprPrec
funPrec = Int -> PprPrec
PprPrec 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 2 -- Infix operator
appPrec :: PprPrec
appPrec = Int -> PprPrec
PprPrec 3 -- Constructor args; no parens for atomic

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

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

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

We use this consistently for Type and HsType.

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

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

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

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

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

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

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

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

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

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

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

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

-- | 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 :: (a -> SDoc) -> a -> Int -> Int -> SDoc
pprAlternative pp :: a -> SDoc
pp x :: a
x alt :: Int
alt arity :: Int
arity =
    [SDoc] -> SDoc
fsep (Int -> SDoc -> [SDoc]
forall a. Int -> a -> [a]
replicate (Int
alt Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) SDoc
vbar [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [a -> SDoc
pp a
x] [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ Int -> SDoc -> [SDoc]
forall a. Int -> a -> [a]
replicate (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alt) SDoc
vbar)

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

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

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

And we should have

        to (from x) = x

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

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

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

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

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


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

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

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

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

  | OneOcc          { OccInfo -> Bool
occ_in_lam  :: !InsideLam
                    , OccInfo -> Bool
occ_one_br  :: !OneBranch
                    , OccInfo -> Bool
occ_int_cxt :: !InterestingCxt
                    , occ_tail    :: !TailCallInfo }
                        -- ^ Occurs exactly once (per branch), not inside a rule

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

  deriving (OccInfo -> OccInfo -> Bool
(OccInfo -> OccInfo -> Bool)
-> (OccInfo -> OccInfo -> Bool) -> Eq OccInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OccInfo -> OccInfo -> Bool
$c/= :: OccInfo -> OccInfo -> Bool
== :: OccInfo -> OccInfo -> Bool
$c== :: OccInfo -> OccInfo -> Bool
Eq)

type RulesOnly = Bool

{-
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 = $WManyOccs :: TailCallInfo -> OccInfo
ManyOccs { occ_tail :: TailCallInfo
occ_tail = TailCallInfo
NoTailCallInfo }

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

seqOccInfo :: OccInfo -> ()
seqOccInfo :: OccInfo -> ()
seqOccInfo occ :: OccInfo
occ = OccInfo
occ OccInfo -> () -> ()
forall a b. a -> b -> b
`seq` ()

-----------------
-- | Interesting Context
type InterestingCxt = Bool      -- True <=> Function: is applied
                                --          Data value: scrutinised by a case with
                                --                      at least one non-DEFAULT branch

-----------------
-- | Inside Lambda
type InsideLam = Bool   -- True <=> Occurs inside a non-linear lambda
                        -- Substituting a redex for this occurrence is
                        -- dangerous because it might duplicate work.
insideLam, notInsideLam :: InsideLam
insideLam :: Bool
insideLam    = Bool
True
notInsideLam :: Bool
notInsideLam = Bool
False

-----------------
type OneBranch = Bool   -- True <=> Occurs in only one case branch
                        --      so no code-duplication issue to worry about
oneBranch, notOneBranch :: OneBranch
oneBranch :: Bool
oneBranch    = Bool
True
notOneBranch :: Bool
notOneBranch = Bool
False

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

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

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

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

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

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

isWeakLoopBreaker :: OccInfo -> Bool
isWeakLoopBreaker :: OccInfo -> Bool
isWeakLoopBreaker (IAmALoopBreaker{}) = Bool
True
isWeakLoopBreaker _                   = 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 _                                            = Bool
False

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

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

zapFragileOcc :: OccInfo -> OccInfo
-- Keep only the most robust data: deadness, loop-breaker-hood
zapFragileOcc :: OccInfo -> OccInfo
zapFragileOcc (OneOcc {}) = OccInfo
noOccInfo
zapFragileOcc occ :: 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 tails :: TailCallInfo
tails)     = TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tails
  ppr IAmDead              = String -> SDoc
text "Dead"
  ppr (IAmALoopBreaker rule_only :: Bool
rule_only tails :: TailCallInfo
tails)
        = String -> SDoc
text "LoopBreaker" SDoc -> SDoc -> SDoc
<> SDoc
pp_ro SDoc -> SDoc -> SDoc
<> TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tails
        where
          pp_ro :: SDoc
pp_ro | Bool
rule_only = Char -> SDoc
char '!'
                | Bool
otherwise = SDoc
empty
  ppr (OneOcc inside_lam :: Bool
inside_lam one_branch :: Bool
one_branch int_cxt :: Bool
int_cxt tail_info :: TailCallInfo
tail_info)
        = String -> SDoc
text "Once" SDoc -> SDoc -> SDoc
<> SDoc
pp_lam SDoc -> SDoc -> SDoc
<> SDoc
pp_br SDoc -> SDoc -> SDoc
<> SDoc
pp_args SDoc -> SDoc -> SDoc
<> SDoc
pp_tail
        where
          pp_lam :: SDoc
pp_lam | Bool
inside_lam = Char -> SDoc
char 'L'
                 | Bool
otherwise  = SDoc
empty
          pp_br :: SDoc
pp_br  | Bool
one_branch = SDoc
empty
                 | Bool
otherwise  = Char -> SDoc
char '*'
          pp_args :: SDoc
pp_args | Bool
int_cxt   = Char -> SDoc
char '!'
                  | Bool
otherwise = SDoc
empty
          pp_tail :: SDoc
pp_tail             = TailCallInfo -> SDoc
pprShortTailCallInfo TailCallInfo
tail_info

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

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

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

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

Note that there is a 'TailCallInfo' on a 'ManyOccs' value. One might expect that
being tail-called would mean that the variable could only appear once per branch
(thus getting a `OneOcc { occ_one_br = True }` 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_one_br = True }`.

************************************************************************
*                                                                      *
                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 VanillaDM      = String -> SDoc
text "{- Has default method -}"
  ppr (GenericDM {}) = String -> SDoc
text "{- Has generic default method -}"

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

data SuccessFlag = Succeeded | Failed

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

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

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

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

{-
************************************************************************
*                                                                      *
\subsection{Source Text}
*                                                                      *
************************************************************************
Keeping Source Text for source to source conversions

Note [Pragma source text]
~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer does a case-insensitive match for pragmas, as well as
accepting both UK and US spelling variants.

So

  {-# SPECIALISE #-}
  {-# SPECIALIZE #-}
  {-# Specialize #-}

will all generate ITspec_prag token for the start of the pragma.

In order to be able to do source to source conversions, the original
source text for the token needs to be preserved, hence the
`SourceText` field.

So the lexer will then generate

  ITspec_prag "{ -# SPECIALISE"
  ITspec_prag "{ -# SPECIALIZE"
  ITspec_prag "{ -# Specialize"

for the cases above.
 [without the space between '{' and '-', otherwise this comment won't parse]


Note [Literal source text]
~~~~~~~~~~~~~~~~~~~~~~~~~~
The lexer/parser converts literals from their original source text
versions to an appropriate internal representation. This is a problem
for tools doing source to source conversions, so the original source
text is stored in literals where this can occur.

Motivating examples for HsLit

  HsChar          '\n'       == '\x20`
  HsCharPrim      '\x41`#    == `A`
  HsString        "\x20\x41" == " A"
  HsStringPrim    "\x20"#    == " "#
  HsInt           001        == 1
  HsIntPrim       002#       == 2#
  HsWordPrim      003##      == 3##
  HsInt64Prim     004##      == 4##
  HsWord64Prim    005##      == 5##
  HsInteger       006        == 6

For OverLitVal

  HsIntegral      003      == 0x003
  HsIsString      "\x41nd" == "And"
-}

 -- Note [Literal source text],[Pragma source text]
data SourceText = SourceText String
                | NoSourceText -- ^ For when code is generated, e.g. TH,
                               -- deriving. The pretty printer will then make
                               -- its own representation of the item.
                deriving (Typeable SourceText
DataType
Constr
Typeable SourceText =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> SourceText -> c SourceText)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceText)
-> (SourceText -> Constr)
-> (SourceText -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceText))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceText))
-> ((forall b. Data b => b -> b) -> SourceText -> SourceText)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceText -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceText -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourceText -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceText -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourceText -> m SourceText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceText -> m SourceText)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceText -> m SourceText)
-> Data SourceText
SourceText -> DataType
SourceText -> Constr
(forall b. Data b => b -> b) -> SourceText -> SourceText
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceText -> c SourceText
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceText
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) -> SourceText -> u
forall u. (forall d. Data d => d -> u) -> SourceText -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceText
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceText -> c SourceText
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceText)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceText)
$cNoSourceText :: Constr
$cSourceText :: Constr
$tSourceText :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SourceText -> m SourceText
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
gmapMp :: (forall d. Data d => d -> m d) -> SourceText -> m SourceText
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
gmapM :: (forall d. Data d => d -> m d) -> SourceText -> m SourceText
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceText -> m SourceText
gmapQi :: Int -> (forall d. Data d => d -> u) -> SourceText -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceText -> u
gmapQ :: (forall d. Data d => d -> u) -> SourceText -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceText -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceText -> r
gmapT :: (forall b. Data b => b -> b) -> SourceText -> SourceText
$cgmapT :: (forall b. Data b => b -> b) -> SourceText -> SourceText
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceText)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceText)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourceText)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceText)
dataTypeOf :: SourceText -> DataType
$cdataTypeOf :: SourceText -> DataType
toConstr :: SourceText -> Constr
$ctoConstr :: SourceText -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceText
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceText
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceText -> c SourceText
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceText -> c SourceText
$cp1Data :: Typeable SourceText
Data, Int -> SourceText -> ShowS
[SourceText] -> ShowS
SourceText -> String
(Int -> SourceText -> ShowS)
-> (SourceText -> String)
-> ([SourceText] -> ShowS)
-> Show SourceText
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceText] -> ShowS
$cshowList :: [SourceText] -> ShowS
show :: SourceText -> String
$cshow :: SourceText -> String
showsPrec :: Int -> SourceText -> ShowS
$cshowsPrec :: Int -> SourceText -> ShowS
Show, SourceText -> SourceText -> Bool
(SourceText -> SourceText -> Bool)
-> (SourceText -> SourceText -> Bool) -> Eq SourceText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceText -> SourceText -> Bool
$c/= :: SourceText -> SourceText -> Bool
== :: SourceText -> SourceText -> Bool
$c== :: SourceText -> SourceText -> Bool
Eq )

instance Outputable SourceText where
  ppr :: SourceText -> SDoc
ppr (SourceText s :: String
s) = String -> SDoc
text "SourceText" SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
s
  ppr NoSourceText   = String -> SDoc
text "NoSourceText"

-- | Special combinator for showing string literals.
pprWithSourceText :: SourceText -> SDoc -> SDoc
pprWithSourceText :: SourceText -> SDoc -> SDoc
pprWithSourceText NoSourceText     d :: SDoc
d = SDoc
d
pprWithSourceText (SourceText src :: String
src) _ = String -> SDoc
text String
src

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

When a rule or inlining is active
-}

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

data CompilerPhase
  = Phase PhaseNum
  | InitialPhase    -- The first phase -- number = infinity!

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

activeAfterInitial :: Activation
-- Active in the first phase after the initial phase
-- Currently we have just phases [2,1,0]
activeAfterInitial :: Activation
activeAfterInitial = SourceText -> Int -> Activation
ActiveAfter SourceText
NoSourceText 2

activeDuringFinal :: Activation
-- Active in the final simplification phase (which is repeated)
activeDuringFinal :: Activation
activeDuringFinal = SourceText -> Int -> Activation
ActiveAfter SourceText
NoSourceText 0

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

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

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

      , InlinePragma -> Maybe Int
inl_sat    :: Maybe Arity    -- Just n <=> Inline only when applied to n
                                     --            explicit (non-type, non-dictionary) args
                                     --   That is, inl_sat describes the number of *source-code*
                                     --   arguments the thing must be applied to.  We add on the
                                     --   number of implicit, dictionary arguments when making
                                     --   the Unfolding, and don't look at inl_sat further

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

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

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

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

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

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

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

If you want to know where InlinePragmas take effect: Look in DsBinds.makeCorePair

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

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

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

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

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

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

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

The main effects of CONLIKE are:

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

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

    - A CoreUnfolding has a field that caches exprIsExpandable

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance Outputable InlineSpec where
   ppr :: InlineSpec -> SDoc
ppr Inline       = String -> SDoc
text "INLINE"
   ppr NoInline     = String -> SDoc
text "NOINLINE"
   ppr Inlinable    = String -> SDoc
text "INLINABLE"
   ppr NoUserInline = String -> SDoc
text "NOUSERINLINE" -- what is better?

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

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

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

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

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

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

isActive :: CompilerPhase -> Activation -> Bool
isActive :: CompilerPhase -> Activation -> Bool
isActive InitialPhase AlwaysActive      = Bool
True
isActive InitialPhase (ActiveBefore {}) = Bool
True
isActive InitialPhase _                 = Bool
False
isActive (Phase p :: Int
p)    act :: Activation
act               = Int -> Activation -> Bool
isActiveIn Int
p Activation
act

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

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

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

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

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

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

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

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

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

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

-- | Integral Literal
--
-- Used (instead of Integer) to represent negative zegative zero which is
-- required for NegativeLiterals extension to correctly parse `-0::Double`
-- as negative zero. See also #13211.
data IntegralLit
  = IL { IntegralLit -> SourceText
il_text :: SourceText
       , IntegralLit -> Bool
il_neg :: Bool -- See Note [Negative zero]
       , IntegralLit -> Integer
il_value :: Integer
       }
  deriving (Typeable IntegralLit
DataType
Constr
Typeable IntegralLit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> IntegralLit -> c IntegralLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IntegralLit)
-> (IntegralLit -> Constr)
-> (IntegralLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c IntegralLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c IntegralLit))
-> ((forall b. Data b => b -> b) -> IntegralLit -> IntegralLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> IntegralLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> IntegralLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> IntegralLit -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IntegralLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit)
-> Data IntegralLit
IntegralLit -> DataType
IntegralLit -> Constr
(forall b. Data b => b -> b) -> IntegralLit -> IntegralLit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegralLit -> c IntegralLit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegralLit
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) -> IntegralLit -> u
forall u. (forall d. Data d => d -> u) -> IntegralLit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegralLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegralLit -> c IntegralLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IntegralLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IntegralLit)
$cIL :: Constr
$tIntegralLit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
gmapMp :: (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
gmapM :: (forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IntegralLit -> m IntegralLit
gmapQi :: Int -> (forall d. Data d => d -> u) -> IntegralLit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IntegralLit -> u
gmapQ :: (forall d. Data d => d -> u) -> IntegralLit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IntegralLit -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IntegralLit -> r
gmapT :: (forall b. Data b => b -> b) -> IntegralLit -> IntegralLit
$cgmapT :: (forall b. Data b => b -> b) -> IntegralLit -> IntegralLit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IntegralLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c IntegralLit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c IntegralLit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IntegralLit)
dataTypeOf :: IntegralLit -> DataType
$cdataTypeOf :: IntegralLit -> DataType
toConstr :: IntegralLit -> Constr
$ctoConstr :: IntegralLit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegralLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IntegralLit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegralLit -> c IntegralLit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntegralLit -> c IntegralLit
$cp1Data :: Typeable IntegralLit
Data, Int -> IntegralLit -> ShowS
[IntegralLit] -> ShowS
IntegralLit -> String
(Int -> IntegralLit -> ShowS)
-> (IntegralLit -> String)
-> ([IntegralLit] -> ShowS)
-> Show IntegralLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IntegralLit] -> ShowS
$cshowList :: [IntegralLit] -> ShowS
show :: IntegralLit -> String
$cshow :: IntegralLit -> String
showsPrec :: Int -> IntegralLit -> ShowS
$cshowsPrec :: Int -> IntegralLit -> ShowS
Show)

mkIntegralLit :: Integral a => a -> IntegralLit
mkIntegralLit :: a -> IntegralLit
mkIntegralLit i :: a
i = IL :: SourceText -> Bool -> Integer -> IntegralLit
IL { il_text :: SourceText
il_text = String -> SourceText
SourceText (Integer -> String
forall a. Show a => a -> String
show Integer
i_integer)
                     , il_neg :: Bool
il_neg = a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0
                     , il_value :: Integer
il_value = Integer
i_integer }
  where
    i_integer :: Integer
    i_integer :: Integer
i_integer = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
i

negateIntegralLit :: IntegralLit -> IntegralLit
negateIntegralLit :: IntegralLit -> IntegralLit
negateIntegralLit (IL text :: SourceText
text neg :: Bool
neg value :: Integer
value)
  = case SourceText
text of
      SourceText ('-':src :: String
src) -> SourceText -> Bool -> Integer -> IntegralLit
IL (String -> SourceText
SourceText String
src)       Bool
False    (Integer -> Integer
forall a. Num a => a -> a
negate Integer
value)
      SourceText      src :: String
src  -> SourceText -> Bool -> Integer -> IntegralLit
IL (String -> SourceText
SourceText ('-'Char -> ShowS
forall a. a -> [a] -> [a]
:String
src)) Bool
True     (Integer -> Integer
forall a. Num a => a -> a
negate Integer
value)
      NoSourceText         -> SourceText -> Bool -> Integer -> IntegralLit
IL SourceText
NoSourceText          (Bool -> Bool
not Bool
neg) (Integer -> Integer
forall a. Num a => a -> a
negate Integer
value)

-- | Fractional Literal
--
-- Used (instead of Rational) to represent exactly the floating point literal that we
-- encountered in the user's source program. This allows us to pretty-print exactly what
-- the user wrote, which is important e.g. for floating point numbers that can't represented
-- as Doubles (we used to via Double for pretty-printing). See also #2245.
data FractionalLit
  = FL { FractionalLit -> SourceText
fl_text :: SourceText     -- How the value was written in the source
       , FractionalLit -> Bool
fl_neg :: Bool            -- See Note [Negative zero]
       , FractionalLit -> Rational
fl_value :: Rational      -- Numeric value of the literal
       }
  deriving (Typeable FractionalLit
DataType
Constr
Typeable FractionalLit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FractionalLit -> c FractionalLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FractionalLit)
-> (FractionalLit -> Constr)
-> (FractionalLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FractionalLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FractionalLit))
-> ((forall b. Data b => b -> b) -> FractionalLit -> FractionalLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FractionalLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FractionalLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> FractionalLit -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FractionalLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit)
-> Data FractionalLit
FractionalLit -> DataType
FractionalLit -> Constr
(forall b. Data b => b -> b) -> FractionalLit -> FractionalLit
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FractionalLit -> c FractionalLit
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalLit
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) -> FractionalLit -> u
forall u. (forall d. Data d => d -> u) -> FractionalLit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FractionalLit -> c FractionalLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalLit)
$cFL :: Constr
$tFractionalLit :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
gmapMp :: (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
gmapM :: (forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FractionalLit -> m FractionalLit
gmapQi :: Int -> (forall d. Data d => d -> u) -> FractionalLit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FractionalLit -> u
gmapQ :: (forall d. Data d => d -> u) -> FractionalLit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FractionalLit -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FractionalLit -> r
gmapT :: (forall b. Data b => b -> b) -> FractionalLit -> FractionalLit
$cgmapT :: (forall b. Data b => b -> b) -> FractionalLit -> FractionalLit
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FractionalLit)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c FractionalLit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FractionalLit)
dataTypeOf :: FractionalLit -> DataType
$cdataTypeOf :: FractionalLit -> DataType
toConstr :: FractionalLit -> Constr
$ctoConstr :: FractionalLit -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FractionalLit
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FractionalLit -> c FractionalLit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FractionalLit -> c FractionalLit
$cp1Data :: Typeable FractionalLit
Data, Int -> FractionalLit -> ShowS
[FractionalLit] -> ShowS
FractionalLit -> String
(Int -> FractionalLit -> ShowS)
-> (FractionalLit -> String)
-> ([FractionalLit] -> ShowS)
-> Show FractionalLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FractionalLit] -> ShowS
$cshowList :: [FractionalLit] -> ShowS
show :: FractionalLit -> String
$cshow :: FractionalLit -> String
showsPrec :: Int -> FractionalLit -> ShowS
$cshowsPrec :: Int -> FractionalLit -> ShowS
Show)
  -- The Show instance is required for the derived Lexer.x:Token instance when DEBUG is on

mkFractionalLit :: Real a => a -> FractionalLit
mkFractionalLit :: a -> FractionalLit
mkFractionalLit r :: a
r = FL :: SourceText -> Bool -> Rational -> FractionalLit
FL { fl_text :: SourceText
fl_text = String -> SourceText
SourceText (Double -> String
forall a. Show a => a -> String
show (a -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
r::Double))
                           -- Converting to a Double here may technically lose
                           -- precision (see #15502). We could alternatively
                           -- convert to a Rational for the most accuracy, but
                           -- it would cause Floats and Doubles to be displayed
                           -- strangely, so we opt not to do this. (In contrast
                           -- to mkIntegralLit, where we always convert to an
                           -- Integer for the highest accuracy.)
                       , fl_neg :: Bool
fl_neg = a
r a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< 0
                       , fl_value :: Rational
fl_value = a -> Rational
forall a. Real a => a -> Rational
toRational a
r }

negateFractionalLit :: FractionalLit -> FractionalLit
negateFractionalLit :: FractionalLit -> FractionalLit
negateFractionalLit (FL text :: SourceText
text neg :: Bool
neg value :: Rational
value)
  = case SourceText
text of
      SourceText ('-':src :: String
src) -> SourceText -> Bool -> Rational -> FractionalLit
FL (String -> SourceText
SourceText String
src)     Bool
False Rational
value
      SourceText      src :: String
src  -> SourceText -> Bool -> Rational -> FractionalLit
FL (String -> SourceText
SourceText ('-'Char -> ShowS
forall a. a -> [a] -> [a]
:String
src)) Bool
True  Rational
value
      NoSourceText         -> SourceText -> Bool -> Rational -> FractionalLit
FL SourceText
NoSourceText (Bool -> Bool
not Bool
neg) (Rational -> Rational
forall a. Num a => a -> a
negate Rational
value)

integralFractionalLit :: Bool -> Integer -> FractionalLit
integralFractionalLit :: Bool -> Integer -> FractionalLit
integralFractionalLit neg :: Bool
neg i :: Integer
i = FL :: SourceText -> Bool -> Rational -> FractionalLit
FL { fl_text :: SourceText
fl_text = String -> SourceText
SourceText (Integer -> String
forall a. Show a => a -> String
show Integer
i),
                                   fl_neg :: Bool
fl_neg = Bool
neg,
                                   fl_value :: Rational
fl_value = Integer -> Rational
forall a. Num a => Integer -> a
fromInteger Integer
i }

-- Comparison operations are needed when grouping literals
-- for compiling pattern-matching (module MatchLit)

instance Eq IntegralLit where
  == :: IntegralLit -> IntegralLit -> Bool
(==) = Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Integer -> Integer -> Bool)
-> (IntegralLit -> Integer) -> IntegralLit -> IntegralLit -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IntegralLit -> Integer
il_value

instance Ord IntegralLit where
  compare :: IntegralLit -> IntegralLit -> Ordering
compare = Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Integer -> Integer -> Ordering)
-> (IntegralLit -> Integer)
-> IntegralLit
-> IntegralLit
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` IntegralLit -> Integer
il_value

instance Outputable IntegralLit where
  ppr :: IntegralLit -> SDoc
ppr (IL (SourceText src :: String
src) _ _) = String -> SDoc
text String
src
  ppr (IL NoSourceText _ value :: Integer
value) = String -> SDoc
text (Integer -> String
forall a. Show a => a -> String
show Integer
value)

instance Eq FractionalLit where
  == :: FractionalLit -> FractionalLit -> Bool
(==) = Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Rational -> Rational -> Bool)
-> (FractionalLit -> Rational)
-> FractionalLit
-> FractionalLit
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FractionalLit -> Rational
fl_value

instance Ord FractionalLit where
  compare :: FractionalLit -> FractionalLit -> Ordering
compare = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Rational -> Rational -> Ordering)
-> (FractionalLit -> Rational)
-> FractionalLit
-> FractionalLit
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FractionalLit -> Rational
fl_value

instance Outputable FractionalLit where
  ppr :: FractionalLit -> SDoc
ppr f :: FractionalLit
f = SourceText -> SDoc -> SDoc
pprWithSourceText (FractionalLit -> SourceText
fl_text FractionalLit
f) (Rational -> SDoc
rational (FractionalLit -> Rational
fl_value FractionalLit
f))

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

Represents an integer or positive infinity

-}

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

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

instance Ord IntWithInf where
  compare :: IntWithInf -> IntWithInf -> Ordering
compare Infinity Infinity = Ordering
EQ
  compare (Int _)  Infinity = Ordering
LT
  compare Infinity (Int _)  = Ordering
GT
  compare (Int a :: Int
a)  (Int b :: 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 Infinity = Char -> SDoc
char '∞'
  ppr (Int n :: Int
n)  = Int -> SDoc
int Int
n

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

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

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

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

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

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

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

-- | Multiply two 'IntWithInf's
mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
mulWithInf :: IntWithInf -> IntWithInf -> IntWithInf
mulWithInf Infinity _        = IntWithInf
Infinity
mulWithInf _        Infinity = IntWithInf
Infinity
mulWithInf (Int a :: Int
a)  (Int b :: 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 0 = IntWithInf
Infinity
treatZeroAsInf n :: Int
n = Int -> IntWithInf
Int Int
n

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

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