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


This module defines interface types and binders
-}


{-# LANGUAGE FlexibleInstances #-}
  -- FlexibleInstances for Binary (DefMethSpec IfaceType)
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}

module GHC.Iface.Type (
        IfExtName, IfLclName,

        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
        IfaceMCoercion(..),
        IfaceUnivCoProv(..),
        IfaceMult,
        IfaceTyCon(..),
        IfaceTyConInfo(..), mkIfaceTyConInfo,
        IfaceTyConSort(..),
        IfaceTyLit(..), IfaceAppArgs(..),
        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
        IfaceForAllSpecBndr,
        IfaceForAllBndr, ForAllTyFlag(..), FunTyFlag(..), ShowForAllFlag(..),
        mkIfaceForAllTvBndr,
        mkIfaceTyConKind,
        ifaceForAllSpecToBndrs, ifaceForAllSpecToBndr,

        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
        ifTyConBinderVar, ifTyConBinderName,

        -- Equality testing
        isIfaceLiftedTypeKind,

        -- Conversion from IfaceAppArgs to IfaceTypes/ForAllTyFlags
        appArgsIfaceTypes, appArgsIfaceTypesForAllTyFlags,

        -- Printing
        SuppressBndrSig(..),
        UseBndrParens(..),
        PrintExplicitKinds(..),
        pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
        pprIfaceContext, pprIfaceContextArr,
        pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
        pprIfaceBndrs, pprIfaceAppArgs, pprParendIfaceAppArgs,
        pprIfaceForAllPart, pprIfaceForAllPartMust, pprIfaceForAll,
        pprIfaceSigmaType, pprIfaceTyLit,
        pprIfaceCoercion, pprParendIfaceCoercion,
        splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
        pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
        isIfaceRhoType,

        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,

        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst,

        many_ty, pprTypeArrow
    ) where

import GHC.Prelude

import {-# SOURCE #-} GHC.Builtin.Types
                                 ( coercibleTyCon, heqTyCon
                                 , constraintKindTyConName
                                 , tupleTyConName
                                 , tupleDataConName
                                 , manyDataConTyCon
                                 , liftedRepTyCon, liftedDataConTyCon )
import GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy, isLevityTy, funTyFlagTyCon )
import GHC.Core.TyCo.Rep( CoSel )
import GHC.Core.TyCo.Compare( eqForAllVis )
import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
import GHC.Types.Var
import GHC.Builtin.Names
import {-# SOURCE #-} GHC.Builtin.Types ( liftedTypeKindTyConName )
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Utils.Panic
import {-# SOURCE #-} GHC.Tc.Utils.TcType ( isMetaTyVar, isTyConableTyVar )

import Data.Maybe( isJust )
import qualified Data.Semigroup as Semi
import Control.DeepSeq

{-
************************************************************************
*                                                                      *
                Local (nested) binders
*                                                                      *
************************************************************************
-}

type IfLclName = FastString     -- A local name in iface syntax

type IfExtName = Name   -- An External or WiredIn Name can appear in Iface syntax
                        -- (However Internal or System Names never should)

data IfaceBndr          -- Local (non-top-level) binders
  = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr
  | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr

type IfaceIdBndr  = (IfaceType, IfLclName, IfaceType)
type IfaceTvBndr  = (IfLclName, IfaceKind)

ifaceTvBndrName :: IfaceTvBndr -> IfLclName
ifaceTvBndrName :: IfaceTvBndr -> FastString
ifaceTvBndrName (FastString
n,IfacePredType
_) = FastString
n

ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName :: IfaceIdBndr -> FastString
ifaceIdBndrName (IfacePredType
_,FastString
n,IfacePredType
_) = FastString
n

ifaceBndrName :: IfaceBndr -> IfLclName
ifaceBndrName :: IfaceBndr -> FastString
ifaceBndrName (IfaceTvBndr IfaceTvBndr
bndr) = IfaceTvBndr -> FastString
ifaceTvBndrName IfaceTvBndr
bndr
ifaceBndrName (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> FastString
ifaceIdBndrName IfaceIdBndr
bndr

ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType :: IfaceBndr -> IfacePredType
ifaceBndrType (IfaceIdBndr (IfacePredType
_, FastString
_, IfacePredType
t)) = IfacePredType
t
ifaceBndrType (IfaceTvBndr (FastString
_, IfacePredType
t)) = IfacePredType
t

type IfaceLamBndr = (IfaceBndr, IfaceOneShot)

data IfaceOneShot    -- See Note [Preserve OneShotInfo] in "GHC.Core.Tidy"
  = IfaceNoOneShot   -- and Note [The oneShot function] in "GHC.Types.Id.Make"
  | IfaceOneShot

instance Outputable IfaceOneShot where
  ppr :: IfaceOneShot -> SDoc
ppr IfaceOneShot
IfaceNoOneShot = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"NoOneShotInfo"
  ppr IfaceOneShot
IfaceOneShot = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"OneShot"

{-
%************************************************************************
%*                                                                      *
                IfaceType
%*                                                                      *
%************************************************************************
-}

-------------------------------
type IfaceKind     = IfaceType

-- | A kind of universal type, used for types and kinds.
--
-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'
-- before being printed. See Note [Pretty printing via Iface syntax] in "GHC.Types.TyThing.Ppr"
data IfaceType
  = IfaceFreeTyVar TyVar                -- See Note [Free tyvars in IfaceType]
  | IfaceTyVar     IfLclName            -- Type/coercion variable only, not tycon
  | IfaceLitTy     IfaceTyLit
  | IfaceAppTy     IfaceType IfaceAppArgs
                             -- See Note [Suppressing invisible arguments] for
                             -- an explanation of why the second field isn't
                             -- IfaceType, analogous to AppTy.
  | IfaceFunTy     FunTyFlag IfaceMult IfaceType IfaceType
  | IfaceForAllTy  IfaceForAllBndr IfaceType
  | IfaceTyConApp  IfaceTyCon IfaceAppArgs  -- Not necessarily saturated
                                            -- Includes newtypes, synonyms, tuples
  | IfaceCastTy     IfaceType IfaceCoercion
  | IfaceCoercionTy IfaceCoercion

  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
       TupleSort                  -- What sort of tuple?
       PromotionFlag                 -- A bit like IfaceTyCon
       IfaceAppArgs               -- arity = length args
          -- For promoted data cons, the kind args are omitted
          -- Why have this? Only for efficiency: IfaceTupleTy can omit the
          -- type arguments, as they can be recreated when deserializing.
          -- In an experiment, removing IfaceTupleTy resulted in a 0.75% regression
          -- in interface file size (in GHC's boot libraries).
          -- See !3987.

type IfaceMult = IfaceType

type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]

data IfaceTyLit
  = IfaceNumTyLit Integer
  | IfaceStrTyLit FastString
  | IfaceCharTyLit Char
  deriving (IfaceTyLit -> IfaceTyLit -> Bool
(IfaceTyLit -> IfaceTyLit -> Bool)
-> (IfaceTyLit -> IfaceTyLit -> Bool) -> Eq IfaceTyLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyLit -> IfaceTyLit -> Bool
== :: IfaceTyLit -> IfaceTyLit -> Bool
$c/= :: IfaceTyLit -> IfaceTyLit -> Bool
/= :: IfaceTyLit -> IfaceTyLit -> Bool
Eq)

type IfaceTyConBinder    = VarBndr IfaceBndr TyConBndrVis
type IfaceForAllBndr     = VarBndr IfaceBndr ForAllTyFlag
type IfaceForAllSpecBndr = VarBndr IfaceBndr Specificity

-- | Make an 'IfaceForAllBndr' from an 'IfaceTvBndr'.
mkIfaceForAllTvBndr :: ForAllTyFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr :: ForAllTyFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr ForAllTyFlag
vis IfaceTvBndr
var = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr IfaceTvBndr
var) ForAllTyFlag
vis

-- | Build the 'tyConKind' from the binders and the result kind.
-- Keep in sync with 'mkTyConKind' in "GHC.Core.TyCon".
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfacePredType -> IfacePredType
mkIfaceTyConKind [IfaceTyConBinder]
bndrs IfacePredType
res_kind = (IfaceTyConBinder -> IfacePredType -> IfacePredType)
-> IfacePredType -> [IfaceTyConBinder] -> IfacePredType
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IfaceTyConBinder -> IfacePredType -> IfacePredType
mk IfacePredType
res_kind [IfaceTyConBinder]
bndrs
  where
    mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
    mk :: IfaceTyConBinder -> IfacePredType -> IfacePredType
mk (Bndr IfaceBndr
tv (AnonTCB FunTyFlag
af))   IfacePredType
k = FunTyFlag
-> IfacePredType -> IfacePredType -> IfacePredType -> IfacePredType
IfaceFunTy FunTyFlag
af IfacePredType
many_ty (IfaceBndr -> IfacePredType
ifaceBndrType IfaceBndr
tv) IfacePredType
k
    mk (Bndr IfaceBndr
tv (NamedTCB ForAllTyFlag
vis)) IfacePredType
k = IfaceForAllBndr -> IfacePredType -> IfacePredType
IfaceForAllTy (IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv ForAllTyFlag
vis) IfacePredType
k

ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs :: [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
ifaceForAllSpecToBndrs = (IfaceForAllSpecBndr -> IfaceForAllBndr)
-> [IfaceForAllSpecBndr] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr

ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr :: IfaceForAllSpecBndr -> IfaceForAllBndr
ifaceForAllSpecToBndr (Bndr IfaceBndr
tv Specificity
spec) = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv (Specificity -> ForAllTyFlag
Invisible Specificity
spec)

-- | Stores the arguments in a type application as a list.
-- See @Note [Suppressing invisible arguments]@.
data IfaceAppArgs
  = IA_Nil
  | IA_Arg IfaceType    -- The type argument

           ForAllTyFlag      -- The argument's visibility. We store this here so
                        -- that we can:
                        --
                        -- 1. Avoid pretty-printing invisible (i.e., specified
                        --    or inferred) arguments when
                        --    -fprint-explicit-kinds isn't enabled, or
                        -- 2. When -fprint-explicit-kinds *is*, enabled, print
                        --    specified arguments in @(...) and inferred
                        --    arguments in @{...}.

           IfaceAppArgs -- The rest of the arguments

instance Semi.Semigroup IfaceAppArgs where
  IfaceAppArgs
IA_Nil <> :: IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
<> IfaceAppArgs
xs              = IfaceAppArgs
xs
  IA_Arg IfacePredType
ty ForAllTyFlag
argf IfaceAppArgs
rest <> IfaceAppArgs
xs = IfacePredType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfacePredType
ty ForAllTyFlag
argf (IfaceAppArgs
rest IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Semigroup a => a -> a -> a
Semi.<> IfaceAppArgs
xs)

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

-- Encodes type constructors, kind constructors,
-- coercion constructors, the lot.
-- We have to tag them in order to pretty print them
-- properly.
data IfaceTyCon = IfaceTyCon { IfaceTyCon -> IfExtName
ifaceTyConName :: IfExtName
                             , IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo :: IfaceTyConInfo }
    deriving (IfaceTyCon -> IfaceTyCon -> Bool
(IfaceTyCon -> IfaceTyCon -> Bool)
-> (IfaceTyCon -> IfaceTyCon -> Bool) -> Eq IfaceTyCon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyCon -> IfaceTyCon -> Bool
== :: IfaceTyCon -> IfaceTyCon -> Bool
$c/= :: IfaceTyCon -> IfaceTyCon -> Bool
/= :: IfaceTyCon -> IfaceTyCon -> Bool
Eq)

-- | The various types of TyCons which have special, built-in syntax.
data IfaceTyConSort = IfaceNormalTyCon          -- ^ a regular tycon

                    | IfaceTupleTyCon !Arity !TupleSort
                      -- ^ a tuple, e.g. @(a, b, c)@ or @(#a, b, c#)@.
                      -- The arity is the tuple width, not the tycon arity
                      -- (which is twice the width in the case of unboxed
                      -- tuples).

                    | IfaceSumTyCon !Arity
                      -- ^ an unboxed sum, e.g. @(# a | b | c #)@

                    | IfaceEqualityTyCon
                      -- ^ A heterogeneous equality TyCon
                      --   (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)
                      -- that is actually being applied to two types
                      -- of the same kind.  This affects pretty-printing
                      -- only: see Note [Equality predicates in IfaceType]
                    deriving (IfaceTyConSort -> IfaceTyConSort -> Bool
(IfaceTyConSort -> IfaceTyConSort -> Bool)
-> (IfaceTyConSort -> IfaceTyConSort -> Bool) -> Eq IfaceTyConSort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyConSort -> IfaceTyConSort -> Bool
== :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
Eq)

instance Outputable IfaceTyConSort where
  ppr :: IfaceTyConSort -> SDoc
ppr IfaceTyConSort
IfaceNormalTyCon         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"normal"
  ppr (IfaceTupleTyCon Int
n TupleSort
sort) = TupleSort -> SDoc
forall a. Outputable a => a -> SDoc
ppr TupleSort
sort SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
  ppr (IfaceSumTyCon Int
n)        = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"sum:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
n
  ppr IfaceTyConSort
IfaceEqualityTyCon       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"equality"

{- Note [Free tyvars in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Nowadays (since Nov 16, 2016) we pretty-print a Type by converting to
an IfaceType and pretty printing that.  This eliminates a lot of
pretty-print duplication, and it matches what we do with pretty-
printing TyThings. See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr.

It works fine for closed types, but when printing debug traces (e.g.
when using -ddump-tc-trace) we print a lot of /open/ types.  These
types are full of TcTyVars, and it's absolutely crucial to print them
in their full glory, with their unique, TcTyVarDetails etc.

So we simply embed a TyVar in IfaceType with the IfaceFreeTyVar constructor.
Note that:

* We never expect to serialise an IfaceFreeTyVar into an interface file, nor
  to deserialise one.  IfaceFreeTyVar is used only in the "convert to IfaceType
  and then pretty-print" pipeline.

We do the same for covars, naturally.

Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
in GHC.Builtin.Types.Prim for details).  In an effort to avoid confusing users, we suppress
the differences during pretty printing unless certain flags are enabled.
Here is how each equality predicate* is printed in homogeneous and
heterogeneous contexts, depending on which combination of the
-fprint-explicit-kinds and -fprint-equality-relations flags is used:

--------------------------------------------------------------------------------------------
|         Predicate             |        Neither flag        |    -fprint-explicit-kinds   |
|-------------------------------|----------------------------|-----------------------------|
| a ~ b         (homogeneous)   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| a ~# b,       homogeneously   |        a ~ b               | (a :: Type) ~  (b :: Type)  |
| a ~# b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      homogeneously   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |
|-------------------------------|----------------------------|-----------------------------|
|         Predicate             | -fprint-equality-relations |          Both flags         |
|-------------------------------|----------------------------|-----------------------------|
| a ~ b         (homogeneous)   |        a ~  b              | (a :: Type) ~  (b :: Type)  |
| a ~~ b,       homogeneously   |        a ~~ b              | (a :: Type) ~~ (b :: Type)  |
| a ~~ b,       heterogeneously |        a ~~ c              | (a :: Type) ~~ (c :: k)     |
| a ~# b,       homogeneously   |        a ~# b              | (a :: Type) ~# (b :: Type)  |
| a ~# b,       heterogeneously |        a ~# c              | (a :: Type) ~# (c :: k)     |
| Coercible a b (homogeneous)   |        Coercible a b       | Coercible @Type a b         |
| a ~R# b,      homogeneously   |        a ~R# b             | (a :: Type) ~R# (b :: Type) |
| a ~R# b,      heterogeneously |        a ~R# b             | (a :: Type) ~R# (c :: k)    |
--------------------------------------------------------------------------------------------

(* There is no heterogeneous, representational, lifted equality counterpart
to (~~). There could be, but there seems to be no use for it.)

This table adheres to the following rules:

A. With -fprint-equality-relations, print the true equality relation.
B. Without -fprint-equality-relations:
     i. If the equality is representational and homogeneous, use Coercible.
    ii. Otherwise, if the equality is representational, use ~R#.
   iii. If the equality is nominal and homogeneous, use ~.
    iv. Otherwise, if the equality is nominal, use ~~.
C. With -fprint-explicit-kinds, print kinds on both sides of an infix operator,
   as above; or print the kind with Coercible.
D. Without -fprint-explicit-kinds, don't print kinds.

A hetero-kinded equality is used homogeneously when it is applied to two
identical kinds. Unfortunately, determining this from an IfaceType isn't
possible since we can't see through type synonyms. Consequently, we need to
record whether this particular application is homogeneous in IfaceTyConSort
for the purposes of pretty-printing.

See Note [The equality types story] in GHC.Builtin.Types.Prim.
-}

data IfaceTyConInfo   -- Used only to guide pretty-printing
  = IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
                      -- A PromotionFlag value of IsPromoted indicates
                      -- that the type constructor came from a data
                      -- constructor promoted by -XDataKinds, and thus
                      -- should be printed as 'D to distinguish it from
                      -- an existing type constructor D.
                   , IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort       :: IfaceTyConSort }
    deriving (IfaceTyConInfo -> IfaceTyConInfo -> Bool
(IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool) -> Eq IfaceTyConInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
Eq)

-- This smart constructor allows sharing of the two most common
-- cases. See #19194
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo :: PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted  IfaceTyConSort
IfaceNormalTyCon = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted  IfaceTyConSort
IfaceNormalTyCon
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon
mkIfaceTyConInfo PromotionFlag
prom        IfaceTyConSort
sort             = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
prom        IfaceTyConSort
sort

data IfaceMCoercion
  = IfaceMRefl
  | IfaceMCo IfaceCoercion

data IfaceCoercion
  = IfaceReflCo       IfaceType
  | IfaceGReflCo      Role IfaceType (IfaceMCoercion)
  | IfaceFunCo        Role IfaceCoercion IfaceCoercion IfaceCoercion
  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
  | IfaceAppCo        IfaceCoercion IfaceCoercion
  | IfaceForAllCo     IfaceBndr IfaceCoercion IfaceCoercion
  | IfaceCoVarCo      IfLclName
  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]
  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]
       -- There are only a fixed number of CoAxiomRules, so it suffices
       -- to use an IfaceLclName to distinguish them.
       -- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals
  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType
  | IfaceSymCo        IfaceCoercion
  | IfaceTransCo      IfaceCoercion IfaceCoercion
  | IfaceSelCo        CoSel IfaceCoercion
  | IfaceLRCo         LeftOrRight IfaceCoercion
  | IfaceInstCo       IfaceCoercion IfaceCoercion
  | IfaceKindCo       IfaceCoercion
  | IfaceSubCo        IfaceCoercion
  | IfaceFreeCoVar    CoVar    -- See Note [Free tyvars in IfaceType]
  | IfaceHoleCo       CoVar    -- ^ See Note [Holes in IfaceCoercion]

data IfaceUnivCoProv
  = IfacePhantomProv IfaceCoercion
  | IfaceProofIrrelProv IfaceCoercion
  | IfacePluginProv String
  | IfaceCorePrepProv Bool  -- See defn of CorePrepProv

{- Note [Holes in IfaceCoercion]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking fails the typechecker will produce a HoleCo to stand
in place of the unproven assertion. While we generally don't want to
let these unproven assertions leak into interface files, we still need
to be able to pretty-print them as we use IfaceType's pretty-printer
to render Types. For this reason IfaceCoercion has a IfaceHoleCo
constructor; however, we fails when asked to serialize to a
IfaceHoleCo to ensure that they don't end up in an interface file.


%************************************************************************
%*                                                                      *
                Functions over IfaceTypes
*                                                                      *
************************************************************************
-}

ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey IfaceTyCon
tc Unique
key = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
key

-- | Returns true for Type or (TYPE LiftedRep)
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind :: IfacePredType -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedTypeKindTyConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True  -- Type

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
  , IA_Arg IfacePredType
arg1 ForAllTyFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  , IfacePredType -> Bool
isIfaceLiftedRep IfacePredType
arg1
  = Bool
True  -- TYPE Lifted

isIfaceLiftedTypeKind IfacePredType
_ = Bool
False

-- | Returns true for Constraint or (CONSTRAINT LiftedRep)
isIfaceConstraintKind :: IfaceKind -> Bool
isIfaceConstraintKind :: IfacePredType -> Bool
isIfaceConstraintKind (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
constraintKindTyConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True  -- Type

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
cONSTRAINTTyConKey
  , IA_Arg IfacePredType
arg1 ForAllTyFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  , IfacePredType -> Bool
isIfaceLiftedRep IfacePredType
arg1
  = Bool
True  -- TYPE Lifted

isIfaceConstraintKind IfacePredType
_ = Bool
False

isIfaceLiftedRep :: IfaceKind -> Bool
-- Returns true for LiftedRep, or BoxedRep Lifted
isIfaceLiftedRep :: IfacePredType -> Bool
isIfaceLiftedRep (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepTyConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True  -- LiftedRep

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
boxedRepDataConKey
  , IA_Arg IfacePredType
arg1 ForAllTyFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  , IfacePredType -> Bool
isIfaceLifted IfacePredType
arg1
  = Bool
True  -- TYPE Lifted

isIfaceLiftedRep IfacePredType
_ = Bool
False

isIfaceLifted :: IfaceKind -> Bool
-- Returns true for Lifted
isIfaceLifted :: IfacePredType -> Bool
isIfaceLifted (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
args)
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedDataConKey
  , IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
  = Bool
True
isIfaceLifted IfacePredType
_ = Bool
False

splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
-- Mainly for printing purposes
--
-- Here we split nested IfaceSigmaTy properly.
--
-- @
-- forall t. T t => forall m a b. M m => (a -> m b) -> t a -> m (t b)
-- @
--
-- If you called @splitIfaceSigmaTy@ on this type:
--
-- @
-- ([t, m, a, b], [T t, M m], (a -> m b) -> t a -> m (t b))
-- @
splitIfaceSigmaTy :: IfacePredType
-> ([IfaceForAllBndr], [IfacePredType], IfacePredType)
splitIfaceSigmaTy IfacePredType
ty
  = case ([IfaceForAllBndr]
bndrs, [IfacePredType]
theta) of
      ([], []) -> ([IfaceForAllBndr]
bndrs, [IfacePredType]
theta, IfacePredType
tau)
      ([IfaceForAllBndr], [IfacePredType])
_        -> let ([IfaceForAllBndr]
bndrs', [IfacePredType]
theta', IfacePredType
tau') = IfacePredType
-> ([IfaceForAllBndr], [IfacePredType], IfacePredType)
splitIfaceSigmaTy IfacePredType
tau
                   in ([IfaceForAllBndr]
bndrs [IfaceForAllBndr] -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. [a] -> [a] -> [a]
++ [IfaceForAllBndr]
bndrs', [IfacePredType]
theta [IfacePredType] -> [IfacePredType] -> [IfacePredType]
forall a. [a] -> [a] -> [a]
++ [IfacePredType]
theta', IfacePredType
tau')
  where
    ([IfaceForAllBndr]
bndrs, IfacePredType
rho)   = IfacePredType -> ([IfaceForAllBndr], IfacePredType)
split_foralls IfacePredType
ty
    ([IfacePredType]
theta, IfacePredType
tau)   = IfacePredType -> ([IfacePredType], IfacePredType)
split_rho IfacePredType
rho

    split_foralls :: IfacePredType -> ([IfaceForAllBndr], IfacePredType)
split_foralls (IfaceForAllTy IfaceForAllBndr
bndr IfacePredType
ty)
        | ForAllTyFlag -> Bool
isInvisibleForAllTyFlag (IfaceForAllBndr -> ForAllTyFlag
forall tv argf. VarBndr tv argf -> argf
binderFlag IfaceForAllBndr
bndr)
        = case IfacePredType -> ([IfaceForAllBndr], IfacePredType)
split_foralls IfacePredType
ty of { ([IfaceForAllBndr]
bndrs, IfacePredType
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfacePredType
rho) }
    split_foralls IfacePredType
rho = ([], IfacePredType
rho)

    split_rho :: IfacePredType -> ([IfacePredType], IfacePredType)
split_rho (IfaceFunTy FunTyFlag
af IfacePredType
_ IfacePredType
ty1 IfacePredType
ty2)
        | FunTyFlag -> Bool
isInvisibleFunArg FunTyFlag
af
        = case IfacePredType -> ([IfacePredType], IfacePredType)
split_rho IfacePredType
ty2 of { ([IfacePredType]
ps, IfacePredType
tau) -> (IfacePredType
ty1IfacePredType -> [IfacePredType] -> [IfacePredType]
forall a. a -> [a] -> [a]
:[IfacePredType]
ps, IfacePredType
tau) }
    split_rho IfacePredType
tau = ([], IfacePredType
tau)

splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
splitIfaceReqForallTy :: IfacePredType -> ([IfaceForAllBndr], IfacePredType)
splitIfaceReqForallTy (IfaceForAllTy IfaceForAllBndr
bndr IfacePredType
ty)
  | ForAllTyFlag -> Bool
isVisibleForAllTyFlag (IfaceForAllBndr -> ForAllTyFlag
forall tv argf. VarBndr tv argf -> argf
binderFlag IfaceForAllBndr
bndr)
  = case IfacePredType -> ([IfaceForAllBndr], IfacePredType)
splitIfaceReqForallTy IfacePredType
ty of { ([IfaceForAllBndr]
bndrs, IfacePredType
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfacePredType
rho) }
splitIfaceReqForallTy IfacePredType
rho = ([], IfacePredType
rho)

suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles :: forall a. PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles (PrintExplicitKinds Bool
True) [IfaceTyConBinder]
_tys [a]
xs = [a]
xs
suppressIfaceInvisibles (PrintExplicitKinds Bool
False) [IfaceTyConBinder]
tys [a]
xs = [IfaceTyConBinder] -> [a] -> [a]
forall {tv} {a}. [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [IfaceTyConBinder]
tys [a]
xs
    where
      suppress :: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
_       []      = []
      suppress []      [a]
a       = [a]
a
      suppress (VarBndr tv TyConBndrVis
k:[VarBndr tv TyConBndrVis]
ks) (a
x:[a]
xs)
        | VarBndr tv TyConBndrVis -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder VarBndr tv TyConBndrVis
k =     [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs
        | Bool
otherwise                = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs

stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars (PrintExplicitKinds Bool
True)  [IfaceTyConBinder]
tyvars = [IfaceTyConBinder]
tyvars
stripIfaceInvisVars (PrintExplicitKinds Bool
False) [IfaceTyConBinder]
tyvars
  = (IfaceTyConBinder -> Bool)
-> [IfaceTyConBinder] -> [IfaceTyConBinder]
forall a. (a -> Bool) -> [a] -> [a]
filterOut IfaceTyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [IfaceTyConBinder]
tyvars

-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar = IfaceForAllBndr -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar

-- | Extract the variable name from an 'IfaceForAllBndr'.
ifForAllBndrName :: IfaceForAllBndr -> IfLclName
ifForAllBndrName :: IfaceForAllBndr -> FastString
ifForAllBndrName IfaceForAllBndr
fab = IfaceBndr -> FastString
ifaceBndrName (IfaceForAllBndr -> IfaceBndr
ifForAllBndrVar IfaceForAllBndr
fab)

-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar = IfaceTyConBinder -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar

-- | Extract the variable name from an 'IfaceTyConBinder'.
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
ifTyConBinderName :: IfaceTyConBinder -> FastString
ifTyConBinderName IfaceTyConBinder
tcb = IfaceBndr -> FastString
ifaceBndrName (IfaceTyConBinder -> IfaceBndr
ifTyConBinderVar IfaceTyConBinder
tcb)

ifTypeIsVarFree :: IfaceType -> Bool
-- Returns True if the type definitely has no variables at all
-- Just used to control pretty printing
ifTypeIsVarFree :: IfacePredType -> Bool
ifTypeIsVarFree IfacePredType
ty = IfacePredType -> Bool
go IfacePredType
ty
  where
    go :: IfacePredType -> Bool
go (IfaceTyVar {})         = Bool
False
    go (IfaceFreeTyVar {})     = Bool
False
    go (IfaceAppTy IfacePredType
fun IfaceAppArgs
args)   = IfacePredType -> Bool
go IfacePredType
fun Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceFunTy FunTyFlag
_ IfacePredType
w IfacePredType
arg IfacePredType
res) = IfacePredType -> Bool
go IfacePredType
w Bool -> Bool -> Bool
&& IfacePredType -> Bool
go IfacePredType
arg Bool -> Bool -> Bool
&& IfacePredType -> Bool
go IfacePredType
res
    go (IfaceForAllTy {})      = Bool
False
    go (IfaceTyConApp IfaceTyCon
_ IfaceAppArgs
args)  = IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceTupleTy TupleSort
_ PromotionFlag
_ IfaceAppArgs
args) = IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceLitTy IfaceTyLit
_)          = Bool
True
    go (IfaceCastTy {})        = Bool
False -- Safe
    go (IfaceCoercionTy {})    = Bool
False -- Safe

    go_args :: IfaceAppArgs -> Bool
go_args IfaceAppArgs
IA_Nil = Bool
True
    go_args (IA_Arg IfacePredType
arg ForAllTyFlag
_ IfaceAppArgs
args) = IfacePredType -> Bool
go IfacePredType
arg Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args

{- Note [Substitution on IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Substitutions on IfaceType are done only during pretty-printing to
construct the result type of a GADT, and does not deal with binders
(eg IfaceForAll), so it doesn't need fancy capture stuff.  -}

type IfaceTySubst = FastStringEnv IfaceType -- Note [Substitution on IfaceType]

mkIfaceTySubst :: [(IfLclName,IfaceType)] -> IfaceTySubst
-- See Note [Substitution on IfaceType]
mkIfaceTySubst :: [IfaceTvBndr] -> IfaceTySubst
mkIfaceTySubst [IfaceTvBndr]
eq_spec = [IfaceTvBndr] -> IfaceTySubst
forall a. [(FastString, a)] -> FastStringEnv a
mkFsEnv [IfaceTvBndr]
eq_spec

inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
-- See Note [Substitution on IfaceType]
inDomIfaceTySubst :: IfaceTySubst -> IfaceTvBndr -> Bool
inDomIfaceTySubst IfaceTySubst
subst (FastString
fs, IfacePredType
_) = Maybe IfacePredType -> Bool
forall a. Maybe a -> Bool
isJust (IfaceTySubst -> FastString -> Maybe IfacePredType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subst FastString
fs)

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
-- See Note [Substitution on IfaceType]
substIfaceType :: IfaceTySubst -> IfacePredType -> IfacePredType
substIfaceType IfaceTySubst
env IfacePredType
ty
  = IfacePredType -> IfacePredType
go IfacePredType
ty
  where
    go :: IfacePredType -> IfacePredType
go (IfaceFreeTyVar CoVar
tv)    = CoVar -> IfacePredType
IfaceFreeTyVar CoVar
tv
    go (IfaceTyVar FastString
tv)        = IfaceTySubst -> FastString -> IfacePredType
substIfaceTyVar IfaceTySubst
env FastString
tv
    go (IfaceAppTy  IfacePredType
t IfaceAppArgs
ts)     = IfacePredType -> IfaceAppArgs -> IfacePredType
IfaceAppTy  (IfacePredType -> IfacePredType
go IfacePredType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
ts)
    go (IfaceFunTy FunTyFlag
af IfacePredType
w IfacePredType
t1 IfacePredType
t2)  = FunTyFlag
-> IfacePredType -> IfacePredType -> IfacePredType -> IfacePredType
IfaceFunTy FunTyFlag
af (IfacePredType -> IfacePredType
go IfacePredType
w) (IfacePredType -> IfacePredType
go IfacePredType
t1) (IfacePredType -> IfacePredType
go IfacePredType
t2)
    go ty :: IfacePredType
ty@(IfaceLitTy {})     = IfacePredType
ty
    go (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
    go (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfacePredType
IfaceTupleTy TupleSort
s PromotionFlag
i (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
    go (IfaceForAllTy {})     = String -> SDoc -> IfacePredType
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceType" (IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty)
    go (IfaceCastTy IfacePredType
ty IfaceCoercion
co)    = IfacePredType -> IfaceCoercion -> IfacePredType
IfaceCastTy (IfacePredType -> IfacePredType
go IfacePredType
ty) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go (IfaceCoercionTy IfaceCoercion
co)   = IfaceCoercion -> IfacePredType
IfaceCoercionTy (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)

    go_mco :: IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
IfaceMRefl    = IfaceMCoercion
IfaceMRefl
    go_mco (IfaceMCo IfaceCoercion
co) = IfaceCoercion -> IfaceMCoercion
IfaceMCo (IfaceCoercion -> IfaceMCoercion)
-> IfaceCoercion -> IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co

    go_co :: IfaceCoercion -> IfaceCoercion
go_co (IfaceReflCo IfacePredType
ty)           = IfacePredType -> IfaceCoercion
IfaceReflCo (IfacePredType -> IfacePredType
go IfacePredType
ty)
    go_co (IfaceGReflCo Role
r IfacePredType
ty IfaceMCoercion
mco)    = Role -> IfacePredType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (IfacePredType -> IfacePredType
go IfacePredType
ty) (IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
mco)
    go_co (IfaceFunCo Role
r IfaceCoercion
w IfaceCoercion
c1 IfaceCoercion
c2)     = Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
w) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos) = Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r IfaceTyCon
tc ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
    go_co (IfaceAppCo IfaceCoercion
c1 IfaceCoercion
c2)         = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceForAllCo {})         = String -> SDoc -> IfaceCoercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceCoercion" (IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty)
    go_co (IfaceFreeCoVar CoVar
cv)        = CoVar -> IfaceCoercion
IfaceFreeCoVar CoVar
cv
    go_co (IfaceCoVarCo FastString
cv)          = FastString -> IfaceCoercion
IfaceCoVarCo FastString
cv
    go_co (IfaceHoleCo CoVar
cv)           = CoVar -> IfaceCoercion
IfaceHoleCo CoVar
cv
    go_co (IfaceAxiomInstCo IfExtName
a Int
i [IfaceCoercion]
cos) = IfExtName -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a Int
i ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
    go_co (IfaceUnivCo IfaceUnivCoProv
prov Role
r IfacePredType
t1 IfacePredType
t2) = IfaceUnivCoProv
-> Role -> IfacePredType -> IfacePredType -> IfaceCoercion
IfaceUnivCo (IfaceUnivCoProv -> IfaceUnivCoProv
go_prov IfaceUnivCoProv
prov) Role
r (IfacePredType -> IfacePredType
go IfacePredType
t1) (IfacePredType -> IfacePredType
go IfacePredType
t2)
    go_co (IfaceSymCo IfaceCoercion
co)            = IfaceCoercion -> IfaceCoercion
IfaceSymCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2)     = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co2)
    go_co (IfaceSelCo CoSel
n IfaceCoercion
co)          = CoSel -> IfaceCoercion -> IfaceCoercion
IfaceSelCo CoSel
n (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceLRCo LeftOrRight
lr IfaceCoercion
co)          = LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
lr (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceInstCo IfaceCoercion
c1 IfaceCoercion
c2)        = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceKindCo IfaceCoercion
co)           = IfaceCoercion -> IfaceCoercion
IfaceKindCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceSubCo IfaceCoercion
co)            = IfaceCoercion -> IfaceCoercion
IfaceSubCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceAxiomRuleCo FastString
n [IfaceCoercion]
cos)   = FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo FastString
n ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)

    go_cos :: [IfaceCoercion] -> [IfaceCoercion]
go_cos = (IfaceCoercion -> IfaceCoercion)
-> [IfaceCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> IfaceCoercion
go_co

    go_prov :: IfaceUnivCoProv -> IfaceUnivCoProv
go_prov (IfacePhantomProv IfaceCoercion
co)    = IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_prov (IfaceProofIrrelProv IfaceCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_prov co :: IfaceUnivCoProv
co@(IfacePluginProv String
_)   = IfaceUnivCoProv
co
    go_prov co :: IfaceUnivCoProv
co@(IfaceCorePrepProv Bool
_) = IfaceUnivCoProv
co

substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
args
  = IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
args
  where
    go :: IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
IA_Nil              = IfaceAppArgs
IA_Nil
    go (IA_Arg IfacePredType
ty ForAllTyFlag
arg IfaceAppArgs
tys) = IfacePredType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfacePredType -> IfacePredType
substIfaceType IfaceTySubst
env IfacePredType
ty) ForAllTyFlag
arg (IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
tys)

substIfaceTyVar :: IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar :: IfaceTySubst -> FastString -> IfacePredType
substIfaceTyVar IfaceTySubst
env FastString
tv
  | Just IfacePredType
ty <- IfaceTySubst -> FastString -> Maybe IfacePredType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
env FastString
tv = IfacePredType
ty
  | Bool
otherwise                     = FastString -> IfacePredType
IfaceTyVar FastString
tv


{-
************************************************************************
*                                                                      *
                Functions over IfaceAppArgs
*                                                                      *
************************************************************************
-}

stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (PrintExplicitKinds Bool
True)  IfaceAppArgs
tys = IfaceAppArgs
tys
stripInvisArgs (PrintExplicitKinds Bool
False) IfaceAppArgs
tys = IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
tys
    where
      suppress_invis :: IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
c
        = case IfaceAppArgs
c of
            IfaceAppArgs
IA_Nil -> IfaceAppArgs
IA_Nil
            IA_Arg IfacePredType
t ForAllTyFlag
argf IfaceAppArgs
ts
              |  ForAllTyFlag -> Bool
isVisibleForAllTyFlag ForAllTyFlag
argf
              -> IfacePredType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfacePredType
t ForAllTyFlag
argf (IfaceAppArgs -> IfaceAppArgs) -> IfaceAppArgs -> IfaceAppArgs
forall a b. (a -> b) -> a -> b
$ IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts
              -- Keep recursing through the remainder of the arguments, as it's
              -- possible that there are remaining invisible ones.
              -- See the "In type declarations" section of Note [VarBndrs,
              -- ForAllTyBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep.
              |  Bool
otherwise
              -> IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts

appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes :: IfaceAppArgs -> [IfacePredType]
appArgsIfaceTypes IfaceAppArgs
IA_Nil = []
appArgsIfaceTypes (IA_Arg IfacePredType
t ForAllTyFlag
_ IfaceAppArgs
ts) = IfacePredType
t IfacePredType -> [IfacePredType] -> [IfacePredType]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [IfacePredType]
appArgsIfaceTypes IfaceAppArgs
ts

appArgsIfaceTypesForAllTyFlags :: IfaceAppArgs -> [(IfaceType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags :: IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags IfaceAppArgs
IA_Nil = []
appArgsIfaceTypesForAllTyFlags (IA_Arg IfacePredType
t ForAllTyFlag
a IfaceAppArgs
ts)
                                 = (IfacePredType
t, ForAllTyFlag
a) (IfacePredType, ForAllTyFlag)
-> [(IfacePredType, ForAllTyFlag)]
-> [(IfacePredType, ForAllTyFlag)]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags IfaceAppArgs
ts

ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength = Int -> IfaceAppArgs -> Int
forall {t}. Num t => t -> IfaceAppArgs -> t
go Int
0
  where
    go :: t -> IfaceAppArgs -> t
go !t
n IfaceAppArgs
IA_Nil = t
n
    go t
n  (IA_Arg IfacePredType
_ ForAllTyFlag
argf IfaceAppArgs
rest)
      | ForAllTyFlag -> Bool
isVisibleForAllTyFlag ForAllTyFlag
argf = t -> IfaceAppArgs -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1) IfaceAppArgs
rest
      | Bool
otherwise             = t -> IfaceAppArgs -> t
go t
n IfaceAppArgs
rest

{-
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We use the IfaceAppArgs data type to specify which of the arguments to a type
should be displayed when pretty-printing, under the control of
-fprint-explicit-kinds.
See also Type.filterOutInvisibleTypes.
For example, given

    T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
    'Just :: forall k. k -> 'Maybe k   -- Promoted

we want

    T * Tree Int    prints as    T Tree Int
    'Just *         prints as    Just *

For type constructors (IfaceTyConApp), IfaceAppArgs is a quite natural fit,
since the corresponding Core constructor:

    data Type
      = ...
      | TyConApp TyCon [Type]

Already puts all of its arguments into a list. So when converting a Type to an
IfaceType (see toIfaceAppArgsX in GHC.Core.ToIface), we simply use the kind of
the TyCon (which is cached) to guide the process of converting the argument
Types into an IfaceAppArgs list.

We also want this behavior for IfaceAppTy, since given:

    data Proxy (a :: k)
    f :: forall (t :: forall a. a -> Type). Proxy Type (t Bool True)

We want to print the return type as `Proxy (t True)` without the use of
-fprint-explicit-kinds (#15330). Accomplishing this is trickier than in the
tycon case, because the corresponding Core constructor for IfaceAppTy:

    data Type
      = ...
      | AppTy Type Type

Only stores one argument at a time. Therefore, when converting an AppTy to an
IfaceAppTy (in toIfaceTypeX in GHC.CoreToIface), we:

1. Flatten the chain of AppTys down as much as possible
2. Use typeKind to determine the function Type's kind
3. Use this kind to guide the process of converting the argument Types into an
   IfaceAppArgs list.

By flattening the arguments like this, we obtain two benefits:

(a) We can reuse the same machinery to pretty-print IfaceTyConApp arguments as
    we do IfaceTyApp arguments, which means that we only need to implement the
    logic to filter out invisible arguments once.
(b) Unlike for tycons, finding the kind of a type in general (through typeKind)
    is not a constant-time operation, so by flattening the arguments first, we
    decrease the number of times we have to call typeKind.

Note [Pretty-printing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Note [Suppressing invisible arguments] is all about how to avoid printing
invisible arguments when the -fprint-explicit-kinds flag is disables. Well,
what about when it's enabled? Then we can and should print invisible kind
arguments, and this Note explains how we do it.

As two running examples, consider the following code:

  {-# LANGUAGE PolyKinds #-}
  data T1 a
  data T2 (a :: k)

When displaying these types (with -fprint-explicit-kinds on), we could just
do the following:

  T1 k a
  T2 k a

That certainly gets the job done. But it lacks a crucial piece of information:
is the `k` argument inferred or specified? To communicate this, we use visible
kind application syntax to distinguish the two cases:

  T1 @{k} a
  T2 @k   a

Here, @{k} indicates that `k` is an inferred argument, and @k indicates that
`k` is a specified argument. (See
Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility] in GHC.Core.TyCo.Rep for
a lengthier explanation on what "inferred" and "specified" mean.)

************************************************************************
*                                                                      *
                Pretty-printing
*                                                                      *
************************************************************************
-}

if_print_coercions :: SDoc  -- ^ if printing coercions
                   -> SDoc  -- ^ otherwise
                   -> SDoc
if_print_coercions :: SDoc -> SDoc -> SDoc
if_print_coercions SDoc
yes SDoc
no
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_co ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
    (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
    if Bool
print_co Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| Bool
debug
    then SDoc
yes
    else SDoc
no

pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
pp_tc SDoc
pp_ty1 SDoc
pp_ty2
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
pp_ty1, SDoc
pp_tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
pp_ty2]

pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp :: PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec SDoc
pp_fun [SDoc]
pp_tys
  | [SDoc] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
pp_tys = SDoc
pp_fun
  | Bool
otherwise   = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  SDoc -> Int -> SDoc -> SDoc
hang SDoc
pp_fun Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc]
pp_tys)

isIfaceRhoType :: IfaceType -> Bool
isIfaceRhoType :: IfacePredType -> Bool
isIfaceRhoType (IfaceForAllTy IfaceForAllBndr
_ IfacePredType
_)   = Bool
False
isIfaceRhoType (IfaceFunTy FunTyFlag
af IfacePredType
_ IfacePredType
_ IfacePredType
_) = FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af
isIfaceRhoType IfacePredType
_ = Bool
True

-- ----------------------------- Printing binders ------------------------------------

instance Outputable IfaceBndr where
    ppr :: IfaceBndr -> SDoc
ppr (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
bndr
    ppr (IfaceTvBndr IfaceTvBndr
bndr) = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
bndr (Bool -> SuppressBndrSig
SuppressBndrSig Bool
False)
                                                             (Bool -> UseBndrParens
UseBndrParens Bool
False)

pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs [IfaceBndr]
bs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((IfaceBndr -> SDoc) -> [IfaceBndr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceBndr]
bs)

pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceNoOneShot) = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b
pprIfaceLamBndr (IfaceBndr
b, IfaceOneShot
IfaceOneShot)   = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"[OneShot]"

pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr (IfacePredType
w, FastString
name, IfacePredType
ty) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
name SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
w) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty)

{- Note [Suppressing binder signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When printing the binders in a 'forall', we want to keep the kind annotations:

    forall (a :: k). blah
              ^^^^
              good

On the other hand, when we print the binders of a data declaration in :info,
the kind information would be redundant due to the standalone kind signature:

   type F :: Symbol -> Type
   type F (s :: Symbol) = blah
             ^^^^^^^^^
             redundant

Here we'd like to omit the kind annotation:

   type F :: Symbol -> Type
   type F s = blah

Note [Printing type abbreviations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Normally, we pretty-print
   `TYPE       'LiftedRep` as `Type` (or `*`)
   `CONSTRAINT 'LiftedRep` as `Constraint`
   `FUN 'Many`             as `(->)`.
This way, error messages don't refer to representation polymorphism
or linearity if it is not necessary.  Normally we'd would represent
these types using their synonyms (see GHC.Core.Type
Note [Using synonyms to compress types]), but in the :kind! GHCi
command we specifically expand synonyms (see GHC.Tc.Module.tcRnExpr).
So here in the pretty-printing we effectively collapse back Type
and Constraint to their synonym forms.  A bit confusing!

However, when printing the definition of Type, Constraint or (->) with :info,
this would give confusing output: `type (->) = (->)` (#18594).
Solution: detect when we are in :info and disable displaying the synonym
with the SDoc option sdocPrintTypeAbbreviations.
If you are creating a similar synonym, make sure it is listed in pprIfaceDecl,
see reference to this Note.

If there will be a need, in the future we could expose it as a flag
-fprint-type-abbreviations or even three separate flags controlling
TYPE 'LiftedRep, CONSTRAINT 'LiftedRep and FUN 'Many.
-}

-- | Do we want to suppress kind annotations on binders?
-- See Note [Suppressing binder signatures]
newtype SuppressBndrSig = SuppressBndrSig Bool

newtype UseBndrParens      = UseBndrParens Bool
newtype PrintExplicitKinds = PrintExplicitKinds Bool

pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr (FastString
tv, IfacePredType
ki) (SuppressBndrSig Bool
suppress_sig) (UseBndrParens Bool
use_parens)
  | Bool
suppress_sig             = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv
  | IfacePredType -> Bool
isIfaceLiftedTypeKind IfacePredType
ki = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv
  | Bool
otherwise                = SDoc -> SDoc
maybe_parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ki)
  where
    maybe_parens :: SDoc -> SDoc
maybe_parens | Bool
use_parens = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens
                 | Bool
otherwise  = SDoc -> SDoc
forall a. a -> a
id

pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders SuppressBndrSig
suppress_sig = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ([SDoc] -> SDoc)
-> ([IfaceTyConBinder] -> [SDoc]) -> [IfaceTyConBinder] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IfaceTyConBinder -> SDoc) -> [IfaceTyConBinder] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceTyConBinder -> SDoc
go
  where
    go :: IfaceTyConBinder -> SDoc
    go :: IfaceTyConBinder -> SDoc
go (Bndr (IfaceIdBndr IfaceIdBndr
bndr) TyConBndrVis
_) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
bndr
    go (Bndr (IfaceTvBndr IfaceTvBndr
bndr) TyConBndrVis
vis) =
      -- See Note [Pretty-printing invisible arguments]
      case TyConBndrVis
vis of
        AnonTCB  FunTyFlag
af
          | FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
          | Bool
otherwise          -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
False))
          -- The above case is rare. (See Note [AnonTCB with constraint arg]
          --   in GHC.Core.TyCon.)
          -- Should we print these differently?
        NamedTCB ForAllTyFlag
Required  -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        NamedTCB ForAllTyFlag
Specified -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        NamedTCB ForAllTyFlag
Inferred  -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
False))
      where
        ppr_bndr :: UseBndrParens -> SDoc
ppr_bndr = IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
bndr SuppressBndrSig
suppress_sig

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

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

-- ----------------------------- Printing IfaceType ------------------------------------

---------------------------------
instance Outputable IfaceType where
  ppr :: IfacePredType -> SDoc
ppr IfacePredType
ty = IfacePredType -> SDoc
pprIfaceType IfacePredType
ty

pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
pprIfaceType :: IfacePredType -> SDoc
pprIfaceType       = PprPrec -> IfacePredType -> SDoc
pprPrecIfaceType PprPrec
topPrec
pprParendIfaceType :: IfacePredType -> SDoc
pprParendIfaceType = PprPrec -> IfacePredType -> SDoc
pprPrecIfaceType PprPrec
appPrec

pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
-- We still need `hideNonStandardTypes`, since the `pprPrecIfaceType` may be
-- called from other places, besides `:type` and `:info`.
pprPrecIfaceType :: PprPrec -> IfacePredType -> SDoc
pprPrecIfaceType PprPrec
prec IfacePredType
ty =
  (IfacePredType -> SDoc) -> IfacePredType -> SDoc
hideNonStandardTypes (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
prec) IfacePredType
ty

pprTypeArrow :: FunTyFlag -> IfaceMult -> SDoc
pprTypeArrow :: FunTyFlag -> IfacePredType -> SDoc
pprTypeArrow FunTyFlag
af IfacePredType
mult
  = (IfacePredType -> Maybe IfaceTyCon,
 PprPrec -> IfacePredType -> SDoc)
-> FunTyFlag -> IfacePredType -> SDoc
forall a.
(a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
-> FunTyFlag -> a -> SDoc
pprArrow (IfacePredType -> Maybe IfaceTyCon
mb_conc, PprPrec -> IfacePredType -> SDoc
pprPrecIfaceType) FunTyFlag
af IfacePredType
mult
  where
    mb_conc :: IfacePredType -> Maybe IfaceTyCon
mb_conc (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) = IfaceTyCon -> Maybe IfaceTyCon
forall a. a -> Maybe a
Just IfaceTyCon
tc
    mb_conc IfacePredType
_                    = Maybe IfaceTyCon
forall a. Maybe a
Nothing

pprArrow :: (a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
         -> FunTyFlag -> a -> SDoc
-- Prints a thin arrow (->) with its multiplicity
-- Used for both FunTy and FunCo, hence higher order arguments
pprArrow :: forall a.
(a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
-> FunTyFlag -> a -> SDoc
pprArrow (a -> Maybe IfaceTyCon
mb_conc, PprPrec -> a -> SDoc
ppr_mult) FunTyFlag
af a
mult
  | FunTyFlag -> Bool
isFUNArg FunTyFlag
af
  = case a -> Maybe IfaceTyCon
mb_conc a
mult of
      Just IfaceTyCon
tc | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
manyDataConKey -> SDoc
arrow
              | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
oneDataConKey  -> SDoc
lollipop
      Maybe IfaceTyCon
_ -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"%" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> a -> SDoc
ppr_mult PprPrec
appPrec a
mult SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow
  | Bool
otherwise
  = TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr (FunTyFlag -> TyCon
funTyFlagTyCon FunTyFlag
af)

ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty :: PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
ctxt_prec IfacePredType
ty
  | Bool -> Bool
not (IfacePredType -> Bool
isIfaceRhoType IfacePredType
ty)             = ShowForAllFlag -> PprPrec -> IfacePredType -> SDoc
ppr_sigma ShowForAllFlag
ShowForAllMust PprPrec
ctxt_prec IfacePredType
ty
ppr_ty PprPrec
_         (IfaceForAllTy {})     = String -> SDoc
forall a. HasCallStack => String -> a
panic String
"ppr_ty"  -- Covered by not.isIfaceRhoType
ppr_ty PprPrec
_         (IfaceFreeTyVar CoVar
tyvar) = CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
tyvar  -- This is the main reason for IfaceFreeTyVar!
ppr_ty PprPrec
_         (IfaceTyVar FastString
tyvar)     = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tyvar  -- See Note [Free tyvars in IfaceType]
ppr_ty PprPrec
ctxt_prec (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys
ppr_ty PprPrec
ctxt_prec (IfaceTupleTy TupleSort
i PromotionFlag
p IfaceAppArgs
tys) = PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
i PromotionFlag
p IfaceAppArgs
tys -- always fully saturated
ppr_ty PprPrec
_         (IfaceLitTy IfaceTyLit
n)         = IfaceTyLit -> SDoc
pprIfaceTyLit IfaceTyLit
n

        -- Function types
ppr_ty PprPrec
ctxt_prec ty :: IfacePredType
ty@(IfaceFunTy FunTyFlag
af IfacePredType
w IfacePredType
ty1 IfacePredType
ty2)  -- Should be a visible argument
  = Bool -> SDoc -> SDoc -> SDoc
forall a. HasCallStack => Bool -> SDoc -> a -> a
assertPpr (FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af) (IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$  -- Ensured by isIfaceRhoType above
    -- We want to print a chain of arrows in a column
    --     type1
    --     -> type2
    --     -> type3
    PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
funPrec IfacePredType
ty1, [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (IfacePredType -> IfacePredType -> [SDoc]
ppr_fun_tail IfacePredType
w IfacePredType
ty2)]
  where
    ppr_fun_tail :: IfacePredType -> IfacePredType -> [SDoc]
ppr_fun_tail IfacePredType
wthis (IfaceFunTy FunTyFlag
af IfacePredType
wnext IfacePredType
ty1 IfacePredType
ty2)
      | FunTyFlag -> Bool
isVisibleFunArg FunTyFlag
af
      = (FunTyFlag -> IfacePredType -> SDoc
pprTypeArrow FunTyFlag
af IfacePredType
wthis SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
funPrec IfacePredType
ty1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfacePredType -> IfacePredType -> [SDoc]
ppr_fun_tail IfacePredType
wnext IfacePredType
ty2
    ppr_fun_tail IfacePredType
wthis IfacePredType
other_ty
      = [FunTyFlag -> IfacePredType -> SDoc
pprTypeArrow FunTyFlag
af IfacePredType
wthis SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfacePredType -> SDoc
pprIfaceType IfacePredType
other_ty]

ppr_ty PprPrec
ctxt_prec (IfaceAppTy IfacePredType
t IfaceAppArgs
ts)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      SDoc
ppr_app_ty
      SDoc
ppr_app_ty_no_casts
  where
    ppr_app_ty :: SDoc
ppr_app_ty =
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
        let tys_wo_kinds :: [(IfacePredType, ForAllTyFlag)]
tys_wo_kinds = IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags (IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)])
-> IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs
                              (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
ts
        in PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec
                             (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
funPrec IfacePredType
t)
                             (((IfacePredType, ForAllTyFlag) -> SDoc)
-> [(IfacePredType, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfacePredType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) [(IfacePredType, ForAllTyFlag)]
tys_wo_kinds)


    -- Strip any casts from the head of the application
    ppr_app_ty_no_casts :: SDoc
ppr_app_ty_no_casts =
        case IfacePredType
t of
          IfaceCastTy IfacePredType
head IfaceCoercion
_ -> PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
ctxt_prec (IfacePredType -> IfaceAppArgs -> IfacePredType
mk_app_tys IfacePredType
head IfaceAppArgs
ts)
          IfacePredType
_                  -> SDoc
ppr_app_ty

    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
    mk_app_tys :: IfacePredType -> IfaceAppArgs -> IfacePredType
mk_app_tys (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys1) IfaceAppArgs
tys2 =
        IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
tc (IfaceAppArgs
tys1 IfaceAppArgs -> IfaceAppArgs -> IfaceAppArgs
forall a. Monoid a => a -> a -> a
`mappend` IfaceAppArgs
tys2)
    mk_app_tys IfacePredType
t1 IfaceAppArgs
tys2 = IfacePredType -> IfaceAppArgs -> IfacePredType
IfaceAppTy IfacePredType
t1 IfaceAppArgs
tys2

ppr_ty PprPrec
ctxt_prec (IfaceCastTy IfacePredType
ty IfaceCoercion
co)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
topPrec IfacePredType
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"|>" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceCoercion
co))
      (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
ctxt_prec IfacePredType
ty)

ppr_ty PprPrec
ctxt_prec (IfaceCoercionTy IfaceCoercion
co)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
ctxt_prec IfaceCoercion
co)
      (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"<>")

{- Note [Defaulting RuntimeRep variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
RuntimeRep variables are considered by many (most?) users to be little
more than syntactic noise. When the notion was introduced there was a
significant and understandable push-back from those with pedagogy in
mind, which argued that RuntimeRep variables would throw a wrench into
nearly any teach approach since they appear in even the lowly ($)
function's type,

    ($) :: forall (w :: RuntimeRep) a (b :: TYPE w). (a -> b) -> a -> b

which is significantly less readable than its non RuntimeRep-polymorphic type of

    ($) :: (a -> b) -> a -> b

Moreover, unboxed types don't appear all that often in run-of-the-mill
Haskell programs, so it makes little sense to make all users pay this
syntactic overhead.

For this reason it was decided that we would hide RuntimeRep variables
for now (see #11549). We do this by defaulting all type variables of
kind RuntimeRep to LiftedRep.
Likewise, we default all Multiplicity variables to Many.

This is done in a pass right before pretty-printing
(defaultIfaceTyVarsOfKind, controlled by
-fprint-explicit-runtime-reps and -XLinearTypes)

This applies to /quantified/ variables like 'w' above.  What about
variables that are /free/ in the type being printed, which certainly
happens in error messages.  Suppose (#16074, #19361) we are reporting a
mismatch between skolems
          (a :: RuntimeRep) ~ (b :: RuntimeRep)
        or
          (m :: Multiplicity) ~ Many
We certainly don't want to say "Can't match LiftedRep with LiftedRep" or
"Can't match Many with Many"!

But if we are printing the type
    (forall (a :: TYPE r). blah)
we do want to turn that (free) r into LiftedRep, so it prints as
    (forall a. blah)

We use isMetaTyVar to distinguish between those two situations:
metavariables are converted, skolem variables are not.

There's one exception though: TyVarTv metavariables should not be defaulted,
as they appear during kind-checking of "newtype T :: TYPE r where..."
(test T18357a). Therefore, we additionally test for isTyConableTyVar.
-}

-- | Default 'RuntimeRep' variables to 'LiftedRep',
--   'Levity' variables to 'Lifted', and 'Multiplicity'
--   variables to 'Many'. For example:
--
-- @
-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
--        (a -> b) -> a -> b
-- Just :: forall (k :: Multiplicity) a. a % k -> Maybe a
-- @
--
-- turns in to,
--
-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
-- @ Just :: forall a . a -> Maybe a @
--
-- We do this to prevent RuntimeRep, Levity and Multiplicity variables from
-- incurring a significant syntactic overhead in otherwise simple
-- type signatures (e.g. ($)). See Note [Defaulting RuntimeRep variables]
-- and #11549 for further discussion.
defaultIfaceTyVarsOfKind :: Bool -- ^ default 'RuntimeRep'/'Levity' variables?
                         -> Bool -- ^ default 'Multiplicity' variables?
                         -> IfaceType -> IfaceType
defaultIfaceTyVarsOfKind :: Bool -> Bool -> IfacePredType -> IfacePredType
defaultIfaceTyVarsOfKind Bool
def_rep Bool
def_mult IfacePredType
ty = IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
forall a. FastStringEnv a
emptyFsEnv IfacePredType
ty
  where
    go :: FastStringEnv IfaceType -- Set of enclosing forall-ed RuntimeRep/Levity/Multiplicity variables
       -> IfaceType
       -> IfaceType
    go :: IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs (IfaceForAllTy (Bndr (IfaceTvBndr (FastString
var, IfacePredType
var_kind)) ForAllTyFlag
argf) IfacePredType
ty)
     | ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
argf  -- Don't default *visible* quantification
                                -- or we get the mess in #13963
     , Just IfacePredType
substituted_ty <- IfacePredType -> Maybe IfacePredType
check_substitution IfacePredType
var_kind
      = let subs' :: IfaceTySubst
subs' = IfaceTySubst -> FastString -> IfacePredType -> IfaceTySubst
forall a. FastStringEnv a -> FastString -> a -> FastStringEnv a
extendFsEnv IfaceTySubst
subs FastString
var IfacePredType
substituted_ty
            -- Record that we should replace it with LiftedRep/Lifted/Many,
            -- and recurse, discarding the forall
        in IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs' IfacePredType
ty

    go IfaceTySubst
subs (IfaceForAllTy IfaceForAllBndr
bndr IfacePredType
ty)
      = IfaceForAllBndr -> IfacePredType -> IfacePredType
IfaceForAllTy (IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs IfaceForAllBndr
bndr) (IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
ty)

    go IfaceTySubst
subs ty :: IfacePredType
ty@(IfaceTyVar FastString
tv) = case IfaceTySubst -> FastString -> Maybe IfacePredType
forall a. FastStringEnv a -> FastString -> Maybe a
lookupFsEnv IfaceTySubst
subs FastString
tv of
      Just IfacePredType
s -> IfacePredType
s
      Maybe IfacePredType
Nothing -> IfacePredType
ty

    go IfaceTySubst
_ ty :: IfacePredType
ty@(IfaceFreeTyVar CoVar
tv)
      -- See Note [Defaulting RuntimeRep variables], about free vars
      | Bool
def_rep
      , Type -> Bool
GHC.Core.Type.isRuntimeRepTy (CoVar -> Type
tyVarKind CoVar
tv)
      , CoVar -> Bool
isMetaTyVar CoVar
tv
      , CoVar -> Bool
isTyConableTyVar CoVar
tv
      = IfacePredType
liftedRep_ty
      | Bool
def_rep
      , Type -> Bool
GHC.Core.Type.isLevityTy (CoVar -> Type
tyVarKind CoVar
tv)
      , CoVar -> Bool
isMetaTyVar CoVar
tv
      , CoVar -> Bool
isTyConableTyVar CoVar
tv
      = IfacePredType
lifted_ty
      | Bool
def_mult
      , Type -> Bool
GHC.Core.Type.isMultiplicityTy (CoVar -> Type
tyVarKind CoVar
tv)
      , CoVar -> Bool
isMetaTyVar CoVar
tv
      , CoVar -> Bool
isTyConableTyVar CoVar
tv
      = IfacePredType
many_ty
      | Bool
otherwise
      = IfacePredType
ty

    go IfaceTySubst
subs (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tc_args)
      = IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
tc_args)

    go IfaceTySubst
subs (IfaceTupleTy TupleSort
sort PromotionFlag
is_prom IfaceAppArgs
tc_args)
      = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfacePredType
IfaceTupleTy TupleSort
sort PromotionFlag
is_prom (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
tc_args)

    go IfaceTySubst
subs (IfaceFunTy FunTyFlag
af IfacePredType
w IfacePredType
arg IfacePredType
res)
      = FunTyFlag
-> IfacePredType -> IfacePredType -> IfacePredType -> IfacePredType
IfaceFunTy FunTyFlag
af (IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
w) (IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
arg) (IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
res)

    go IfaceTySubst
subs (IfaceAppTy IfacePredType
t IfaceAppArgs
ts)
      = IfacePredType -> IfaceAppArgs -> IfacePredType
IfaceAppTy (IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
ts)

    go IfaceTySubst
subs (IfaceCastTy IfacePredType
x IfaceCoercion
co)
      = IfacePredType -> IfaceCoercion -> IfacePredType
IfaceCastTy (IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
x) IfaceCoercion
co

    go IfaceTySubst
_ ty :: IfacePredType
ty@(IfaceLitTy {}) = IfacePredType
ty
    go IfaceTySubst
_ ty :: IfacePredType
ty@(IfaceCoercionTy {}) = IfacePredType
ty

    go_ifacebndr :: FastStringEnv IfaceType -> IfaceForAllBndr -> IfaceForAllBndr
    go_ifacebndr :: IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs (Bndr (IfaceIdBndr (IfacePredType
w, FastString
n, IfacePredType
t)) ForAllTyFlag
argf)
      = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceIdBndr -> IfaceBndr
IfaceIdBndr (IfacePredType
w, FastString
n, IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
t)) ForAllTyFlag
argf
    go_ifacebndr IfaceTySubst
subs (Bndr (IfaceTvBndr (FastString
n, IfacePredType
t)) ForAllTyFlag
argf)
      = IfaceBndr -> ForAllTyFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr (FastString
n, IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
t)) ForAllTyFlag
argf

    go_args :: FastStringEnv IfaceType -> IfaceAppArgs -> IfaceAppArgs
    go_args :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
_ IfaceAppArgs
IA_Nil = IfaceAppArgs
IA_Nil
    go_args IfaceTySubst
subs (IA_Arg IfacePredType
ty ForAllTyFlag
argf IfaceAppArgs
args)
      = IfacePredType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfacePredType -> IfacePredType
go IfaceTySubst
subs IfacePredType
ty) ForAllTyFlag
argf (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args IfaceTySubst
subs IfaceAppArgs
args)

    check_substitution :: IfaceType -> Maybe IfaceType
    check_substitution :: IfacePredType -> Maybe IfacePredType
check_substitution (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_)
        | Bool
def_rep
        , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
runtimeRepTyConKey
        = IfacePredType -> Maybe IfacePredType
forall a. a -> Maybe a
Just IfacePredType
liftedRep_ty
        | Bool
def_rep
        , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
levityTyConKey
        = IfacePredType -> Maybe IfacePredType
forall a. a -> Maybe a
Just IfacePredType
lifted_ty
        | Bool
def_mult
        , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
multiplicityTyConKey
        = IfacePredType -> Maybe IfacePredType
forall a. a -> Maybe a
Just IfacePredType
many_ty
    check_substitution IfacePredType
_ = Maybe IfacePredType
forall a. Maybe a
Nothing

-- | The type ('BoxedRep 'Lifted), also known as LiftedRep.
liftedRep_ty :: IfaceType
liftedRep_ty :: IfacePredType
liftedRep_ty =
  IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
liftedRep IfaceAppArgs
IA_Nil
  where
    liftedRep :: IfaceTyCon
    liftedRep :: IfaceTyCon
liftedRep = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
tc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon)
      where tc_name :: IfExtName
tc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedRepTyCon

-- | The type 'Lifted :: Levity'.
lifted_ty :: IfaceType
lifted_ty :: IfacePredType
lifted_ty =
    IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon))
                  IfaceAppArgs
IA_Nil
  where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedDataConTyCon

-- | The type 'Many :: Multiplicity'.
many_ty :: IfaceType
many_ty :: IfacePredType
many_ty = IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon))
                        IfaceAppArgs
IA_Nil
  where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
manyDataConTyCon

hideNonStandardTypes :: (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes :: (IfacePredType -> SDoc) -> IfacePredType -> SDoc
hideNonStandardTypes IfacePredType -> SDoc
f IfacePredType
ty
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
printExplicitRuntimeReps ->
    (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
linearTypes ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty    ->
    let def_rep :: Bool
def_rep  = Bool -> Bool
not Bool
printExplicitRuntimeReps
        def_mult :: Bool
def_mult = Bool -> Bool
not Bool
linearTypes
    in if PprStyle -> Bool
userStyle PprStyle
sty
       then IfacePredType -> SDoc
f (Bool -> Bool -> IfacePredType -> IfacePredType
defaultIfaceTyVarsOfKind Bool
def_rep Bool
def_mult IfacePredType
ty)
       else IfacePredType -> SDoc
f IfacePredType
ty

instance Outputable IfaceAppArgs where
  ppr :: IfaceAppArgs -> SDoc
ppr IfaceAppArgs
tca = IfaceAppArgs -> SDoc
pprIfaceAppArgs IfaceAppArgs
tca

pprIfaceAppArgs, pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs :: IfaceAppArgs -> SDoc
pprIfaceAppArgs  = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
topPrec
pprParendIfaceAppArgs :: IfaceAppArgs -> SDoc
pprParendIfaceAppArgs = PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
appPrec

ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args :: PprPrec -> IfaceAppArgs -> SDoc
ppr_app_args PprPrec
ctx_prec = IfaceAppArgs -> SDoc
go
  where
    go :: IfaceAppArgs -> SDoc
    go :: IfaceAppArgs -> SDoc
go IfaceAppArgs
IA_Nil             = SDoc
forall doc. IsOutput doc => doc
empty
    go (IA_Arg IfacePredType
t ForAllTyFlag
argf IfaceAppArgs
ts) = PprPrec -> (IfacePredType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfacePredType
t, ForAllTyFlag
argf) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceAppArgs -> SDoc
go IfaceAppArgs
ts

-- See Note [Pretty-printing invisible arguments]
ppr_app_arg :: PprPrec -> (IfaceType, ForAllTyFlag) -> SDoc
ppr_app_arg :: PprPrec -> (IfacePredType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfacePredType
t, ForAllTyFlag
argf) =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
  case ForAllTyFlag
argf of
       ForAllTyFlag
Required  -> PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
ctx_prec IfacePredType
t
       ForAllTyFlag
Specified |  Bool
print_kinds
                 -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
appPrec IfacePredType
t
       ForAllTyFlag
Inferred  |  Bool
print_kinds
                 -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'@' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
topPrec IfacePredType
t)
       ForAllTyFlag
_         -> SDoc
forall doc. IsOutput doc => doc
empty

-------------------
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPart [IfaceForAllBndr]
tvs [IfacePredType]
ctxt SDoc
sdoc
  = ShowForAllFlag
-> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllWhen [IfaceForAllBndr]
tvs [IfacePredType]
ctxt SDoc
sdoc

-- | Like 'pprIfaceForAllPart', but always uses an explicit @forall@.
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPartMust :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPartMust [IfaceForAllBndr]
tvs [IfacePredType]
ctxt SDoc
sdoc
  = ShowForAllFlag
-> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
ShowForAllMust [IfaceForAllBndr]
tvs [IfacePredType]
ctxt SDoc
sdoc

pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart :: [(FastString, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(FastString, IfaceCoercion)]
tvs SDoc
sdoc
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [(FastString, IfaceCoercion)]
tvs, SDoc
sdoc ]

ppr_iface_forall_part :: ShowForAllFlag
                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part :: ShowForAllFlag
-> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
tvs [IfacePredType]
ctxt SDoc
sdoc
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ case ShowForAllFlag
show_forall of
            ShowForAllFlag
ShowForAllMust -> [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
            ShowForAllFlag
ShowForAllWhen -> [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
        , [IfacePredType] -> SDoc
pprIfaceContextArr [IfacePredType]
ctxt
        , SDoc
sdoc]

-- | Render the "forall ... ." or "forall ... ->" bit of a type.
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceForAll [] = SDoc
forall doc. IsOutput doc => doc
empty
pprIfaceForAll bndrs :: [IfaceForAllBndr]
bndrs@(Bndr IfaceBndr
_ ForAllTyFlag
vis : [IfaceForAllBndr]
_)
  = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ SDoc -> SDoc
add_separator (SDoc
forAllLit SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [SDoc]
docs)
        , [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
bndrs' ]
  where
    ([IfaceForAllBndr]
bndrs', [SDoc]
docs) = [IfaceForAllBndr] -> ForAllTyFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ForAllTyFlag
vis

    add_separator :: SDoc -> SDoc
add_separator SDoc
stuff = case ForAllTyFlag
vis of
                            ForAllTyFlag
Required -> SDoc
stuff SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
arrow
                            ForAllTyFlag
_inv     -> SDoc
stuff SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>  SDoc
forall doc. IsLine doc => doc
dot


-- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
-- Returns both the list of not-yet-rendered binders and the doc.
-- No anonymous binders here!
ppr_itv_bndrs :: [IfaceForAllBndr]
             -> ForAllTyFlag  -- ^ visibility of the first binder in the list
             -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs :: [IfaceForAllBndr] -> ForAllTyFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs all_bndrs :: [IfaceForAllBndr]
all_bndrs@(bndr :: IfaceForAllBndr
bndr@(Bndr IfaceBndr
_ ForAllTyFlag
vis) : [IfaceForAllBndr]
bndrs) ForAllTyFlag
vis1
  | ForAllTyFlag
vis ForAllTyFlag -> ForAllTyFlag -> Bool
`eqForAllVis` ForAllTyFlag
vis1 = let ([IfaceForAllBndr]
bndrs', [SDoc]
doc) = [IfaceForAllBndr] -> ForAllTyFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ForAllTyFlag
vis1 in
                             ([IfaceForAllBndr]
bndrs', IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
doc)
  | Bool
otherwise              = ([IfaceForAllBndr]
all_bndrs, [])
ppr_itv_bndrs [] ForAllTyFlag
_ = ([], [])

pprIfaceForAllCo :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo :: [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCo []  = SDoc
forall doc. IsOutput doc => doc
empty
pprIfaceForAllCo [(FastString, IfaceCoercion)]
tvs = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"forall" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(FastString, IfaceCoercion)]
tvs SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
dot

pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs :: [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(FastString, IfaceCoercion)]
bndrs = [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ ((FastString, IfaceCoercion) -> SDoc)
-> [(FastString, IfaceCoercion)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (FastString, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr [(FastString, IfaceCoercion)]
bndrs

pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr =
  case IfaceForAllBndr
bndr of
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ForAllTyFlag
Inferred ->
      SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
False)
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ForAllTyFlag
_ ->
      IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
    Bndr (IfaceIdBndr IfaceIdBndr
idv) ForAllTyFlag
_ -> IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
idv
  where
    -- See Note [Suppressing binder signatures]
    suppress_sig :: SuppressBndrSig
suppress_sig = Bool -> SuppressBndrSig
SuppressBndrSig Bool
False

pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr :: (FastString, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (FastString
tv, IfaceCoercion
kind_co)
  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
kind_co)

-- | Show forall flag
--
-- Unconditionally show the forall quantifier with ('ShowForAllMust')
-- or when ('ShowForAllWhen') the names used are free in the binder
-- or when compiling with -fprint-explicit-foralls.
data ShowForAllFlag = ShowForAllMust | ShowForAllWhen

pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType :: ShowForAllFlag -> IfacePredType -> SDoc
pprIfaceSigmaType ShowForAllFlag
show_forall IfacePredType
ty
  = (IfacePredType -> SDoc) -> IfacePredType -> SDoc
hideNonStandardTypes (ShowForAllFlag -> PprPrec -> IfacePredType -> SDoc
ppr_sigma ShowForAllFlag
show_forall PprPrec
topPrec) IfacePredType
ty

ppr_sigma :: ShowForAllFlag -> PprPrec -> IfaceType -> SDoc
ppr_sigma :: ShowForAllFlag -> PprPrec -> IfacePredType -> SDoc
ppr_sigma ShowForAllFlag
show_forall PprPrec
ctxt_prec IfacePredType
iface_ty
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    let ([IfaceForAllBndr]
invis_tvs, [IfacePredType]
theta, IfacePredType
tau) = IfacePredType
-> ([IfaceForAllBndr], [IfacePredType], IfacePredType)
splitIfaceSigmaTy IfacePredType
iface_ty
        ([IfaceForAllBndr]
req_tvs, IfacePredType
tau') = IfacePredType -> ([IfaceForAllBndr], IfacePredType)
splitIfaceReqForallTy IfacePredType
tau
          -- splitIfaceSigmaTy is recursive, so it will gather the binders after
          -- the theta, i.e.  forall a. theta => forall b. tau
          -- will give you    ([a,b], theta, tau).
          --
          -- This isn't right when it comes to visible forall (see
          --  testsuite/tests/polykinds/T18522-ppr),
          -- so we split off required binders separately,
          -- using splitIfaceReqForallTy.
          --
          -- An alternative solution would be to make splitIfaceSigmaTy
          -- non-recursive (see #18458).
          -- Then it could handle both invisible and required binders, and
          -- splitIfaceReqForallTy wouldn't be necessary here.
    in ShowForAllFlag
-> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
invis_tvs [IfacePredType]
theta (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
       [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [[IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
req_tvs, IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
tau']

pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
   = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitForalls ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_foralls ->
     -- See Note [When to print foralls] in this module.
     Bool -> SDoc -> SDoc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen ((IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall {argf}. VarBndr IfaceBndr argf -> Bool
tv_has_kind_var [IfaceForAllBndr]
tvs
             Bool -> Bool -> Bool
|| (IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall {tv}. VarBndr tv ForAllTyFlag -> Bool
tv_is_required [IfaceForAllBndr]
tvs
             Bool -> Bool -> Bool
|| Bool
print_foralls) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
     [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
   where
     tv_has_kind_var :: VarBndr IfaceBndr argf -> Bool
tv_has_kind_var (Bndr (IfaceTvBndr (FastString
_,IfacePredType
kind)) argf
_)
       = Bool -> Bool
not (IfacePredType -> Bool
ifTypeIsVarFree IfacePredType
kind)
     tv_has_kind_var VarBndr IfaceBndr argf
_ = Bool
False

     tv_is_required :: VarBndr tv ForAllTyFlag -> Bool
tv_is_required = ForAllTyFlag -> Bool
isVisibleForAllTyFlag (ForAllTyFlag -> Bool)
-> (VarBndr tv ForAllTyFlag -> ForAllTyFlag)
-> VarBndr tv ForAllTyFlag
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarBndr tv ForAllTyFlag -> ForAllTyFlag
forall tv argf. VarBndr tv argf -> argf
binderFlag

{-
Note [When to print foralls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We opt to explicitly pretty-print `forall`s if any of the following
criteria are met:

1. -fprint-explicit-foralls is on.

2. A bound type variable has a polymorphic kind. E.g.,

     forall k (a::k). Proxy a -> Proxy a

   Since a's kind mentions a variable k, we print the foralls.

3. A bound type variable is a visible argument (#14238).
   Suppose we are printing the kind of:

     T :: forall k -> k -> Type

   The "forall k ->" notation means that this kind argument is required.
   That is, it must be supplied at uses of T. E.g.,

     f :: T (Type->Type)  Monad -> Int

   So we print an explicit "T :: forall k -> k -> Type",
   because omitting it and printing "T :: k -> Type" would be
   utterly misleading.

   See Note [VarBndrs, ForAllTyBinders, TyConBinders, and visibility]
   in GHC.Core.TyCo.Rep.

N.B. Until now (Aug 2018) we didn't check anything for coercion variables.

Note [Printing foralls in type family instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We use the same criteria as in Note [When to print foralls] to determine
whether a type family instance should be pretty-printed with an explicit
`forall`. Example:

  type family Foo (a :: k) :: k where
    Foo Maybe       = []
    Foo (a :: Type) = Int
    Foo a           = a

Without -fprint-explicit-foralls enabled, this will be pretty-printed as:

type family Foo (a :: k) :: k where
  Foo Maybe = []
  Foo a = Int
  forall k (a :: k). Foo a = a

Note that only the third equation has an explicit forall, since it has a type
variable with a non-Type kind. (If -fprint-explicit-foralls were enabled, then
the second equation would be preceded with `forall a.`.)

There is one tricky point in the implementation: what visibility
do we give the type variables in a type family instance? Type family instances
only store type *variables*, not type variable *binders*, and only the latter
has visibility information. We opt to default the visibility of each of these
type variables to Specified because users can't ever instantiate these
variables manually, so the choice of visibility is only relevant to
pretty-printing. (This is why the `k` in `forall k (a :: k). ...` above is
printed the way it is, even though it wasn't written explicitly in the
original source code.)

We adopt the same strategy for data family instances. Example:

  data family DF (a :: k)
  data instance DF '[a, b] = DFList

That data family instance is pretty-printed as:

  data instance forall j (a :: j) (b :: j). DF '[a, b] = DFList

This is despite that the representation tycon for this data instance (call it
$DF:List) actually has different visibilities for its binders.
However, the visibilities of these binders are utterly irrelevant to the
programmer, who cares only about the specificity of variables in `DF`'s type,
not $DF:List's type. Therefore, we opt to pretty-print all variables in data
family instances as Specified.

Note [Printing promoted type constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this GHCi session (#14343)
    > _ :: Proxy '[ 'True ]
    error:
      Found hole: _ :: Proxy '['True]

This would be bad, because the '[' looks like a character literal.

A similar issue arises if the element is a character literal (#22488)
    ghci> type T = '[ 'x' ]
    ghci> :kind! T
    T :: [Char]
    = '['x']

Solution: in type-level lists and tuples, add a leading space
if the first element is printed with a single quote.
-}


-------------------

-- See equivalent function in "GHC.Core.TyCo.Rep"
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
-- Given a type-level list (t1 ': t2), see if we can print
-- it in list notation [t1, ...].
-- Precondition: Opt_PrintExplicitKinds is off
pprIfaceTyList :: PprPrec -> IfacePredType -> IfacePredType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfacePredType
ty1 IfacePredType
ty2
  = case IfacePredType -> ([IfacePredType], Maybe IfacePredType)
gather IfacePredType
ty2 of
      ([IfacePredType]
arg_tys, Maybe IfacePredType
Nothing)
        ->
        (SDocContext -> SDoc) -> SDoc
sdocWithContext ((SDocContext -> SDoc) -> SDoc) -> (SDocContext -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx ->
          let
            items :: [IfacePredType]
items  = IfacePredType
ty1IfacePredType -> [IfacePredType] -> [IfacePredType]
forall a. a -> [a] -> [a]
:[IfacePredType]
arg_tys
            eos :: IsEmptyOrSingleton
eos    = [IfacePredType] -> IsEmptyOrSingleton
forall a. [a] -> IsEmptyOrSingleton
isListEmptyOrSingleton [IfacePredType]
items
            ticked :: Bool
ticked = PprStyle -> QueryPromotionTick
promTick (SDocContext -> PprStyle
sdocStyle SDocContext
ctx) (IsEmptyOrSingleton -> PromotedItem
PromotedItemListSyntax IsEmptyOrSingleton
eos)
            (SDoc
preBracket, SDoc -> SDoc
postBracket) =
              if Bool
ticked
              then (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\'', SDoc -> SDoc
spaceIfSingleQuote)
              else (SDoc
forall doc. IsOutput doc => doc
empty, SDoc -> SDoc
forall a. a -> a
id)
          in
            SDoc
preBracket SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (SDoc -> SDoc
postBracket ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep
                          (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((IfacePredType -> SDoc) -> [IfacePredType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
topPrec) [IfacePredType]
items))))
      ([IfacePredType]
arg_tys, Just IfacePredType
tl)
        -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
funPrec IfacePredType
ty1)
           Int
2 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep [ SDoc
forall doc. IsLine doc => doc
colon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
funPrec IfacePredType
ty | IfacePredType
ty <- [IfacePredType]
arg_tys [IfacePredType] -> [IfacePredType] -> [IfacePredType]
forall a. [a] -> [a] -> [a]
++ [IfacePredType
tl]])
  where
    gather :: IfaceType -> ([IfaceType], Maybe IfaceType)
     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl
    gather :: IfacePredType -> ([IfacePredType], Maybe IfacePredType)
gather (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
      , IA_Arg IfacePredType
_ ForAllTyFlag
argf (IA_Arg IfacePredType
ty1 ForAllTyFlag
Required (IA_Arg IfacePredType
ty2 ForAllTyFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
      , ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
argf
      , ([IfacePredType]
args, Maybe IfacePredType
tl) <- IfacePredType -> ([IfacePredType], Maybe IfacePredType)
gather IfacePredType
ty2
      = (IfacePredType
ty1IfacePredType -> [IfacePredType] -> [IfacePredType]
forall a. a -> [a] -> [a]
:[IfacePredType]
args, Maybe IfacePredType
tl)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
nilDataConKey
      = ([], Maybe IfacePredType
forall a. Maybe a
Nothing)
    gather IfacePredType
ty = ([], IfacePredType -> Maybe IfacePredType
forall a. a -> Maybe a
Just IfacePredType
ty)

pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp PprPrec
prec IfaceTyCon
tc IfaceAppArgs
args = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
prec IfaceTyCon
tc IfaceAppArgs
args

pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys =
    (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
    (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintTypeAbbreviations ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_type_abbreviations ->
    (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->

    if | IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ipClassKey
       , IA_Arg (IfaceLitTy (IfaceStrTyLit FastString
n))
                ForAllTyFlag
Required (IA_Arg IfacePredType
ty ForAllTyFlag
Required IfaceAppArgs
IA_Nil) <- IfaceAppArgs
tys
       -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec
         (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'?' SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> FastString -> SDoc
forall doc. IsLine doc => FastString -> doc
ftext FastString
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"::" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
topPrec IfacePredType
ty

       | IfaceTupleTyCon Int
arity TupleSort
sort <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
       , Bool -> Bool
not Bool
debug
       , Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> Int
ifaceVisAppArgsLength IfaceAppArgs
tys
       -> PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
sort (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
           -- NB: pprTuple requires a saturated tuple.

       | IfaceSumTyCon Int
arity <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
       , Bool -> Bool
not Bool
debug
       , Int
arity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> Int
ifaceVisAppArgsLength IfaceAppArgs
tys
       -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys
           -- NB: pprSum requires a saturated unboxed sum.

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
       , Bool
False <- Bool
print_kinds
       , IA_Arg IfacePredType
_ ForAllTyFlag
argf (IA_Arg IfacePredType
ty1 ForAllTyFlag
Required (IA_Arg IfacePredType
ty2 ForAllTyFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
       , ForAllTyFlag -> Bool
isInvisibleForAllTyFlag ForAllTyFlag
argf
       -> PprPrec -> IfacePredType -> IfacePredType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfacePredType
ty1 IfacePredType
ty2

       | IfacePredType -> Bool
isIfaceLiftedTypeKind (IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec

       | IfacePredType -> Bool
isIfaceConstraintKind (IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> IfExtName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IfExtName
constraintKindTyConName

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
fUNTyConKey
       , IA_Arg (IfaceTyConApp IfaceTyCon
rep IfaceAppArgs
IA_Nil) ForAllTyFlag
Required IfaceAppArgs
args <- IfaceAppArgs
tys
       , IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
manyDataConKey
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens SDoc
arrow) (((IfacePredType, ForAllTyFlag) -> SDoc)
-> [(IfacePredType, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfacePredType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) ([(IfacePredType, ForAllTyFlag)] -> [SDoc])
-> [(IfacePredType, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
          IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags (IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)])
-> IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
forall a b. (a -> b) -> a -> b
$
          PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
args)
          -- Use appArgsIfaceTypesForAllTyFlags to print invisible arguments
          -- correctly (#19310)

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
errorMessageTypeErrorFamKey
       , Bool -> Bool
not Bool
debug
         -- Suppress detail unless you _really_ want to see
       -> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"(TypeError ...)"

       | Just SDoc
doc <- PprPrec -> IfaceTyCon -> [IfacePredType] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc (IfaceAppArgs -> [IfacePredType]
appArgsIfaceTypes IfaceAppArgs
tys)
       -> SDoc
doc

       | Bool
otherwise
       -> (PprPrec -> (IfacePredType, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfacePredType, ForAllTyFlag)] -> SDoc
forall a.
(PprPrec -> (a, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (IfacePredType, ForAllTyFlag) -> SDoc
ppr_app_arg PprPrec
ctxt_prec IfaceTyCon
tc ([(IfacePredType, ForAllTyFlag)] -> SDoc)
-> [(IfacePredType, ForAllTyFlag)] -> SDoc
forall a b. (a -> b) -> a -> b
$
          IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
appArgsIfaceTypesForAllTyFlags (IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)])
-> IfaceAppArgs -> [(IfacePredType, ForAllTyFlag)]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
tys
  where
    info :: IfaceTyConInfo
info = IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc

ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocStarIsType ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
   Bool
False -> IfExtName -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IfExtName
liftedTypeKindTyConName
   Bool
True  -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
starPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'★') (Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'*')

-- | Pretty-print a type-level equality.
-- Returns (Just doc) if the argument is a /saturated/ application
-- of   eqTyCon          (~)
--      eqPrimTyCon      (~#)
--      eqReprPrimTyCon  (~R#)
--      heqTyCon         (~~)
--
-- See Note [Equality predicates in IfaceType]
-- and Note [The equality types story] in GHC.Builtin.Types.Prim
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality :: PprPrec -> IfaceTyCon -> [IfacePredType] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc [IfacePredType]
args
  | Bool
hetero_eq_tc
  , [IfacePredType
k1, IfacePredType
k2, IfacePredType
t1, IfacePredType
t2] <- [IfacePredType]
args
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfacePredType, IfacePredType, IfacePredType, IfacePredType)
-> SDoc
print_equality (IfacePredType
k1, IfacePredType
k2, IfacePredType
t1, IfacePredType
t2)

  | Bool
hom_eq_tc
  , [IfacePredType
k, IfacePredType
t1, IfacePredType
t2] <- [IfacePredType]
args
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfacePredType, IfacePredType, IfacePredType, IfacePredType)
-> SDoc
print_equality (IfacePredType
k, IfacePredType
k, IfacePredType
t1, IfacePredType
t2)

  | Bool
otherwise
  = Maybe SDoc
forall a. Maybe a
Nothing
  where
    homogeneous :: Bool
homogeneous = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey -- (~)
               Bool -> Bool -> Bool
|| Bool
hetero_tc_used_homogeneously
      where
        hetero_tc_used_homogeneously :: Bool
hetero_tc_used_homogeneously
          = case IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort (IfaceTyConInfo -> IfaceTyConSort)
-> IfaceTyConInfo -> IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc of
                          IfaceTyConSort
IfaceEqualityTyCon -> Bool
True
                          IfaceTyConSort
_other             -> Bool
False
             -- True <=> a heterogeneous equality whose arguments
             --          are (in this case) of the same kind

    tc_name :: IfExtName
tc_name = IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc
    pp :: PprPrec -> IfacePredType -> SDoc
pp = PprPrec -> IfacePredType -> SDoc
ppr_ty
    hom_eq_tc :: Bool
hom_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqTyConKey            -- (~)
    hetero_eq_tc :: Bool
hetero_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey     -- (~#)
                Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey -- (~R#)
                Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey        -- (~~)
    nominal_eq_tc :: Bool
nominal_eq_tc = IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
heqTyConKey       -- (~~)
                 Bool -> Bool -> Bool
|| IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey    -- (~#)
    print_equality :: (IfacePredType, IfacePredType, IfacePredType, IfacePredType)
-> SDoc
print_equality (IfacePredType, IfacePredType, IfacePredType, IfacePredType)
args =
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintEqualityRelations ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_eqs ->
        (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style  ->
        (Bool -> SDoc) -> SDoc
forall doc. IsOutput doc => (Bool -> doc) -> doc
getPprDebug      ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug  ->
        (IfacePredType, IfacePredType, IfacePredType, IfacePredType)
-> Bool -> Bool -> SDoc
print_equality' (IfacePredType, IfacePredType, IfacePredType, IfacePredType)
args Bool
print_kinds
          (Bool
print_eqs Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| Bool
debug)

    print_equality' :: (IfacePredType, IfacePredType, IfacePredType, IfacePredType)
-> Bool -> Bool -> SDoc
print_equality' (IfacePredType
ki1, IfacePredType
ki2, IfacePredType
ty1, IfacePredType
ty2) Bool
print_kinds Bool
print_eqs
      | -- If -fprint-equality-relations is on, just print the original TyCon
        Bool
print_eqs
      = SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)

      | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2)
        --                 or unlifted equality      (ty1 ~# ty2)
        Bool
nominal_eq_tc, Bool
homogeneous
      = SDoc -> SDoc
ppr_infix_eq (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"~")

      | -- Heterogeneous use of unlifted equality (ty1 ~# ty2)
        Bool -> Bool
not Bool
homogeneous
      = SDoc -> SDoc
ppr_infix_eq (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
heqTyCon)

      | -- Homogeneous use of representational unlifted equality (ty1 ~R# ty2)
        IfExtName
tc_name IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey, Bool
homogeneous
      = let ki :: [SDoc]
ki | Bool
print_kinds = [PprPrec -> IfacePredType -> SDoc
pp PprPrec
appPrec IfacePredType
ki1]
               | Bool
otherwise   = []
        in PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
coercibleTyCon)
                            ([SDoc]
ki [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [PprPrec -> IfacePredType -> SDoc
pp PprPrec
appPrec IfacePredType
ty1, PprPrec -> IfacePredType -> SDoc
pp PprPrec
appPrec IfacePredType
ty2])

        -- The other cases work as you'd expect
      | Bool
otherwise
      = SDoc -> SDoc
ppr_infix_eq (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)
      where
        ppr_infix_eq :: SDoc -> SDoc
        ppr_infix_eq :: SDoc -> SDoc
ppr_infix_eq SDoc
eq_op = PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
eq_op
                               (IfacePredType -> IfacePredType -> SDoc
pp_ty_ki IfacePredType
ty1 IfacePredType
ki1) (IfacePredType -> IfacePredType -> SDoc
pp_ty_ki IfacePredType
ty2 IfacePredType
ki2)
          where
            pp_ty_ki :: IfacePredType -> IfacePredType -> SDoc
pp_ty_ki IfacePredType
ty IfacePredType
ki
              | Bool
print_kinds
              = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfacePredType -> SDoc
pp PprPrec
topPrec IfacePredType
ty SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfacePredType -> SDoc
pp PprPrec
opPrec IfacePredType
ki)
              | Bool
otherwise
              = PprPrec -> IfacePredType -> SDoc
pp PprPrec
opPrec IfacePredType
ty


pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
ctxt_prec IfaceTyCon
tc [IfaceCoercion]
tys =
  (PprPrec -> (IfaceCoercion, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceCoercion, ForAllTyFlag)] -> SDoc
forall a.
(PprPrec -> (a, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc
ppr_iface_tc_app (\PprPrec
prec (IfaceCoercion
co, ForAllTyFlag
_) -> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
prec IfaceCoercion
co) PprPrec
ctxt_prec IfaceTyCon
tc
    ((IfaceCoercion -> (IfaceCoercion, ForAllTyFlag))
-> [IfaceCoercion] -> [(IfaceCoercion, ForAllTyFlag)]
forall a b. (a -> b) -> [a] -> [b]
map (, ForAllTyFlag
Required) [IfaceCoercion]
tys)
    -- We are trying to re-use ppr_iface_tc_app here, which requires its
    -- arguments to be accompanied by visibilities. But visibility is
    -- irrelevant when printing coercions, so just default everything to
    -- Required.

-- | Pretty-prints an application of a type constructor to some arguments
-- (whose visibilities are known). This is polymorphic (over @a@) since we use
-- this function to pretty-print two different things:
--
-- 1. Types (from `pprTyTcApp'`)
--
-- 2. Coercions (from 'pprIfaceCoTcApp')
ppr_iface_tc_app :: (PprPrec -> (a, ForAllTyFlag) -> SDoc)
                 -> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc

ppr_iface_tc_app :: forall a.
(PprPrec -> (a, ForAllTyFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ForAllTyFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
ctxt_prec IfaceTyCon
tc [(a, ForAllTyFlag)]
tys =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocListTuplePuns ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
listTuplePuns ->
  if | Bool
listTuplePuns, IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
listTyConKey, [(a, ForAllTyFlag)
ty] <- [(a, ForAllTyFlag)]
tys
     -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
topPrec (a, ForAllTyFlag)
ty)

     | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedTypeKindTyConKey
     -> PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec

     | Bool -> Bool
not (OccName -> Bool
isSymOcc (IfExtName -> OccName
nameOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)))
     -> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc) (((a, ForAllTyFlag) -> SDoc) -> [(a, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
appPrec) [(a, ForAllTyFlag)]
tys)

     | [ ty1 :: (a, ForAllTyFlag)
ty1@(a
_, ForAllTyFlag
Required), ty2 :: (a, ForAllTyFlag)
ty2@(a
_, ForAllTyFlag
Required) ] <- [(a, ForAllTyFlag)]
tys
         -- Infix, two visible arguments (we know nothing of precedence though).
         -- Don't apply this special case if one of the arguments is invisible,
         -- lest we print something like (@LiftedRep -> @LiftedRep) (#15941).
     -> PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc) (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
opPrec (a, ForAllTyFlag)
ty1) (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
opPrec (a, ForAllTyFlag)
ty2)

     | Bool
otherwise
     -> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc)) (((a, ForAllTyFlag) -> SDoc) -> [(a, ForAllTyFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ForAllTyFlag) -> SDoc
pp PprPrec
appPrec) [(a, ForAllTyFlag)]
tys)

-- | Pretty-print an unboxed sum type. The sum should be saturated:
-- as many visible arguments as the arity of the sum.
--
-- NB: this always strips off the invisible 'RuntimeRep' arguments,
-- even with `-fprint-explicit-runtime-reps` and `-fprint-explicit-kinds`.
pprSum :: PromotionFlag -> IfaceAppArgs -> SDoc
pprSum :: PromotionFlag -> IfaceAppArgs -> SDoc
pprSum PromotionFlag
is_promoted IfaceAppArgs
args
  =   -- drop the RuntimeRep vars.
      -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
    let tys :: [IfacePredType]
tys   = IfaceAppArgs -> [IfacePredType]
appArgsIfaceTypes IfaceAppArgs
args
        args' :: [IfacePredType]
args' = Int -> [IfacePredType] -> [IfacePredType]
forall a. Int -> [a] -> [a]
drop ([IfacePredType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfacePredType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfacePredType]
tys
    in PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
is_promoted
       SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
sumParens ((IfacePredType -> SDoc) -> [IfacePredType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars (PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
topPrec) [IfacePredType]
args')

-- | Pretty-print a tuple type (boxed tuple, constraint tuple, unboxed tuple).
-- The tuple should be saturated: as many visible arguments as the arity of
-- the tuple.
--
-- NB: this always strips off the invisible 'RuntimeRep' arguments,
-- even with `-fprint-explicit-runtime-reps` and `-fprint-explicit-kinds`.
pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
sort PromotionFlag
promoted IfaceAppArgs
args =
  case PromotionFlag
promoted of
    PromotionFlag
IsPromoted
      -> let tys :: [IfacePredType]
tys = IfaceAppArgs -> [IfacePredType]
appArgsIfaceTypes IfaceAppArgs
args
             args' :: [IfacePredType]
args' = Int -> [IfacePredType] -> [IfacePredType]
forall a. Int -> [a] -> [a]
drop ([IfacePredType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfacePredType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfacePredType]
tys
         in [IfacePredType] -> SDoc -> SDoc
ppr_tuple_app [IfacePredType]
args' (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
IsPromoted SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
            TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort (SDoc -> SDoc
spaceIfSingleQuote ((IfacePredType -> SDoc) -> [IfacePredType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfacePredType -> SDoc
pprIfaceType [IfacePredType]
args'))

    PromotionFlag
NotPromoted
      |  TupleSort
ConstraintTuple <- TupleSort
sort
      ,  IfaceAppArgs
IA_Nil <- IfaceAppArgs
args
      -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
sigPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"() :: Constraint"

      | Bool
otherwise
      ->   -- drop the RuntimeRep vars.
           -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
         let tys :: [IfacePredType]
tys   = IfaceAppArgs -> [IfacePredType]
appArgsIfaceTypes IfaceAppArgs
args
             args' :: [IfacePredType]
args' = case TupleSort
sort of
                       TupleSort
UnboxedTuple -> Int -> [IfacePredType] -> [IfacePredType]
forall a. Int -> [a] -> [a]
drop ([IfacePredType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfacePredType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfacePredType]
tys
                       TupleSort
_            -> [IfacePredType]
tys
         in
         [IfacePredType] -> SDoc -> SDoc
ppr_tuple_app [IfacePredType]
args' (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
         PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
promoted SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<>
         TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort ((IfacePredType -> SDoc) -> [IfacePredType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfacePredType -> SDoc
pprIfaceType [IfacePredType]
args')
  where
    ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
    ppr_tuple_app :: [IfacePredType] -> SDoc -> SDoc
ppr_tuple_app [IfacePredType]
args_wo_runtime_reps SDoc
ppr_args_w_parens
        -- Special-case unary boxed tuples so that they are pretty-printed as
        -- `Solo x`, not `(x)`
      | [IfacePredType
_] <- [IfacePredType]
args_wo_runtime_reps
      , TupleSort
BoxedTuple <- TupleSort
sort
      = let solo_tc_info :: IfaceTyConInfo
solo_tc_info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo PromotionFlag
promoted IfaceTyConSort
IfaceNormalTyCon
            tupleName :: Int -> IfExtName
tupleName = case PromotionFlag
promoted of
              PromotionFlag
IsPromoted -> Boxity -> Int -> IfExtName
tupleDataConName (TupleSort -> Boxity
tupleSortBoxity TupleSort
sort)
              PromotionFlag
NotPromoted -> TupleSort -> Int -> IfExtName
tupleTyConName TupleSort
sort
            solo_tc :: IfaceTyCon
solo_tc = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon (Int -> IfExtName
tupleName Int
1) IfaceTyConInfo
solo_tc_info in
        PprPrec -> IfacePredType -> SDoc
pprPrecIfaceType PprPrec
ctxt_prec (IfacePredType -> SDoc) -> IfacePredType -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
solo_tc IfaceAppArgs
args
      | Bool
otherwise
      = SDoc
ppr_args_w_parens

pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit (IfaceNumTyLit Integer
n) = Integer -> SDoc
forall doc. IsLine doc => Integer -> doc
integer Integer
n
pprIfaceTyLit (IfaceStrTyLit FastString
n) = String -> SDoc
forall doc. IsLine doc => String -> doc
text (FastString -> String
forall a. Show a => a -> String
show FastString
n)
pprIfaceTyLit (IfaceCharTyLit Char
c) = String -> SDoc
forall doc. IsLine doc => String -> doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)

pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
pprIfaceCoercion :: IfaceCoercion -> SDoc
pprIfaceCoercion = PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec
pprParendIfaceCoercion :: IfaceCoercion -> SDoc
pprParendIfaceCoercion = PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
appPrec

ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
_         (IfaceReflCo IfacePredType
ty) = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
Nominal
ppr_co PprPrec
_         (IfaceGReflCo Role
r IfacePredType
ty IfaceMCoercion
IfaceMRefl)
  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceGReflCo Role
r IfacePredType
ty (IfaceMCo IfaceCoercion
co))
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec
    (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"GRefl" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfacePredType -> SDoc
pprParendIfaceType IfacePredType
ty) [IfaceCoercion
co]

ppr_co PprPrec
ctxt_prec (IfaceFunCo Role
r IfaceCoercion
co_mult IfaceCoercion
co1 IfaceCoercion
co2)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co_mult IfaceCoercion
co2)
  where
    ppr_fun_tail :: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co_mult1 (IfaceFunCo Role
r IfaceCoercion
co_mult2 IfaceCoercion
co1 IfaceCoercion
co2)
      = (IfaceCoercion -> SDoc
ppr_arrow IfaceCoercion
co_mult1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1)
        SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co_mult2 IfaceCoercion
co2
    ppr_fun_tail IfaceCoercion
co_mult1 IfaceCoercion
other_co
      = [IfaceCoercion -> SDoc
ppr_arrow IfaceCoercion
co_mult1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]

    ppr_arrow :: IfaceCoercion -> SDoc
ppr_arrow = (IfaceCoercion -> Maybe IfaceTyCon,
 PprPrec -> IfaceCoercion -> SDoc)
-> FunTyFlag -> IfaceCoercion -> SDoc
forall a.
(a -> Maybe IfaceTyCon, PprPrec -> a -> SDoc)
-> FunTyFlag -> a -> SDoc
pprArrow (IfaceCoercion -> Maybe IfaceTyCon
mb_conc, PprPrec -> IfaceCoercion -> SDoc
ppr_co) FunTyFlag
visArgTypeLike
    mb_conc :: IfaceCoercion -> Maybe IfaceTyCon
mb_conc (IfaceTyConAppCo Role
_ IfaceTyCon
tc [IfaceCoercion]
_) = IfaceTyCon -> Maybe IfaceTyCon
forall a. a -> Maybe a
Just IfaceTyCon
tc
    mb_conc IfaceCoercion
_                        = Maybe IfaceTyCon
forall a. Maybe a
Nothing

ppr_co PprPrec
_         (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos)
  = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
topPrec IfaceTyCon
tc [IfaceCoercion]
cos) SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceAppCo IfaceCoercion
co1 IfaceCoercion
co2)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co2
ppr_co PprPrec
ctxt_prec co :: IfaceCoercion
co@(IfaceForAllCo {})
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [(FastString, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(FastString, IfaceCoercion)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
  where
    ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
inner_co) = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co

    split_co :: IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co (IfaceForAllCo (IfaceTvBndr (FastString
name, IfacePredType
_)) IfaceCoercion
kind_co IfaceCoercion
co')
      = let ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((FastString
name,IfaceCoercion
kind_co)(FastString, IfaceCoercion)
-> [(FastString, IfaceCoercion)] -> [(FastString, IfaceCoercion)]
forall a. a -> [a] -> [a]
:[(FastString, IfaceCoercion)]
tvs,IfaceCoercion
co'')
    split_co (IfaceForAllCo (IfaceIdBndr (IfacePredType
_, FastString
name, IfacePredType
_)) IfaceCoercion
kind_co IfaceCoercion
co')
      = let ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
co'') = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co' in ((FastString
name,IfaceCoercion
kind_co)(FastString, IfaceCoercion)
-> [(FastString, IfaceCoercion)] -> [(FastString, IfaceCoercion)]
forall a. a -> [a] -> [a]
:[(FastString, IfaceCoercion)]
tvs,IfaceCoercion
co'')
    split_co IfaceCoercion
co' = ([], IfaceCoercion
co')

-- Why these three? See Note [Free tyvars in IfaceType]
ppr_co PprPrec
_ (IfaceFreeCoVar CoVar
covar) = CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
covar
ppr_co PprPrec
_ (IfaceCoVarCo FastString
covar)   = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
covar
ppr_co PprPrec
_ (IfaceHoleCo CoVar
covar)    = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
braces (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
covar)

ppr_co PprPrec
_ (IfaceUnivCo IfaceUnivCoProv
prov Role
role IfacePredType
ty1 IfacePredType
ty2)
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Univ" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> (SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [ Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
role SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv IfaceUnivCoProv
prov
          , SDoc
dcolon SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+>  IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty1 SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfacePredType
ty2 ])

ppr_co PprPrec
ctxt_prec (IfaceInstCo IfaceCoercion
co IfaceCoercion
ty)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Inst" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
                        SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
ty

ppr_co PprPrec
ctxt_prec (IfaceAxiomRuleCo FastString
tc [IfaceCoercion]
cos)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([IfaceCoercion] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [IfaceCoercion]
cos)

ppr_co PprPrec
ctxt_prec (IfaceAxiomInstCo IfExtName
n Int
i [IfaceCoercion]
cos)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfExtName
n SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
i)) [IfaceCoercion]
cos
ppr_co PprPrec
ctxt_prec (IfaceSymCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Sym") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2)
    -- chain nested TransCo
  = let ppr_trans :: IfaceCoercion -> [SDoc]
ppr_trans (IfaceTransCo IfaceCoercion
c1 IfaceCoercion
c2) = SDoc
forall doc. IsLine doc => doc
semi SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
c1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_trans IfaceCoercion
c2
        ppr_trans IfaceCoercion
c                    = [SDoc
forall doc. IsLine doc => doc
semi SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
opPrec IfaceCoercion
c]
    in PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
        [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_trans IfaceCoercion
co2)
ppr_co PprPrec
ctxt_prec (IfaceSelCo CoSel
d IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SelCo:" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> CoSel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoSel
d) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceLRCo LeftOrRight
lr IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (LeftOrRight -> SDoc
forall a. Outputable a => a -> SDoc
ppr LeftOrRight
lr) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceSubCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Sub") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceKindCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Kind") [IfaceCoercion
co]

ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec SDoc
doc [IfaceCoercion]
cos
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec
               ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep [SDoc
doc, Int -> SDoc -> SDoc
nest Int
4 ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
sep ((IfaceCoercion -> SDoc) -> [IfaceCoercion] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceCoercion -> SDoc
pprParendIfaceCoercion [IfaceCoercion]
cos))])

ppr_role :: Role -> SDoc
ppr_role :: Role -> SDoc
ppr_role Role
r = SDoc
forall doc. IsLine doc => doc
underscore SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
pp_role
  where pp_role :: SDoc
pp_role = case Role
r of
                    Role
Nominal          -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'N'
                    Role
Representational -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'R'
                    Role
Phantom          -> Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'P'

------------------
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv (IfacePhantomProv IfaceCoercion
co)
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"phantom" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfaceProofIrrelProv IfaceCoercion
co)
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"irrel" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfacePluginProv String
s)
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"plugin" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
doubleQuotes (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
s)
pprIfaceUnivCoProv (IfaceCorePrepProv Bool
_)
  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CorePrep"

-------------------
instance Outputable IfaceTyCon where
  ppr :: IfaceTyCon -> SDoc
ppr IfaceTyCon
tc = IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)

instance Outputable IfaceTyConInfo where
  ppr :: IfaceTyConInfo -> SDoc
ppr (IfaceTyConInfo { ifaceTyConIsPromoted :: IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted = PromotionFlag
prom
                      , ifaceTyConSort :: IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort       = IfaceTyConSort
sort })
    = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
angleBrackets (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ PromotionFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr PromotionFlag
prom SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc
forall doc. IsLine doc => doc
comma SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> IfaceTyConSort -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyConSort
sort

pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc =
  (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
    let
      name :: OccName
name   = IfExtName -> OccName
forall a. NamedThing a => a -> OccName
getOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)
      ticked :: Bool
ticked =
        case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted (IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc) of
          PromotionFlag
NotPromoted -> Bool
False
          PromotionFlag
IsPromoted  -> PprStyle -> QueryPromotionTick
promTick PprStyle
sty (OccName -> PromotedItem
PromotedItemDataCon OccName
name)
    in
      if Bool
ticked
      then Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\''
      else SDoc
forall doc. IsOutput doc => doc
empty

pprPromotionQuoteI  :: PromotionFlag -> SDoc
pprPromotionQuoteI :: PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
NotPromoted = SDoc
forall doc. IsOutput doc => doc
empty
pprPromotionQuoteI PromotionFlag
IsPromoted  = Char -> SDoc
forall doc. IsLine doc => Char -> doc
char Char
'\''

instance Outputable IfaceCoercion where
  ppr :: IfaceCoercion -> SDoc
ppr = IfaceCoercion -> SDoc
pprIfaceCoercion

instance Binary IfaceTyCon where
   put_ :: BinHandle -> IfaceTyCon -> IO ()
put_ BinHandle
bh (IfaceTyCon IfExtName
n IfaceTyConInfo
i) = BinHandle -> IfExtName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
n IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceTyConInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyConInfo
i

   get :: BinHandle -> IO IfaceTyCon
get BinHandle
bh = do IfExtName
n <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
               IfaceTyConInfo
i <- BinHandle -> IO IfaceTyConInfo
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
               IfaceTyCon -> IO IfaceTyCon
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
n IfaceTyConInfo
i)

instance Binary IfaceTyConSort where
   put_ :: BinHandle -> IfaceTyConSort -> IO ()
put_ BinHandle
bh IfaceTyConSort
IfaceNormalTyCon             = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
   put_ BinHandle
bh (IfaceTupleTyCon Int
arity TupleSort
sort) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> TupleSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
sort
   put_ BinHandle
bh (IfaceSumTyCon Int
arity)        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity
   put_ BinHandle
bh IfaceTyConSort
IfaceEqualityTyCon           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3

   get :: BinHandle -> IO IfaceTyConSort
get BinHandle
bh = do
       Word8
n <- BinHandle -> IO Word8
getByte BinHandle
bh
       case Word8
n of
         Word8
0 -> IfaceTyConSort -> IO IfaceTyConSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
         Word8
1 -> Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon (Int -> TupleSort -> IfaceTyConSort)
-> IO Int -> IO (TupleSort -> IfaceTyConSort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (TupleSort -> IfaceTyConSort)
-> IO TupleSort -> IO IfaceTyConSort
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO TupleSort
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
         Word8
2 -> Int -> IfaceTyConSort
IfaceSumTyCon (Int -> IfaceTyConSort) -> IO Int -> IO IfaceTyConSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
         Word8
_ -> IfaceTyConSort -> IO IfaceTyConSort
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceEqualityTyCon

instance Binary IfaceTyConInfo where
   put_ :: BinHandle -> IfaceTyConInfo -> IO ()
put_ BinHandle
bh (IfaceTyConInfo PromotionFlag
i IfaceTyConSort
s) = BinHandle -> PromotionFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PromotionFlag
i IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceTyConSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyConSort
s

   get :: BinHandle -> IO IfaceTyConInfo
get BinHandle
bh = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
mkIfaceTyConInfo (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo)
-> IO PromotionFlag -> IO (IfaceTyConSort -> IfaceTyConInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO PromotionFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (IfaceTyConSort -> IfaceTyConInfo)
-> IO IfaceTyConSort -> IO IfaceTyConInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO IfaceTyConSort
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Outputable IfaceTyLit where
  ppr :: IfaceTyLit -> SDoc
ppr = IfaceTyLit -> SDoc
pprIfaceTyLit

instance Binary IfaceTyLit where
  put_ :: BinHandle -> IfaceTyLit -> IO ()
put_ BinHandle
bh (IfaceNumTyLit Integer
n)   = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Integer -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Integer
n
  put_ BinHandle
bh (IfaceStrTyLit FastString
n)   = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
n
  put_ BinHandle
bh (IfaceCharTyLit Char
n)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Char -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Char
n

  get :: BinHandle -> IO IfaceTyLit
get BinHandle
bh =
    do Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
       case Word8
tag of
         Word8
1 -> do { Integer
n <- BinHandle -> IO Integer
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IfaceTyLit
IfaceNumTyLit Integer
n) }
         Word8
2 -> do { FastString
n <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceTyLit
IfaceStrTyLit FastString
n) }
         Word8
3 -> do { Char
n <- BinHandle -> IO Char
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> IfaceTyLit
IfaceCharTyLit Char
n) }
         Word8
_ -> String -> IO IfaceTyLit
forall a. HasCallStack => String -> a
panic (String
"get IfaceTyLit " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

instance Binary IfaceAppArgs where
  put_ :: BinHandle -> IfaceAppArgs -> IO ()
put_ BinHandle
bh IfaceAppArgs
tk =
    case IfaceAppArgs
tk of
      IA_Arg IfacePredType
t ForAllTyFlag
a IfaceAppArgs
ts -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
t IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ForAllTyFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ForAllTyFlag
a IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
ts
      IfaceAppArgs
IA_Nil        -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1

  get :: BinHandle -> IO IfaceAppArgs
get BinHandle
bh =
    do Word8
c <- BinHandle -> IO Word8
getByte BinHandle
bh
       case Word8
c of
         Word8
0 -> do
           IfacePredType
t  <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           ForAllTyFlag
a  <- BinHandle -> IO ForAllTyFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           IfaceAppArgs
ts <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           IfaceAppArgs -> IO IfaceAppArgs
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceAppArgs -> IO IfaceAppArgs)
-> IfaceAppArgs -> IO IfaceAppArgs
forall a b. (a -> b) -> a -> b
$! IfacePredType -> ForAllTyFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfacePredType
t ForAllTyFlag
a IfaceAppArgs
ts
         Word8
1 -> IfaceAppArgs -> IO IfaceAppArgs
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceAppArgs
IA_Nil
         Word8
_ -> String -> IO IfaceAppArgs
forall a. HasCallStack => String -> a
panic (String
"get IfaceAppArgs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
c)

-------------------

-- Some notes about printing contexts
--
-- In the event that we are printing a singleton context (e.g. @Eq a@) we can
-- omit parentheses. However, we must take care to set the precedence correctly
-- to opPrec, since something like @a :~: b@ must be parenthesized (see
-- #9658).
--
-- When printing a larger context we use 'fsep' instead of 'sep' so that
-- the context doesn't get displayed as a giant column. Rather than,
--  instance (Eq a,
--            Eq b,
--            Eq c,
--            Eq d,
--            Eq e,
--            Eq f,
--            Eq g,
--            Eq h,
--            Eq i,
--            Eq j,
--            Eq k,
--            Eq l) =>
--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)
--
-- we want
--
--  instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i,
--            Eq j, Eq k, Eq l) =>
--           Eq (a, b, c, d, e, f, g, h, i, j, k, l)



-- | Prints "(C a, D b) =>", including the arrow.
-- Used when we want to print a context in a type, so we
-- use 'funPrec' to decide whether to parenthesise a singleton
-- predicate; e.g.   Num a => a -> a
pprIfaceContextArr :: [IfacePredType] -> SDoc
pprIfaceContextArr :: [IfacePredType] -> SDoc
pprIfaceContextArr []     = SDoc
forall doc. IsOutput doc => doc
empty
pprIfaceContextArr [IfacePredType
pred] = PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
funPrec IfacePredType
pred SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow
pprIfaceContextArr [IfacePredType]
preds  = [IfacePredType] -> SDoc
ppr_parend_preds [IfacePredType]
preds SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc
darrow

-- | Prints a context or @()@ if empty
-- You give it the context precedence
pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
pprIfaceContext :: PprPrec -> [IfacePredType] -> SDoc
pprIfaceContext PprPrec
_    []     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"()"
pprIfaceContext PprPrec
prec [IfacePredType
pred] = PprPrec -> IfacePredType -> SDoc
ppr_ty PprPrec
prec IfacePredType
pred
pprIfaceContext PprPrec
_    [IfacePredType]
preds  = [IfacePredType] -> SDoc
ppr_parend_preds [IfacePredType]
preds

ppr_parend_preds :: [IfacePredType] -> SDoc
ppr_parend_preds :: [IfacePredType] -> SDoc
ppr_parend_preds [IfacePredType]
preds = SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens ([SDoc] -> SDoc
forall doc. IsLine doc => [doc] -> doc
fsep (SDoc -> [SDoc] -> [SDoc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate SDoc
forall doc. IsLine doc => doc
comma ((IfacePredType -> SDoc) -> [IfacePredType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfacePredType -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfacePredType]
preds)))

instance Binary IfaceType where
    put_ :: BinHandle -> IfacePredType -> IO ()
put_ BinHandle
_ (IfaceFreeTyVar CoVar
tv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeTyVar" (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
tv)

    put_ BinHandle
bh (IfaceForAllTy IfaceForAllBndr
aa IfacePredType
ab) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> IfaceForAllBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceForAllBndr
aa
            BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
ab
    put_ BinHandle
bh (IfaceTyVar FastString
ad) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ad
    put_ BinHandle
bh (IfaceAppTy IfacePredType
ae IfaceAppArgs
af) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
            BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
ae
            BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
af
    put_ BinHandle
bh (IfaceFunTy FunTyFlag
af IfacePredType
aw IfacePredType
ag IfacePredType
ah) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
            BinHandle -> FunTyFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FunTyFlag
af
            BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
aw
            BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
ag
            BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
ah
    put_ BinHandle
bh (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
      = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5; BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
tc; BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
tys }
    put_ BinHandle
bh (IfaceCastTy IfacePredType
a IfaceCoercion
b)
      = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6; BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
a; BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b }
    put_ BinHandle
bh (IfaceCoercionTy IfaceCoercion
a)
      = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7; BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a }
    put_ BinHandle
bh (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys)
      = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8; BinHandle -> TupleSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
s; BinHandle -> PromotionFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh PromotionFlag
i; BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
tys }
    put_ BinHandle
bh (IfaceLitTy IfaceTyLit
n)
      = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9; BinHandle -> IfaceTyLit -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyLit
n }

    get :: BinHandle -> IO IfacePredType
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do IfaceForAllBndr
aa <- BinHandle -> IO IfaceForAllBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType
ab <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceForAllBndr -> IfacePredType -> IfacePredType
IfaceForAllTy IfaceForAllBndr
aa IfacePredType
ab)
              Word8
1 -> do FastString
ad <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfacePredType
IfaceTyVar FastString
ad)
              Word8
2 -> do IfacePredType
ae <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceAppArgs
af <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfacePredType -> IfaceAppArgs -> IfacePredType
IfaceAppTy IfacePredType
ae IfaceAppArgs
af)
              Word8
3 -> do FunTyFlag
af <- BinHandle -> IO FunTyFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType
aw <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType
ag <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType
ah <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FunTyFlag
-> IfacePredType -> IfacePredType -> IfacePredType -> IfacePredType
IfaceFunTy FunTyFlag
af IfacePredType
aw IfacePredType
ag IfacePredType
ah)
              Word8
5 -> do { IfaceTyCon
tc <- BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceAppArgs
tys <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      ; IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyCon -> IfaceAppArgs -> IfacePredType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) }
              Word8
6 -> do { IfacePredType
a <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      ; IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfacePredType -> IfaceCoercion -> IfacePredType
IfaceCastTy IfacePredType
a IfaceCoercion
b) }
              Word8
7 -> do { IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      ; IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfacePredType
IfaceCoercionTy IfaceCoercion
a) }

              Word8
8 -> do { TupleSort
s <- BinHandle -> IO TupleSort
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; PromotionFlag
i <- BinHandle -> IO PromotionFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceAppArgs
tys <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      ; IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TupleSort -> PromotionFlag -> IfaceAppArgs -> IfacePredType
IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) }
              Word8
_  -> do IfaceTyLit
n <- BinHandle -> IO IfaceTyLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                       IfacePredType -> IO IfacePredType
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyLit -> IfacePredType
IfaceLitTy IfaceTyLit
n)

instance Binary IfaceMCoercion where
  put_ :: BinHandle -> IfaceMCoercion -> IO ()
put_ BinHandle
bh IfaceMCoercion
IfaceMRefl =
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
  put_ BinHandle
bh (IfaceMCo IfaceCoercion
co) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
co

  get :: BinHandle -> IO IfaceMCoercion
get BinHandle
bh = do
    Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
tag of
         Word8
1 -> IfaceMCoercion -> IO IfaceMCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceMCoercion
IfaceMRefl
         Word8
2 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                 IfaceMCoercion -> IO IfaceMCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceMCoercion -> IO IfaceMCoercion)
-> IfaceMCoercion -> IO IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceMCoercion
IfaceMCo IfaceCoercion
a
         Word8
_ -> String -> IO IfaceMCoercion
forall a. HasCallStack => String -> a
panic (String
"get IfaceMCoercion " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

instance Binary IfaceCoercion where
  put_ :: BinHandle -> IfaceCoercion -> IO ()
put_ BinHandle
bh (IfaceReflCo IfacePredType
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
          BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
a
  put_ BinHandle
bh (IfaceGReflCo Role
a IfacePredType
b IfaceMCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
          BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
          BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
b
          BinHandle -> IfaceMCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceMCoercion
c
  put_ BinHandle
bh (IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
          BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
w
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
  put_ BinHandle
bh (IfaceTyConAppCo Role
a IfaceTyCon
b [IfaceCoercion]
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
          BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
          BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
b
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
  put_ BinHandle
bh (IfaceAppCo IfaceCoercion
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceForAllCo IfaceBndr
a IfaceCoercion
b IfaceCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
          BinHandle -> IfaceBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceBndr
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
  put_ BinHandle
bh (IfaceCoVarCo FastString
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
          BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
  put_ BinHandle
bh (IfaceAxiomInstCo IfExtName
a Int
b [IfaceCoercion]
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
          BinHandle -> IfExtName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
a
          BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
b
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
  put_ BinHandle
bh (IfaceUnivCo IfaceUnivCoProv
a Role
b IfacePredType
c IfacePredType
d) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
9
          BinHandle -> IfaceUnivCoProv -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceUnivCoProv
a
          BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
b
          BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
c
          BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
d
  put_ BinHandle
bh (IfaceSymCo IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
10
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ BinHandle
bh (IfaceTransCo IfaceCoercion
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
11
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceSelCo CoSel
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12
          BinHandle -> CoSel -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CoSel
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceLRCo LeftOrRight
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
13
          BinHandle -> LeftOrRight -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LeftOrRight
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceInstCo IfaceCoercion
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
14
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceKindCo IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
15
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ BinHandle
bh (IfaceSubCo IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
16
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ BinHandle
bh (IfaceAxiomRuleCo FastString
a [IfaceCoercion]
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
17
          BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
b
  put_ BinHandle
_ (IfaceFreeCoVar CoVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeCoVar" (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
cv)
  put_ BinHandle
_  (IfaceHoleCo CoVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceHoleCo" (CoVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr CoVar
cv)
          -- See Note [Holes in IfaceCoercion]

  get :: BinHandle -> IO IfaceCoercion
get BinHandle
bh = do
      Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
      case Word8
tag of
           Word8
1 -> do IfacePredType
a <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfacePredType -> IfaceCoercion
IfaceReflCo IfacePredType
a
           Word8
2 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfacePredType
b <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceMCoercion
c <- BinHandle -> IO IfaceMCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role -> IfacePredType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
a IfacePredType
b IfaceMCoercion
c
           Word8
3 -> do Role
a  <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
w  <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b  <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
c  <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c
           Word8
4 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceTyCon
b <- BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
c <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
a IfaceTyCon
b [IfaceCoercion]
c
           Word8
5 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo IfaceCoercion
a IfaceCoercion
b
           Word8
6 -> do IfaceBndr
a <- BinHandle -> IO IfaceBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
c <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceBndr -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceForAllCo IfaceBndr
a IfaceCoercion
b IfaceCoercion
c
           Word8
7 -> do FastString
a <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ FastString -> IfaceCoercion
IfaceCoVarCo FastString
a
           Word8
8 -> do IfExtName
a <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   Int
b <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
c <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfExtName -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a Int
b [IfaceCoercion]
c
           Word8
9 -> do IfaceUnivCoProv
a <- BinHandle -> IO IfaceUnivCoProv
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   Role
b <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfacePredType
c <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfacePredType
d <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceUnivCoProv
-> Role -> IfacePredType -> IfacePredType -> IfaceCoercion
IfaceUnivCo IfaceUnivCoProv
a Role
b IfacePredType
c IfacePredType
d
           Word8
10-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceSymCo IfaceCoercion
a
           Word8
11-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo IfaceCoercion
a IfaceCoercion
b
           Word8
12-> do CoSel
a <- BinHandle -> IO CoSel
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ CoSel -> IfaceCoercion -> IfaceCoercion
IfaceSelCo CoSel
a IfaceCoercion
b
           Word8
13-> do LeftOrRight
a <- BinHandle -> IO LeftOrRight
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
a IfaceCoercion
b
           Word8
14-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo IfaceCoercion
a IfaceCoercion
b
           Word8
15-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceKindCo IfaceCoercion
a
           Word8
16-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceCoercion
IfaceSubCo IfaceCoercion
a
           Word8
17-> do FastString
a <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
b <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo FastString
a [IfaceCoercion]
b
           Word8
_ -> String -> IO IfaceCoercion
forall a. HasCallStack => String -> a
panic (String
"get IfaceCoercion " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

instance Binary IfaceUnivCoProv where
  put_ :: BinHandle -> IfaceUnivCoProv -> IO ()
put_ BinHandle
bh (IfacePhantomProv IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ BinHandle
bh (IfaceProofIrrelProv IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ BinHandle
bh (IfacePluginProv String
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
          BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
a
  put_ BinHandle
bh (IfaceCorePrepProv Bool
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
          BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a

  get :: BinHandle -> IO IfaceUnivCoProv
get BinHandle
bh = do
      Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
      case Word8
tag of
           Word8
1 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv IfaceCoercion
a
           Word8
2 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv IfaceCoercion
a
           Word8
3 -> do String
a <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ String -> IfaceUnivCoProv
IfacePluginProv String
a
           Word8
4 -> do Bool
a <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IfaceUnivCoProv
IfaceCorePrepProv Bool
a)
           Word8
_ -> String -> IO IfaceUnivCoProv
forall a. HasCallStack => String -> a
panic (String
"get IfaceUnivCoProv " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)


instance Binary (DefMethSpec IfaceType) where
    put_ :: BinHandle -> DefMethSpec IfacePredType -> IO ()
put_ BinHandle
bh DefMethSpec IfacePredType
VanillaDM     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh (GenericDM IfacePredType
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfacePredType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfacePredType
t
    get :: BinHandle -> IO (DefMethSpec IfacePredType)
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> DefMethSpec IfacePredType -> IO (DefMethSpec IfacePredType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return DefMethSpec IfacePredType
forall ty. DefMethSpec ty
VanillaDM
              Word8
_ -> do { IfacePredType
t <- BinHandle -> IO IfacePredType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; DefMethSpec IfacePredType -> IO (DefMethSpec IfacePredType)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (IfacePredType -> DefMethSpec IfacePredType
forall ty. ty -> DefMethSpec ty
GenericDM IfacePredType
t) }

instance NFData IfaceType where
  rnf :: IfacePredType -> ()
rnf = \case
    IfaceFreeTyVar CoVar
f1 -> CoVar
f1 CoVar -> () -> ()
forall a b. a -> b -> b
`seq` ()
    IfaceTyVar FastString
f1 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1
    IfaceLitTy IfaceTyLit
f1 -> IfaceTyLit -> ()
forall a. NFData a => a -> ()
rnf IfaceTyLit
f1
    IfaceAppTy IfacePredType
f1 IfaceAppArgs
f2 -> IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
    IfaceFunTy FunTyFlag
f1 IfacePredType
f2 IfacePredType
f3 IfacePredType
f4 -> FunTyFlag
f1 FunTyFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f4
    IfaceForAllTy IfaceForAllBndr
f1 IfacePredType
f2 -> IfaceForAllBndr
f1 IfaceForAllBndr -> () -> ()
forall a b. a -> b -> b
`seq` IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f2
    IfaceTyConApp IfaceTyCon
f1 IfaceAppArgs
f2 -> IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
    IfaceCastTy IfacePredType
f1 IfaceCoercion
f2 -> IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceCoercionTy IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceTupleTy TupleSort
f1 PromotionFlag
f2 IfaceAppArgs
f3 -> TupleSort
f1 TupleSort -> () -> ()
forall a b. a -> b -> b
`seq` PromotionFlag
f2 PromotionFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3

instance NFData IfaceTyLit where
  rnf :: IfaceTyLit -> ()
rnf = \case
    IfaceNumTyLit Integer
f1 -> Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
f1
    IfaceStrTyLit FastString
f1 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1
    IfaceCharTyLit Char
f1 -> Char -> ()
forall a. NFData a => a -> ()
rnf Char
f1

instance NFData IfaceCoercion where
  rnf :: IfaceCoercion -> ()
rnf = \case
    IfaceReflCo IfacePredType
f1 -> IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f1
    IfaceGReflCo Role
f1 IfacePredType
f2 IfaceMCoercion
f3 -> Role
f1 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceMCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceMCoercion
f3
    IfaceFunCo Role
f1 IfaceCoercion
f2 IfaceCoercion
f3 IfaceCoercion
f4 -> Role
f1 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f4
    IfaceTyConAppCo Role
f1 IfaceTyCon
f2 [IfaceCoercion]
f3 -> Role
f1 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
    IfaceAppCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceForAllCo IfaceBndr
f1 IfaceCoercion
f2 IfaceCoercion
f3 -> IfaceBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceBndr
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3
    IfaceCoVarCo FastString
f1 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1
    IfaceAxiomInstCo IfExtName
f1 Int
f2 [IfaceCoercion]
f3 -> IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
f2 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
    IfaceAxiomRuleCo FastString
f1 [IfaceCoercion]
f2 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f2
    IfaceUnivCo IfaceUnivCoProv
f1 Role
f2 IfacePredType
f3 IfacePredType
f4 -> IfaceUnivCoProv -> ()
forall a. NFData a => a -> ()
rnf IfaceUnivCoProv
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` Role
f2 Role -> () -> ()
forall a b. a -> b -> b
`seq` IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f3 () -> () -> ()
forall a b. a -> b -> b
`seq` IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f4
    IfaceSymCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceTransCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceSelCo CoSel
f1 IfaceCoercion
f2 -> CoSel -> ()
forall a. NFData a => a -> ()
rnf CoSel
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceLRCo LeftOrRight
f1 IfaceCoercion
f2 -> LeftOrRight
f1 LeftOrRight -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceInstCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceKindCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceSubCo IfaceCoercion
f1 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1
    IfaceFreeCoVar CoVar
f1 -> CoVar
f1 CoVar -> () -> ()
forall a b. a -> b -> b
`seq` ()
    IfaceHoleCo CoVar
f1 -> CoVar
f1 CoVar -> () -> ()
forall a b. a -> b -> b
`seq` ()

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

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

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

instance NFData IfaceTyConSort where
  rnf :: IfaceTyConSort -> ()
rnf = \case
    IfaceTyConSort
IfaceNormalTyCon -> ()
    IfaceTupleTyCon Int
arity TupleSort
sort -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity () -> () -> ()
forall a b. a -> b -> b
`seq` TupleSort
sort TupleSort -> () -> ()
forall a b. a -> b -> b
`seq` ()
    IfaceSumTyCon Int
arity -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity
    IfaceTyConSort
IfaceEqualityTyCon -> ()

instance NFData IfaceTyConInfo where
  rnf :: IfaceTyConInfo -> ()
rnf (IfaceTyConInfo PromotionFlag
f IfaceTyConSort
s) = PromotionFlag
f PromotionFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTyConSort -> ()
forall a. NFData a => a -> ()
rnf IfaceTyConSort
s

instance NFData IfaceTyCon where
  rnf :: IfaceTyCon -> ()
rnf (IfaceTyCon IfExtName
nm IfaceTyConInfo
info) = IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
nm () -> () -> ()
forall a b. a -> b -> b
`seq` IfaceTyConInfo -> ()
forall a. NFData a => a -> ()
rnf IfaceTyConInfo
info

instance NFData IfaceBndr where
  rnf :: IfaceBndr -> ()
rnf = \case
    IfaceIdBndr IfaceIdBndr
id_bndr -> IfaceIdBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceIdBndr
id_bndr
    IfaceTvBndr IfaceTvBndr
tv_bndr -> IfaceTvBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceTvBndr
tv_bndr

instance NFData IfaceAppArgs where
  rnf :: IfaceAppArgs -> ()
rnf = \case
    IfaceAppArgs
IA_Nil -> ()
    IA_Arg IfacePredType
f1 ForAllTyFlag
f2 IfaceAppArgs
f3 -> IfacePredType -> ()
forall a. NFData a => a -> ()
rnf IfacePredType
f1 () -> () -> ()
forall a b. a -> b -> b
`seq` ForAllTyFlag
f2 ForAllTyFlag -> () -> ()
forall a b. a -> b -> b
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3