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


This module defines interface types and binders
-}

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

module IfaceType (
        IfExtName, IfLclName,

        IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
        IfaceMCoercion(..),
        IfaceUnivCoProv(..),
        IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..),
        IfaceTyLit(..), IfaceAppArgs(..),
        IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
        IfaceForAllBndr, ArgFlag(..), AnonArgFlag(..),
        ForallVisFlag(..), ShowForAllFlag(..),
        mkIfaceForAllTvBndr,
        mkIfaceTyConKind,

        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
        ifTyConBinderVar, ifTyConBinderName,

        -- Equality testing
        isIfaceLiftedTypeKind,

        -- Conversion from IfaceAppArgs to IfaceTypes/ArgFlags
        appArgsIfaceTypes, appArgsIfaceTypesArgFlags,

        -- Printing
        SuppressBndrSig(..),
        UseBndrParens(..),
        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,
        isIfaceTauType,

        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,

        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst
    ) where

#include "HsVersions.h"

import GhcPrelude

import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon
                                 , liftedRepDataConTyCon, tupleTyConName )
import {-# SOURCE #-} Type       ( isRuntimeRepTy )

import DynFlags
import TyCon hiding ( pprPromotionQuote )
import CoAxiom
import Var
import PrelNames
import Name
import BasicTypes
import Binary
import Outputable
import FastString
import FastStringEnv
import Util

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 IfaceSyn
                        -- (However Internal or System Names never should)

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

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

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

ifaceIdBndrName :: IfaceIdBndr -> IfLclName
ifaceIdBndrName :: IfaceTvBndr -> IfLclName
ifaceIdBndrName (IfLclName
n,IfaceKind
_) = IfLclName
n

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

ifaceBndrType :: IfaceBndr -> IfaceType
ifaceBndrType :: IfaceBndr -> IfaceKind
ifaceBndrType (IfaceIdBndr (IfLclName
_, IfaceKind
t)) = IfaceKind
t
ifaceBndrType (IfaceTvBndr (IfLclName
_, IfaceKind
t)) = IfaceKind
t

type IfaceLamBndr = (IfaceBndr, IfaceOneShot)

data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
  = IfaceNoOneShot   -- and Note [The oneShot function] in MkId
  | IfaceOneShot


{-
%************************************************************************
%*                                                                      *
                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 IfaceSyn] in PprTyThing
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     AnonArgFlag 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

type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]

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

type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis
type IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag

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

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

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

           ArgFlag      -- 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 IfaceKind
ty ArgFlag
argf IfaceAppArgs
rest <> IfaceAppArgs
xs = IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceKind
ty ArgFlag
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
/= :: IfaceTyCon -> IfaceTyCon -> Bool
$c/= :: IfaceTyCon -> IfaceTyCon -> Bool
== :: IfaceTyCon -> IfaceTyCon -> Bool
$c== :: IfaceTyCon -> IfaceTyCon -> Bool
Eq)

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

                    | IfaceTupleTyCon !Arity !TupleSort
                      -- ^ 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
                      -- ^ 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
/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c/= :: IfaceTyConSort -> IfaceTyConSort -> Bool
== :: IfaceTyConSort -> IfaceTyConSort -> Bool
$c== :: IfaceTyConSort -> IfaceTyConSort -> Bool
Eq)

{- 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 IfaceSyn] in PprTyThing.

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

data IfaceTyConInfo   -- Used to guide pretty-printing
                      -- and to disambiguate D from 'D (they share a name)
  = IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
                   , 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
/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
Eq)

data IfaceMCoercion
  = IfaceMRefl
  | IfaceMCo IfaceCoercion

data IfaceCoercion
  = IfaceReflCo       IfaceType
  | IfaceGReflCo      Role IfaceType (IfaceMCoercion)
  | IfaceFunCo        Role 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 TcTypeNats
  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType
  | IfaceSymCo        IfaceCoercion
  | IfaceTransCo      IfaceCoercion IfaceCoercion
  | IfaceNthCo        Int 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
  = IfaceUnsafeCoerceProv
  | IfacePhantomProv IfaceCoercion
  | IfaceProofIrrelProv IfaceCoercion
  | IfacePluginProv String

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

isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind :: IfaceKind -> Bool
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
IA_Nil)
  = IfExtName -> Bool
isLiftedTypeKindTyConName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)
isIfaceLiftedTypeKind (IfaceTyConApp IfaceTyCon
tc
                       (IA_Arg (IfaceTyConApp IfaceTyCon
ptr_rep_lifted IfaceAppArgs
IA_Nil)
                               ArgFlag
Required IfaceAppArgs
IA_Nil))
  =  IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
  Bool -> Bool -> Bool
&& IfaceTyCon
ptr_rep_lifted IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepDataConKey
isIfaceLiftedTypeKind IfaceKind
_ = 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 :: IfaceKind -> ([IfaceForAllBndr], [IfaceKind], IfaceKind)
splitIfaceSigmaTy IfaceKind
ty
  = case ([IfaceForAllBndr]
bndrs, [IfaceKind]
theta) of
      ([], []) -> ([IfaceForAllBndr]
bndrs, [IfaceKind]
theta, IfaceKind
tau)
      ([IfaceForAllBndr], [IfaceKind])
_        -> let ([IfaceForAllBndr]
bndrs', [IfaceKind]
theta', IfaceKind
tau') = IfaceKind -> ([IfaceForAllBndr], [IfaceKind], IfaceKind)
splitIfaceSigmaTy IfaceKind
tau
                   in ([IfaceForAllBndr]
bndrs [IfaceForAllBndr] -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. [a] -> [a] -> [a]
++ [IfaceForAllBndr]
bndrs', [IfaceKind]
theta [IfaceKind] -> [IfaceKind] -> [IfaceKind]
forall a. [a] -> [a] -> [a]
++ [IfaceKind]
theta', IfaceKind
tau')
  where
    ([IfaceForAllBndr]
bndrs, IfaceKind
rho)   = IfaceKind -> ([IfaceForAllBndr], IfaceKind)
split_foralls IfaceKind
ty
    ([IfaceKind]
theta, IfaceKind
tau)   = IfaceKind -> ([IfaceKind], IfaceKind)
split_rho IfaceKind
rho

    split_foralls :: IfaceKind -> ([IfaceForAllBndr], IfaceKind)
split_foralls (IfaceForAllTy IfaceForAllBndr
bndr IfaceKind
ty)
        = case IfaceKind -> ([IfaceForAllBndr], IfaceKind)
split_foralls IfaceKind
ty of { ([IfaceForAllBndr]
bndrs, IfaceKind
rho) -> (IfaceForAllBndr
bndrIfaceForAllBndr -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. a -> [a] -> [a]
:[IfaceForAllBndr]
bndrs, IfaceKind
rho) }
    split_foralls IfaceKind
rho = ([], IfaceKind
rho)

    split_rho :: IfaceKind -> ([IfaceKind], IfaceKind)
split_rho (IfaceFunTy AnonArgFlag
InvisArg IfaceKind
ty1 IfaceKind
ty2)
        = case IfaceKind -> ([IfaceKind], IfaceKind)
split_rho IfaceKind
ty2 of { ([IfaceKind]
ps, IfaceKind
tau) -> (IfaceKind
ty1IfaceKind -> [IfaceKind] -> [IfaceKind]
forall a. a -> [a] -> [a]
:[IfaceKind]
ps, IfaceKind
tau) }
    split_rho IfaceKind
tau = ([], IfaceKind
tau)

suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles DynFlags
dflags [IfaceTyConBinder]
tys [a]
xs
  | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = [a]
xs
  | Bool
otherwise = [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 :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars DynFlags
dflags [IfaceTyConBinder]
tyvars
  | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = [IfaceTyConBinder]
tyvars
  | Bool
otherwise = (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 -> IfLclName
ifForAllBndrName IfaceForAllBndr
fab = IfaceBndr -> IfLclName
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 -> IfLclName
ifTyConBinderName IfaceTyConBinder
tcb = IfaceBndr -> IfLclName
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 :: IfaceKind -> Bool
ifTypeIsVarFree IfaceKind
ty = IfaceKind -> Bool
go IfaceKind
ty
  where
    go :: IfaceKind -> Bool
go (IfaceTyVar {})         = Bool
False
    go (IfaceFreeTyVar {})     = Bool
False
    go (IfaceAppTy IfaceKind
fun IfaceAppArgs
args)   = IfaceKind -> Bool
go IfaceKind
fun Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceFunTy AnonArgFlag
_ IfaceKind
arg IfaceKind
res)  = IfaceKind -> Bool
go IfaceKind
arg Bool -> Bool -> Bool
&& IfaceKind -> Bool
go IfaceKind
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 IfaceKind
arg ArgFlag
_ IfaceAppArgs
args) = IfaceKind -> Bool
go IfaceKind
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. [(IfLclName, a)] -> FastStringEnv a
mkFsEnv [IfaceTvBndr]
eq_spec

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

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
-- See Note [Substitution on IfaceType]
substIfaceType :: IfaceTySubst -> IfaceKind -> IfaceKind
substIfaceType IfaceTySubst
env IfaceKind
ty
  = IfaceKind -> IfaceKind
go IfaceKind
ty
  where
    go :: IfaceKind -> IfaceKind
go (IfaceFreeTyVar TyVar
tv)    = TyVar -> IfaceKind
IfaceFreeTyVar TyVar
tv
    go (IfaceTyVar IfLclName
tv)        = IfaceTySubst -> IfLclName -> IfaceKind
substIfaceTyVar IfaceTySubst
env IfLclName
tv
    go (IfaceAppTy  IfaceKind
t IfaceAppArgs
ts)     = IfaceKind -> IfaceAppArgs -> IfaceKind
IfaceAppTy  (IfaceKind -> IfaceKind
go IfaceKind
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
ts)
    go (IfaceFunTy AnonArgFlag
af IfaceKind
t1 IfaceKind
t2)  = AnonArgFlag -> IfaceKind -> IfaceKind -> IfaceKind
IfaceFunTy AnonArgFlag
af (IfaceKind -> IfaceKind
go IfaceKind
t1) (IfaceKind -> IfaceKind
go IfaceKind
t2)
    go ty :: IfaceKind
ty@(IfaceLitTy {})     = IfaceKind
ty
    go (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) = IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
    go (IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceKind
IfaceTupleTy TupleSort
s PromotionFlag
i (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
    go (IfaceForAllTy {})     = String -> SDoc -> IfaceKind
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"substIfaceType" (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty)
    go (IfaceCastTy IfaceKind
ty IfaceCoercion
co)    = IfaceKind -> IfaceCoercion -> IfaceKind
IfaceCastTy (IfaceKind -> IfaceKind
go IfaceKind
ty) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go (IfaceCoercionTy IfaceCoercion
co)   = IfaceCoercion -> IfaceKind
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 IfaceKind
ty)           = IfaceKind -> IfaceCoercion
IfaceReflCo (IfaceKind -> IfaceKind
go IfaceKind
ty)
    go_co (IfaceGReflCo Role
r IfaceKind
ty IfaceMCoercion
mco)    = Role -> IfaceKind -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (IfaceKind -> IfaceKind
go IfaceKind
ty) (IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
mco)
    go_co (IfaceFunCo Role
r IfaceCoercion
c1 IfaceCoercion
c2)       = Role -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (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" (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty)
    go_co (IfaceFreeCoVar TyVar
cv)        = TyVar -> IfaceCoercion
IfaceFreeCoVar TyVar
cv
    go_co (IfaceCoVarCo IfLclName
cv)          = IfLclName -> IfaceCoercion
IfaceCoVarCo IfLclName
cv
    go_co (IfaceHoleCo TyVar
cv)           = TyVar -> IfaceCoercion
IfaceHoleCo TyVar
cv
    go_co (IfaceAxiomInstCo IfExtName
a BranchIndex
i [IfaceCoercion]
cos) = IfExtName -> BranchIndex -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a BranchIndex
i ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
    go_co (IfaceUnivCo IfaceUnivCoProv
prov Role
r IfaceKind
t1 IfaceKind
t2) = IfaceUnivCoProv -> Role -> IfaceKind -> IfaceKind -> IfaceCoercion
IfaceUnivCo (IfaceUnivCoProv -> IfaceUnivCoProv
go_prov IfaceUnivCoProv
prov) Role
r (IfaceKind -> IfaceKind
go IfaceKind
t1) (IfaceKind -> IfaceKind
go IfaceKind
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 (IfaceNthCo BranchIndex
n IfaceCoercion
co)          = BranchIndex -> IfaceCoercion -> IfaceCoercion
IfaceNthCo BranchIndex
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 IfLclName
n [IfaceCoercion]
cos)   = IfLclName -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo IfLclName
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 IfaceUnivCoProv
IfaceUnsafeCoerceProv    = IfaceUnivCoProv
IfaceUnsafeCoerceProv
    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 (IfacePluginProv String
str)    = String -> IfaceUnivCoProv
IfacePluginProv String
str

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 IfaceKind
ty ArgFlag
arg IfaceAppArgs
tys) = IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfaceKind -> IfaceKind
substIfaceType IfaceTySubst
env IfaceKind
ty) ArgFlag
arg (IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
tys)

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


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

stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs DynFlags
dflags IfaceAppArgs
tys
  | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = IfaceAppArgs
tys
  | Bool
otherwise = 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 IfaceKind
t ArgFlag
argf IfaceAppArgs
ts
              |  ArgFlag -> Bool
isVisibleArgFlag ArgFlag
argf
              -> IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceKind
t ArgFlag
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,
              -- TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.
              |  Bool
otherwise
              -> IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts

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

appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceType, ArgFlag)]
appArgsIfaceTypesArgFlags :: IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags IfaceAppArgs
IA_Nil = []
appArgsIfaceTypesArgFlags (IA_Arg IfaceKind
t ArgFlag
a IfaceAppArgs
ts)
                                 = (IfaceKind
t, ArgFlag
a) (IfaceKind, ArgFlag)
-> [(IfaceKind, ArgFlag)] -> [(IfaceKind, ArgFlag)]
forall a. a -> [a] -> [a]
: IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags IfaceAppArgs
ts

ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength :: IfaceAppArgs -> BranchIndex
ifaceVisAppArgsLength = BranchIndex -> IfaceAppArgs -> BranchIndex
forall t. Num t => t -> IfaceAppArgs -> t
go BranchIndex
0
  where
    go :: t -> IfaceAppArgs -> t
go !t
n IfaceAppArgs
IA_Nil = t
n
    go t
n  (IA_Arg IfaceKind
_ ArgFlag
argf IfaceAppArgs
rest)
      | ArgFlag -> Bool
isVisibleArgFlag ArgFlag
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 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 ToIface), 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, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep 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
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
    if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitCoercions DynFlags
dflags
         Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| PprStyle -> Bool
debugStyle PprStyle
style
    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
sep [SDoc
pp_ty1, SDoc
pp_tc SDoc -> SDoc -> SDoc
<+> 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 (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 -> BranchIndex -> SDoc -> SDoc
hang SDoc
pp_fun BranchIndex
2 ([SDoc] -> SDoc
sep [SDoc]
pp_tys)

isIfaceTauType :: IfaceType -> Bool
isIfaceTauType :: IfaceKind -> Bool
isIfaceTauType (IfaceForAllTy IfaceForAllBndr
_ IfaceKind
_) = Bool
False
isIfaceTauType (IfaceFunTy AnonArgFlag
InvisArg IfaceKind
_ IfaceKind
_) = Bool
False
isIfaceTauType IfaceKind
_ = Bool
True

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

instance Outputable IfaceBndr where
    ppr :: IfaceBndr -> SDoc
ppr (IfaceIdBndr IfaceTvBndr
bndr) = IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
bndr
    ppr (IfaceTvBndr IfaceTvBndr
bndr) = Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<+> 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
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
<> String -> SDoc
text String
"[OneShot]"

pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr :: IfaceTvBndr -> SDoc
pprIfaceIdBndr (IfLclName
name, IfaceKind
ty) = SDoc -> SDoc
parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
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
-}

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

newtype UseBndrParens = UseBndrParens Bool

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

pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders :: SuppressBndrSig -> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders SuppressBndrSig
suppress_sig = [SDoc] -> SDoc
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 IfaceTvBndr
bndr) TyConBndrVis
_) = IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
bndr
    go (Bndr (IfaceTvBndr IfaceTvBndr
bndr) TyConBndrVis
vis) =
      -- See Note [Pretty-printing invisible arguments]
      case TyConBndrVis
vis of
        AnonTCB  AnonArgFlag
VisArg    -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        AnonTCB  AnonArgFlag
InvisArg  -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
False))
          -- The above case is rare. (See Note [AnonTCB InvisArg] in TyCon.)
          -- Should we print these differently?
        NamedTCB ArgFlag
Required  -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        NamedTCB ArgFlag
Specified -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        NamedTCB ArgFlag
Inferred  -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
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 IfaceTvBndr
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> IfaceTvBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTvBndr
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 IfaceTvBndr
aa <- BinHandle -> IO IfaceTvBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceBndr -> IO IfaceBndr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTvBndr -> IfaceBndr
IfaceIdBndr IfaceTvBndr
aa)
              Word8
_ -> do IfaceTvBndr
ab <- BinHandle -> IO IfaceTvBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceBndr -> IO IfaceBndr
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 = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh IfaceOneShot
IfaceOneShot = do
            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 -> do IfaceOneShot -> IO IfaceOneShot
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceNoOneShot
              Word8
_ -> do IfaceOneShot -> IO IfaceOneShot
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceOneShot

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

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

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

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

ppr_sigma :: PprPrec -> IfaceType -> SDoc
ppr_sigma :: PprPrec -> IfaceKind -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceKind
ty
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (ShowForAllFlag -> IfaceKind -> SDoc
pprIfaceSigmaType ShowForAllFlag
ShowForAllMust IfaceKind
ty)

ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty :: PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
ctxt_prec ty :: IfaceKind
ty@(IfaceForAllTy {})        = PprPrec -> IfaceKind -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceKind
ty
ppr_ty PprPrec
ctxt_prec ty :: IfaceKind
ty@(IfaceFunTy AnonArgFlag
InvisArg IfaceKind
_ IfaceKind
_) = PprPrec -> IfaceKind -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceKind
ty

ppr_ty PprPrec
_         (IfaceFreeTyVar TyVar
tyvar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tyvar  -- This is the main reason for IfaceFreeTyVar!
ppr_ty PprPrec
_         (IfaceTyVar IfLclName
tyvar)     = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tyvar  -- See Note [TcTyVars 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
ppr_ty PprPrec
_         (IfaceLitTy IfaceTyLit
n)         = IfaceTyLit -> SDoc
pprIfaceTyLit IfaceTyLit
n
        -- Function types
ppr_ty PprPrec
ctxt_prec (IfaceFunTy AnonArgFlag
_ IfaceKind
ty1 IfaceKind
ty2)  -- Should be VisArg
  = -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
    PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
sep [PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty1, [SDoc] -> SDoc
sep (IfaceKind -> [SDoc]
ppr_fun_tail IfaceKind
ty2)]
  where
    ppr_fun_tail :: IfaceKind -> [SDoc]
ppr_fun_tail (IfaceFunTy AnonArgFlag
VisArg IfaceKind
ty1 IfaceKind
ty2)
      = (SDoc
arrow SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceKind -> [SDoc]
ppr_fun_tail IfaceKind
ty2
    ppr_fun_tail IfaceKind
other_ty
      = [SDoc
arrow SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
pprIfaceType IfaceKind
other_ty]

ppr_ty PprPrec
ctxt_prec (IfaceAppTy IfaceKind
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 =
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
        PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec
                          (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
t)
                          (((IfaceKind, ArgFlag) -> SDoc) -> [(IfaceKind, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
appPrec) (DynFlags -> [(IfaceKind, ArgFlag)]
tys_wo_kinds DynFlags
dflags))

    tys_wo_kinds :: DynFlags -> [(IfaceKind, ArgFlag)]
tys_wo_kinds DynFlags
dflags = IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags (IfaceAppArgs -> [(IfaceKind, ArgFlag)])
-> IfaceAppArgs -> [(IfaceKind, ArgFlag)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs DynFlags
dflags IfaceAppArgs
ts

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

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

ppr_ty PprPrec
ctxt_prec (IfaceCastTy IfaceKind
ty IfaceCoercion
co)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      (SDoc -> SDoc
parens (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec IfaceKind
ty SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"|>" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceCoercion
co))
      (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
ctxt_prec IfaceKind
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
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
signficant 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. This is done in a pass right before
pretty-printing (defaultRuntimeRepVars, controlled by
-fprint-explicit-runtime-reps)

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) we are reporting a
mismatch between two skolems
          (a :: RuntimeRep) ~ (b :: RuntimeRep)
We certainly don't want to say "Can't match LiftedRep ~ LiftedRep"!

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)

Conclusion: keep track of whether we we are in the kind of a
binder; ohly if so, convert free RuntimeRep variables to LiftedRep.
-}

-- | Default 'RuntimeRep' variables to 'LiftedPtr'. e.g.
--
-- @
-- ($) :: forall (r :: GHC.Types.RuntimeRep) a (b :: TYPE r).
--        (a -> b) -> a -> b
-- @
--
-- turns in to,
--
-- @ ($) :: forall a (b :: *). (a -> b) -> a -> b @
--
-- We do this to prevent RuntimeRep variables from incurring a significant
-- syntactic overhead in otherwise simple type signatures (e.g. ($)). See
-- Note [Defaulting RuntimeRep variables] and #11549 for further discussion.
--
defaultRuntimeRepVars :: IfaceType -> IfaceType
defaultRuntimeRepVars :: IfaceKind -> IfaceKind
defaultRuntimeRepVars IfaceKind
ty = Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
False FastStringEnv ()
forall a. FastStringEnv a
emptyFsEnv IfaceKind
ty
  where
    go :: Bool              -- True <=> Inside the kind of a binder
       -> FastStringEnv ()  -- Set of enclosing forall-ed RuntimeRep variables
       -> IfaceType         --  (replace them with LiftedRep)
       -> IfaceType
    go :: Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs (IfaceForAllTy (Bndr (IfaceTvBndr (IfLclName
var, IfaceKind
var_kind)) ArgFlag
argf) IfaceKind
ty)
     | IfaceKind -> Bool
isRuntimeRep IfaceKind
var_kind
      , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf -- Don't default *visible* quantification
                                -- or we get the mess in #13963
      = let subs' :: FastStringEnv ()
subs' = FastStringEnv () -> IfLclName -> () -> FastStringEnv ()
forall a. FastStringEnv a -> IfLclName -> a -> FastStringEnv a
extendFsEnv FastStringEnv ()
subs IfLclName
var ()
            -- Record that we should replace it with LiftedRep,
            -- and recurse, discarding the forall
        in Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs' IfaceKind
ty

    go Bool
ink FastStringEnv ()
subs (IfaceForAllTy IfaceForAllBndr
bndr IfaceKind
ty)
      = IfaceForAllBndr -> IfaceKind -> IfaceKind
IfaceForAllTy (FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr FastStringEnv ()
subs IfaceForAllBndr
bndr) (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
ty)

    go Bool
_ FastStringEnv ()
subs ty :: IfaceKind
ty@(IfaceTyVar IfLclName
tv)
      | IfLclName
tv IfLclName -> FastStringEnv () -> Bool
forall a. IfLclName -> FastStringEnv a -> Bool
`elemFsEnv` FastStringEnv ()
subs
      = IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
liftedRep IfaceAppArgs
IA_Nil
      | Bool
otherwise
      = IfaceKind
ty

    go Bool
in_kind FastStringEnv ()
_ ty :: IfaceKind
ty@(IfaceFreeTyVar TyVar
tv)
      -- See Note [Defaulting RuntimeRep variables], about free vars
      | Bool
in_kind Bool -> Bool -> Bool
&& Type -> Bool
Type.isRuntimeRepTy (TyVar -> Type
tyVarKind TyVar
tv)
      = IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
liftedRep IfaceAppArgs
IA_Nil
      | Bool
otherwise
      = IfaceKind
ty

    go Bool
ink FastStringEnv ()
subs (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tc_args)
      = IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
tc (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
tc_args)

    go Bool
ink FastStringEnv ()
subs (IfaceTupleTy TupleSort
sort PromotionFlag
is_prom IfaceAppArgs
tc_args)
      = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceKind
IfaceTupleTy TupleSort
sort PromotionFlag
is_prom (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
tc_args)

    go Bool
ink FastStringEnv ()
subs (IfaceFunTy AnonArgFlag
af IfaceKind
arg IfaceKind
res)
      = AnonArgFlag -> IfaceKind -> IfaceKind -> IfaceKind
IfaceFunTy AnonArgFlag
af (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
arg) (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
res)

    go Bool
ink FastStringEnv ()
subs (IfaceAppTy IfaceKind
t IfaceAppArgs
ts)
      = IfaceKind -> IfaceAppArgs -> IfaceKind
IfaceAppTy (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
t) (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
ts)

    go Bool
ink FastStringEnv ()
subs (IfaceCastTy IfaceKind
x IfaceCoercion
co)
      = IfaceKind -> IfaceCoercion -> IfaceKind
IfaceCastTy (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
x) IfaceCoercion
co

    go Bool
_ FastStringEnv ()
_ ty :: IfaceKind
ty@(IfaceLitTy {}) = IfaceKind
ty
    go Bool
_ FastStringEnv ()
_ ty :: IfaceKind
ty@(IfaceCoercionTy {}) = IfaceKind
ty

    go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
    go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr FastStringEnv ()
subs (Bndr (IfaceIdBndr (IfLclName
n, IfaceKind
t)) ArgFlag
argf)
      = IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceIdBndr (IfLclName
n, Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
True FastStringEnv ()
subs IfaceKind
t)) ArgFlag
argf
    go_ifacebndr FastStringEnv ()
subs (Bndr (IfaceTvBndr (IfLclName
n, IfaceKind
t)) ArgFlag
argf)
      = IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTvBndr -> IfaceBndr
IfaceTvBndr (IfLclName
n, Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
True FastStringEnv ()
subs IfaceKind
t)) ArgFlag
argf

    go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
    go_args :: Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
_ FastStringEnv ()
_ IfaceAppArgs
IA_Nil = IfaceAppArgs
IA_Nil
    go_args Bool
ink FastStringEnv ()
subs (IA_Arg IfaceKind
ty ArgFlag
argf IfaceAppArgs
args)
      = IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (Bool -> FastStringEnv () -> IfaceKind -> IfaceKind
go Bool
ink FastStringEnv ()
subs IfaceKind
ty) ArgFlag
argf (Bool -> FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink FastStringEnv ()
subs IfaceAppArgs
args)

    liftedRep :: IfaceTyCon
    liftedRep :: IfaceTyCon
liftedRep = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon)
      where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedRepDataConTyCon

    isRuntimeRep :: IfaceType -> Bool
    isRuntimeRep :: IfaceKind -> Bool
isRuntimeRep (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) =
        IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
runtimeRepTyConKey
    isRuntimeRep IfaceKind
_ = Bool
False

eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
eliminateRuntimeRep :: (IfaceKind -> SDoc) -> IfaceKind -> SDoc
eliminateRuntimeRep IfaceKind -> SDoc
f IfaceKind
ty
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty    ->
    if PprStyle -> Bool
userStyle PprStyle
sty Bool -> Bool -> Bool
&& Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitRuntimeReps DynFlags
dflags)
      then IfaceKind -> SDoc
f (IfaceKind -> IfaceKind
defaultRuntimeRepVars IfaceKind
ty)
      else IfaceKind -> SDoc
f IfaceKind
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
empty
    go (IA_Arg IfaceKind
t ArgFlag
argf IfaceAppArgs
ts) = PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceKind
t, ArgFlag
argf) SDoc -> SDoc -> SDoc
<+> IfaceAppArgs -> SDoc
go IfaceAppArgs
ts

-- See Note [Pretty-printing invisible arguments]
ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg :: PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceKind
t, ArgFlag
argf) =
  (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
  let print_kinds :: Bool
print_kinds = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags
  in case ArgFlag
argf of
       ArgFlag
Required  -> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
ctx_prec IfaceKind
t
       ArgFlag
Specified |  Bool
print_kinds
                 -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
appPrec IfaceKind
t
       ArgFlag
Inferred  |  Bool
print_kinds
                 -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec IfaceKind
t)
       ArgFlag
_         -> SDoc
empty

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

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

pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(IfLclName, IfaceCoercion)]
tvs SDoc
sdoc
  = [SDoc] -> SDoc
sep [ [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [(IfLclName, IfaceCoercion)]
tvs, SDoc
sdoc ]

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

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

    add_separator :: SDoc -> SDoc
add_separator SDoc
stuff = case ArgFlag
vis of
                            ArgFlag
Required -> SDoc
stuff SDoc -> SDoc -> SDoc
<+> SDoc
arrow
                            ArgFlag
_inv     -> SDoc
stuff SDoc -> SDoc -> SDoc
<>  SDoc
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]
             -> ArgFlag  -- ^ visibility of the first binder in the list
             -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs :: [IfaceForAllBndr] -> ArgFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs all_bndrs :: [IfaceForAllBndr]
all_bndrs@(bndr :: IfaceForAllBndr
bndr@(Bndr IfaceBndr
_ ArgFlag
vis) : [IfaceForAllBndr]
bndrs) ArgFlag
vis1
  | ArgFlag
vis ArgFlag -> ArgFlag -> Bool
`sameVis` ArgFlag
vis1 = let ([IfaceForAllBndr]
bndrs', [SDoc]
doc) = [IfaceForAllBndr] -> ArgFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ArgFlag
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 [] ArgFlag
_ = ([], [])

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

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

pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr =
  case IfaceForAllBndr
bndr of
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
Inferred ->
      (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
        if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitForalls DynFlags
dflags
        then SDoc -> SDoc
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)
        else IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
_ ->
      IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
    Bndr (IfaceIdBndr IfaceTvBndr
idv) ArgFlag
_ -> IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
idv
  where
    -- See Note [Suppressing binder signatures] in IfaceType
    suppress_sig :: SuppressBndrSig
suppress_sig = Bool -> SuppressBndrSig
SuppressBndrSig Bool
False

pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (IfLclName
tv, IfaceCoercion
kind_co)
  = SDoc -> SDoc
parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> 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 -> IfaceKind -> SDoc
pprIfaceSigmaType ShowForAllFlag
show_forall IfaceKind
ty
  = (IfaceKind -> SDoc) -> IfaceKind -> SDoc
eliminateRuntimeRep IfaceKind -> SDoc
ppr_fn IfaceKind
ty
  where
    ppr_fn :: IfaceKind -> SDoc
ppr_fn IfaceKind
iface_ty =
      let ([IfaceForAllBndr]
tvs, [IfaceKind]
theta, IfaceKind
tau) = IfaceKind -> ([IfaceForAllBndr], [IfaceKind], IfaceKind)
splitIfaceSigmaTy IfaceKind
iface_ty
       in ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceKind] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
tvs [IfaceKind]
theta (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
tau)

pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
   = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
     -- See Note [When to print foralls] in this module.
     Bool -> SDoc -> SDoc
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 ArgFlag -> Bool
tv_is_required [IfaceForAllBndr]
tvs
             Bool -> Bool -> Bool
|| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitForalls DynFlags
dflags) (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 (IfLclName
_,IfaceKind
kind)) argf
_)
       = Bool -> Bool
not (IfaceKind -> Bool
ifTypeIsVarFree IfaceKind
kind)
     tv_has_kind_var VarBndr IfaceBndr argf
_ = Bool
False

     tv_is_required :: VarBndr tv ArgFlag -> Bool
tv_is_required = ArgFlag -> Bool
isVisibleArgFlag (ArgFlag -> Bool)
-> (VarBndr tv ArgFlag -> ArgFlag) -> VarBndr tv ArgFlag -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarBndr tv ArgFlag -> ArgFlag
forall tv argf. VarBndr tv argf -> argf
binderArgFlag

{-
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, TyCoVarBinders, TyConBinders, and visibility]
   in TyCoRep.

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.
Solution: in type-level lists and tuples, add a leading space
if the first type is itself promoted.  See pprSpaceIfPromotedTyCon.
-}


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

-- | Prefix a space if the given 'IfaceType' is a promoted 'TyCon'.
-- See Note [Printing promoted type constructors]
pprSpaceIfPromotedTyCon :: IfaceType -> SDoc -> SDoc
pprSpaceIfPromotedTyCon :: IfaceKind -> SDoc -> SDoc
pprSpaceIfPromotedTyCon (IfaceTyConApp IfaceTyCon
tyCon IfaceAppArgs
_)
  = case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted (IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tyCon) of
      PromotionFlag
IsPromoted -> (SDoc
space SDoc -> SDoc -> SDoc
<>)
      PromotionFlag
_ -> SDoc -> SDoc
forall a. a -> a
id
pprSpaceIfPromotedTyCon IfaceKind
_
  = SDoc -> SDoc
forall a. a -> a
id

-- See equivalent function in TyCoRep.hs
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 -> IfaceKind -> IfaceKind -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceKind
ty1 IfaceKind
ty2
  = case IfaceKind -> ([IfaceKind], Maybe IfaceKind)
gather IfaceKind
ty2 of
      ([IfaceKind]
arg_tys, Maybe IfaceKind
Nothing)
        -> Char -> SDoc
char Char
'\'' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (IfaceKind -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceKind
ty1 ([SDoc] -> SDoc
fsep
                        (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((IfaceKind -> SDoc) -> [IfaceKind] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec) (IfaceKind
ty1IfaceKind -> [IfaceKind] -> [IfaceKind]
forall a. a -> [a] -> [a]
:[IfaceKind]
arg_tys)))))
      ([IfaceKind]
arg_tys, Just IfaceKind
tl)
        -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> BranchIndex -> SDoc -> SDoc
hang (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty1)
           BranchIndex
2 ([SDoc] -> SDoc
fsep [ SDoc
colon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
ty | IfaceKind
ty <- [IfaceKind]
arg_tys [IfaceKind] -> [IfaceKind] -> [IfaceKind]
forall a. [a] -> [a] -> [a]
++ [IfaceKind
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 :: IfaceKind -> ([IfaceKind], Maybe IfaceKind)
gather (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
      , IA_Arg IfaceKind
_ ArgFlag
argf (IA_Arg IfaceKind
ty1 ArgFlag
Required (IA_Arg IfaceKind
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
      , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
      , ([IfaceKind]
args, Maybe IfaceKind
tl) <- IfaceKind -> ([IfaceKind], Maybe IfaceKind)
gather IfaceKind
ty2
      = (IfaceKind
ty1IfaceKind -> [IfaceKind] -> [IfaceKind]
forall a. a -> [a] -> [a]
:[IfaceKind]
args, Maybe IfaceKind
tl)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
nilDataConKey
      = ([], Maybe IfaceKind
forall a. Maybe a
Nothing)
    gather IfaceKind
ty = ([], IfaceKind -> Maybe IfaceKind
forall a. a -> Maybe a
Just IfaceKind
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 =
    (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style ->
    PprPrec
-> IfaceTyCon -> IfaceAppArgs -> DynFlags -> PprStyle -> SDoc
pprTyTcApp' PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys DynFlags
dflags PprStyle
style

pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs
            -> DynFlags -> PprStyle -> SDoc
pprTyTcApp' :: PprPrec
-> IfaceTyCon -> IfaceAppArgs -> DynFlags -> PprStyle -> SDoc
pprTyTcApp' PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys DynFlags
dflags PprStyle
style
  | IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ipClassKey
  , IA_Arg (IfaceLitTy (IfaceStrTyLit IfLclName
n))
           ArgFlag
Required (IA_Arg IfaceKind
ty ArgFlag
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
char Char
'?' SDoc -> SDoc -> SDoc
<> IfLclName -> SDoc
ftext IfLclName
n SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"::" SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec IfaceKind
ty

  | IfaceTupleTyCon BranchIndex
arity TupleSort
sort <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
  , Bool -> Bool
not (PprStyle -> Bool
debugStyle PprStyle
style)
  , BranchIndex
arity BranchIndex -> BranchIndex -> Bool
forall a. Eq a => a -> a -> Bool
== IfaceAppArgs -> BranchIndex
ifaceVisAppArgsLength IfaceAppArgs
tys
  = PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
sort (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys

  | IfaceSumTyCon BranchIndex
arity <- IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort IfaceTyConInfo
info
  = BranchIndex -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum BranchIndex
arity (IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted IfaceTyConInfo
info) IfaceAppArgs
tys

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
  , Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags)
  , IA_Arg IfaceKind
_ ArgFlag
argf (IA_Arg IfaceKind
ty1 ArgFlag
Required (IA_Arg IfaceKind
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
  , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
  = PprPrec -> IfaceKind -> IfaceKind -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceKind
ty1 IfaceKind
ty2

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
  , IA_Arg (IfaceTyConApp IfaceTyCon
rep IfaceAppArgs
IA_Nil) ArgFlag
Required IfaceAppArgs
IA_Nil <- IfaceAppArgs
tys
  , IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepDataConKey
  = SDoc
kindType

  | Bool
otherwise
  = (Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
dbg ->
    if | Bool -> Bool
not Bool
dbg Bool -> Bool -> Bool
&& IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
errorMessageTypeErrorFamKey
         -- Suppress detail unles you _really_ want to see
         -> String -> SDoc
text String
"(TypeError ...)"

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

       | Bool
otherwise
         -> (PprPrec -> (IfaceKind, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceKind, ArgFlag)] -> SDoc
forall a.
(PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (IfaceKind, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctxt_prec IfaceTyCon
tc [(IfaceKind, ArgFlag)]
tys_wo_kinds
  where
    info :: IfaceTyConInfo
info = IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc
    tys_wo_kinds :: [(IfaceKind, ArgFlag)]
tys_wo_kinds = IfaceAppArgs -> [(IfaceKind, ArgFlag)]
appArgsIfaceTypesArgFlags (IfaceAppArgs -> [(IfaceKind, ArgFlag)])
-> IfaceAppArgs -> [(IfaceKind, ArgFlag)]
forall a b. (a -> b) -> a -> b
$ DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs DynFlags
dflags IfaceAppArgs
tys

-- | 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 TysPrim
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceKind] -> Maybe SDoc
ppr_equality PprPrec
ctxt_prec IfaceTyCon
tc [IfaceKind]
args
  | Bool
hetero_eq_tc
  , [IfaceKind
k1, IfaceKind
k2, IfaceKind
t1, IfaceKind
t2] <- [IfaceKind]
args
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceKind, IfaceKind, IfaceKind, IfaceKind) -> SDoc
print_equality (IfaceKind
k1, IfaceKind
k2, IfaceKind
t1, IfaceKind
t2)

  | Bool
hom_eq_tc
  , [IfaceKind
k, IfaceKind
t1, IfaceKind
t2] <- [IfaceKind]
args
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceKind, IfaceKind, IfaceKind, IfaceKind) -> SDoc
print_equality (IfaceKind
k, IfaceKind
k, IfaceKind
t1, IfaceKind
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 -> IfaceKind -> SDoc
pp = PprPrec -> IfaceKind -> 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 :: (IfaceKind, IfaceKind, IfaceKind, IfaceKind) -> SDoc
print_equality (IfaceKind, IfaceKind, IfaceKind, IfaceKind)
args =
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
        (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style  ->
        (IfaceKind, IfaceKind, IfaceKind, IfaceKind)
-> PprStyle -> DynFlags -> SDoc
print_equality' (IfaceKind, IfaceKind, IfaceKind, IfaceKind)
args PprStyle
style DynFlags
dflags

    print_equality' :: (IfaceKind, IfaceKind, IfaceKind, IfaceKind)
-> PprStyle -> DynFlags -> SDoc
print_equality' (IfaceKind
ki1, IfaceKind
ki2, IfaceKind
ty1, IfaceKind
ty2) PprStyle
style DynFlags
dflags
      | -- 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
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 -> IfaceKind -> SDoc
pp PprPrec
appPrec IfaceKind
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 -> IfaceKind -> SDoc
pp PprPrec
appPrec IfaceKind
ty1, PprPrec -> IfaceKind -> SDoc
pp PprPrec
appPrec IfaceKind
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
                               (IfaceKind -> IfaceKind -> SDoc
pp_ty_ki IfaceKind
ty1 IfaceKind
ki1) (IfaceKind -> IfaceKind -> SDoc
pp_ty_ki IfaceKind
ty2 IfaceKind
ki2)
          where
            pp_ty_ki :: IfaceKind -> IfaceKind -> SDoc
pp_ty_ki IfaceKind
ty IfaceKind
ki
              | Bool
print_kinds
              = SDoc -> SDoc
parens (PprPrec -> IfaceKind -> SDoc
pp PprPrec
topPrec IfaceKind
ty SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceKind -> SDoc
pp PprPrec
opPrec IfaceKind
ki)
              | Bool
otherwise
              = PprPrec -> IfaceKind -> SDoc
pp PprPrec
opPrec IfaceKind
ty

        print_kinds :: Bool
print_kinds = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags
        print_eqs :: Bool
print_eqs   = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintEqualityRelations DynFlags
dflags Bool -> Bool -> Bool
||
                      PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| PprStyle -> Bool
debugStyle PprStyle
style


pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
ctxt_prec IfaceTyCon
tc [IfaceCoercion]
tys =
  (PprPrec -> (IfaceCoercion, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(IfaceCoercion, ArgFlag)] -> SDoc
forall a.
(PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app (\PprPrec
prec (IfaceCoercion
co, ArgFlag
_) -> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
prec IfaceCoercion
co) PprPrec
ctxt_prec IfaceTyCon
tc
    ((IfaceCoercion -> (IfaceCoercion, ArgFlag))
-> [IfaceCoercion] -> [(IfaceCoercion, ArgFlag)]
forall a b. (a -> b) -> [a] -> [b]
map (, ArgFlag
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, ArgFlag) -> SDoc)
                 -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
_ IfaceTyCon
tc [(a, ArgFlag)
ty]
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
listTyConKey = IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
topPrec (a, ArgFlag)
ty)

ppr_iface_tc_app PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
ctxt_prec IfaceTyCon
tc [(a, ArgFlag)]
tys
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedTypeKindTyConKey
  = SDoc
kindType

  | 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, ArgFlag) -> SDoc) -> [(a, ArgFlag)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
appPrec) [(a, ArgFlag)]
tys)

  | [ ty1 :: (a, ArgFlag)
ty1@(a
_, ArgFlag
Required)
    , ty2 :: (a, ArgFlag)
ty2@(a
_, ArgFlag
Required) ] <- [(a, ArgFlag)]
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, ArgFlag) -> SDoc
pp PprPrec
opPrec (a, ArgFlag)
ty1) (PprPrec -> (a, ArgFlag) -> SDoc
pp PprPrec
opPrec (a, ArgFlag)
ty2)

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

pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum :: BranchIndex -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum BranchIndex
_arity PromotionFlag
is_promoted IfaceAppArgs
args
  =   -- drop the RuntimeRep vars.
      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
    let tys :: [IfaceKind]
tys   = IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
args
        args' :: [IfaceKind]
args' = BranchIndex -> [IfaceKind] -> [IfaceKind]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceKind] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceKind]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` BranchIndex
2) [IfaceKind]
tys
    in PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
is_promoted
       SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
sumParens ((IfaceKind -> SDoc) -> [IfaceKind] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars (PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
topPrec) [IfaceKind]
args')

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 :: [IfaceKind]
tys = IfaceAppArgs -> [IfaceKind]
appArgsIfaceTypes IfaceAppArgs
args
             args' :: [IfaceKind]
args' = BranchIndex -> [IfaceKind] -> [IfaceKind]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceKind] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceKind]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` BranchIndex
2) [IfaceKind]
tys
             spaceIfPromoted :: SDoc -> SDoc
spaceIfPromoted = case [IfaceKind]
args' of
               IfaceKind
arg0:[IfaceKind]
_ -> IfaceKind -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceKind
arg0
               [IfaceKind]
_ -> SDoc -> SDoc
forall a. a -> a
id
         in [IfaceKind] -> SDoc -> SDoc
ppr_tuple_app [IfaceKind]
args' (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
            PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
IsPromoted SDoc -> SDoc -> SDoc
<>
            TupleSort -> SDoc -> SDoc
tupleParens TupleSort
sort (SDoc -> SDoc
spaceIfPromoted ((IfaceKind -> SDoc) -> [IfaceKind] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceKind -> SDoc
pprIfaceType [IfaceKind]
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
text String
"() :: Constraint"

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

pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceTyLit (IfaceNumTyLit Integer
n) = Integer -> SDoc
integer Integer
n
pprIfaceTyLit (IfaceStrTyLit IfLclName
n) = String -> SDoc
text (IfLclName -> String
forall a. Show a => a -> String
show IfLclName
n)

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 IfaceKind
ty) = SDoc -> SDoc
angleBrackets (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
Nominal
ppr_co PprPrec
_         (IfaceGReflCo Role
r IfaceKind
ty IfaceMCoercion
IfaceMRefl)
  = SDoc -> SDoc
angleBrackets (IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceGReflCo Role
r IfaceKind
ty (IfaceMCo IfaceCoercion
co))
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec
    (String -> SDoc
text String
"GRefl" SDoc -> SDoc -> SDoc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
pprParendIfaceType IfaceKind
ty) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceFunCo Role
r 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
sep (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co2)
  where
    ppr_fun_tail :: IfaceCoercion -> [SDoc]
ppr_fun_tail (IfaceFunCo Role
r IfaceCoercion
co1 IfaceCoercion
co2)
      = (SDoc
arrow SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co2
    ppr_fun_tail IfaceCoercion
other_co
      = [SDoc
arrow SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]

ppr_co PprPrec
_         (IfaceTyConAppCo Role
r IfaceTyCon
tc [IfaceCoercion]
cos)
  = SDoc -> SDoc
parens (PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprIfaceCoTcApp PprPrec
topPrec IfaceTyCon
tc [IfaceCoercion]
cos) SDoc -> SDoc -> SDoc
<> 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
<+> 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
$
    [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(IfLclName, IfaceCoercion)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
  where
    ([(IfLclName, IfaceCoercion)]
tvs, IfaceCoercion
inner_co) = IfaceCoercion -> ([(IfLclName, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co

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

-- Why these three? See Note [TcTyVars in IfaceType]
ppr_co PprPrec
_ (IfaceFreeCoVar TyVar
covar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
covar
ppr_co PprPrec
_ (IfaceCoVarCo IfLclName
covar)   = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
covar
ppr_co PprPrec
_ (IfaceHoleCo TyVar
covar)    = SDoc -> SDoc
braces (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
covar)

ppr_co PprPrec
ctxt_prec (IfaceUnivCo IfaceUnivCoProv
IfaceUnsafeCoerceProv Role
r IfaceKind
ty1 IfaceKind
ty2)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
text String
"UnsafeCo" SDoc -> SDoc -> SDoc
<+> Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
r SDoc -> SDoc -> SDoc
<+>
    IfaceKind -> SDoc
pprParendIfaceType IfaceKind
ty1 SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
pprParendIfaceType IfaceKind
ty2

ppr_co PprPrec
_ (IfaceUnivCo IfaceUnivCoProv
prov Role
role IfaceKind
ty1 IfaceKind
ty2)
  = String -> SDoc
text String
"Univ" SDoc -> SDoc -> SDoc
<> (SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
      [SDoc] -> SDoc
sep [ Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr Role
role SDoc -> SDoc -> SDoc
<+> IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv IfaceUnivCoProv
prov
          , SDoc
dcolon SDoc -> SDoc -> SDoc
<+>  IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
ty1 SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> IfaceKind -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceKind
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
text String
"Inst" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
                        SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
ty

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

ppr_co PprPrec
ctxt_prec (IfaceAxiomInstCo IfExtName
n BranchIndex
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
<> SDoc -> SDoc
brackets (BranchIndex -> SDoc
forall a. Outputable a => a -> SDoc
ppr BranchIndex
i)) [IfaceCoercion]
cos
ppr_co PprPrec
ctxt_prec (IfaceSymCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Sym") [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceTransCo IfaceCoercion
co1 IfaceCoercion
co2)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
opPrec IfaceCoercion
co1 SDoc -> SDoc -> SDoc
<+> SDoc
semi SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
opPrec IfaceCoercion
co2
ppr_co PprPrec
ctxt_prec (IfaceNthCo BranchIndex
d IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Nth:" SDoc -> SDoc -> SDoc
<> BranchIndex -> SDoc
int BranchIndex
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
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
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
sep [SDoc
doc, BranchIndex -> SDoc -> SDoc
nest BranchIndex
4 ([SDoc] -> SDoc
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
underscore SDoc -> SDoc -> SDoc
<> SDoc
pp_role
  where pp_role :: SDoc
pp_role = case Role
r of
                    Role
Nominal          -> Char -> SDoc
char Char
'N'
                    Role
Representational -> Char -> SDoc
char Char
'R'
                    Role
Phantom          -> Char -> SDoc
char Char
'P'

------------------
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv :: IfaceUnivCoProv -> SDoc
pprIfaceUnivCoProv IfaceUnivCoProv
IfaceUnsafeCoerceProv
  = String -> SDoc
text String
"unsafe"
pprIfaceUnivCoProv (IfacePhantomProv IfaceCoercion
co)
  = String -> SDoc
text String
"phantom" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfaceProofIrrelProv IfaceCoercion
co)
  = String -> SDoc
text String
"irrel" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
pprIfaceUnivCoProv (IfacePluginProv String
s)
  = String -> SDoc
text String
"plugin" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
doubleQuotes (String -> SDoc
text String
s)

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

pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote IfaceTyCon
tc =
    PromotionFlag -> SDoc
pprPromotionQuoteI (PromotionFlag -> SDoc) -> PromotionFlag -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted (IfaceTyConInfo -> PromotionFlag)
-> IfaceTyConInfo -> PromotionFlag
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc

pprPromotionQuoteI  :: PromotionFlag -> SDoc
pprPromotionQuoteI :: PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
NotPromoted = SDoc
empty
pprPromotionQuoteI PromotionFlag
IsPromoted    = Char -> SDoc
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 (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 (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 BranchIndex
arity TupleSort
sort) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
arity IO () -> IO () -> IO ()
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 BranchIndex
arity)        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
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 (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
         Word8
1 -> BranchIndex -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon (BranchIndex -> TupleSort -> IfaceTyConSort)
-> IO BranchIndex -> IO (TupleSort -> IfaceTyConSort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (TupleSort -> IfaceTyConSort)
-> IO TupleSort -> IO IfaceTyConSort
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 -> BranchIndex -> IfaceTyConSort
IfaceSumTyCon (BranchIndex -> IfaceTyConSort)
-> IO BranchIndex -> IO IfaceTyConSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
         Word8
_ -> IfaceTyConSort -> IO IfaceTyConSort
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 (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
IfaceTyConInfo (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 (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 (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 IfLclName
n)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
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 (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IfaceTyLit
IfaceNumTyLit Integer
n) }
         Word8
2 -> do { IfLclName
n <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> IfaceTyLit
IfaceStrTyLit IfLclName
n) }
         Word8
_ -> String -> IO IfaceTyLit
forall a. 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 IfaceKind
t ArgFlag
a IfaceAppArgs
ts -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
t IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> ArgFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ArgFlag
a IO () -> IO () -> IO ()
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
           IfaceKind
t  <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
           ArgFlag
a  <- BinHandle -> IO ArgFlag
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 (m :: * -> *) a. Monad m => a -> m a
return (IfaceAppArgs -> IO IfaceAppArgs)
-> IfaceAppArgs -> IO IfaceAppArgs
forall a b. (a -> b) -> a -> b
$! IfaceKind -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceKind
t ArgFlag
a IfaceAppArgs
ts
         Word8
1 -> IfaceAppArgs -> IO IfaceAppArgs
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceAppArgs
IA_Nil
         Word8
_ -> String -> IO IfaceAppArgs
forall a. 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 :: [IfaceKind] -> SDoc
pprIfaceContextArr []     = SDoc
empty
pprIfaceContextArr [IfaceKind
pred] = PprPrec -> IfaceKind -> SDoc
ppr_ty PprPrec
funPrec IfaceKind
pred SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprIfaceContextArr [IfaceKind]
preds  = [IfaceKind] -> SDoc
ppr_parend_preds [IfaceKind]
preds SDoc -> SDoc -> SDoc
<+> SDoc
darrow

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

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

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

    put_ BinHandle
bh (IfaceForAllTy IfaceForAllBndr
aa IfaceKind
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 -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
ab
    put_ BinHandle
bh (IfaceTyVar IfLclName
ad) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
ad
    put_ BinHandle
bh (IfaceAppTy IfaceKind
ae IfaceAppArgs
af) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
            BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
ae
            BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
af
    put_ BinHandle
bh (IfaceFunTy AnonArgFlag
af IfaceKind
ag IfaceKind
ah) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
            BinHandle -> AnonArgFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh AnonArgFlag
af
            BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
ag
            BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
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 IfaceKind
a IfaceCoercion
b)
      = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6; BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
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 IfaceKind
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
                      IfaceKind
ab <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceForAllBndr -> IfaceKind -> IfaceKind
IfaceForAllTy IfaceForAllBndr
aa IfaceKind
ab)
              Word8
1 -> do IfLclName
ad <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> IfaceKind
IfaceTyVar IfLclName
ad)
              Word8
2 -> do IfaceKind
ae <- BinHandle -> IO IfaceKind
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
                      IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceKind -> IfaceAppArgs -> IfaceKind
IfaceAppTy IfaceKind
ae IfaceAppArgs
af)
              Word8
3 -> do AnonArgFlag
af <- BinHandle -> IO AnonArgFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceKind
ag <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceKind
ah <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (AnonArgFlag -> IfaceKind -> IfaceKind -> IfaceKind
IfaceFunTy AnonArgFlag
af IfaceKind
ag IfaceKind
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
                      ; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyCon -> IfaceAppArgs -> IfaceKind
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) }
              Word8
6 -> do { IfaceKind
a <- BinHandle -> IO IfaceKind
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
                      ; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceKind -> IfaceCoercion -> IfaceKind
IfaceCastTy IfaceKind
a IfaceCoercion
b) }
              Word8
7 -> do { IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      ; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfaceKind
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
                      ; IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceKind
IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) }
              Word8
_  -> do IfaceTyLit
n <- BinHandle -> IO IfaceTyLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                       IfaceKind -> IO IfaceKind
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyLit -> IfaceKind
IfaceLitTy IfaceTyLit
n)

instance Binary IfaceMCoercion where
  put_ :: BinHandle -> IfaceMCoercion -> IO ()
put_ BinHandle
bh IfaceMCoercion
IfaceMRefl = do
          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 (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 (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. 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 IfaceKind
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
          BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
a
  put_ BinHandle
bh (IfaceGReflCo Role
a IfaceKind
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 -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
b
          BinHandle -> IfaceMCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceMCoercion
c
  put_ BinHandle
bh (IfaceFunCo Role
a 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
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 IfLclName
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
          BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a
  put_ BinHandle
bh (IfaceAxiomInstCo IfExtName
a BranchIndex
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 -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
b
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
  put_ BinHandle
bh (IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceKind
c IfaceKind
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 -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
c
          BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
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 (IfaceNthCo BranchIndex
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12
          BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
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 IfLclName
a [IfaceCoercion]
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
17
          BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
b
  put_ BinHandle
_ (IfaceFreeCoVar TyVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceFreeCoVar" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
cv)
  put_ BinHandle
_  (IfaceHoleCo TyVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"Can't serialise IfaceHoleCo" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
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 IfaceKind
a <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceKind -> IfaceCoercion
IfaceReflCo IfaceKind
a
           Word8
2 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceKind
b <- BinHandle -> IO IfaceKind
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 (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role -> IfaceKind -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
a IfaceKind
b IfaceMCoercion
c
           Word8
3 -> do Role
a <- BinHandle -> IO Role
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 (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
IfaceFunCo Role
a 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 (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 (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 (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 IfLclName
a <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfLclName -> IfaceCoercion
IfaceCoVarCo IfLclName
a
           Word8
8 -> do IfExtName
a <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   BranchIndex
b <- BinHandle -> IO BranchIndex
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 (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfExtName -> BranchIndex -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a BranchIndex
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
                   IfaceKind
c <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceKind
d <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfaceUnivCoProv -> Role -> IfaceKind -> IfaceKind -> IfaceCoercion
IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceKind
c IfaceKind
d
           Word8
10-> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
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 (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 BranchIndex
a <- BinHandle -> IO BranchIndex
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 (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ BranchIndex -> IfaceCoercion -> IfaceCoercion
IfaceNthCo BranchIndex
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 (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 (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 (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 (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 IfLclName
a <- BinHandle -> IO IfLclName
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 (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfLclName -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo IfLclName
a [IfaceCoercion]
b
           Word8
_ -> String -> IO IfaceCoercion
forall a. 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 IfaceUnivCoProv
IfaceUnsafeCoerceProv = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
  put_ BinHandle
bh (IfacePhantomProv 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 (IfaceProofIrrelProv IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
          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
4
          BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
a

  get :: BinHandle -> IO IfaceUnivCoProv
get BinHandle
bh = do
      Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
      case Word8
tag of
           Word8
1 -> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceUnivCoProv -> IO IfaceUnivCoProv)
-> IfaceUnivCoProv -> IO IfaceUnivCoProv
forall a b. (a -> b) -> a -> b
$ IfaceUnivCoProv
IfaceUnsafeCoerceProv
           Word8
2 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceUnivCoProv -> IO IfaceUnivCoProv
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
3 -> do IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceUnivCoProv -> IO IfaceUnivCoProv
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
4 -> do String
a <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceUnivCoProv -> IO IfaceUnivCoProv
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
_ -> String -> IO IfaceUnivCoProv
forall a. 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 IfaceKind -> IO ()
put_ BinHandle
bh DefMethSpec IfaceKind
VanillaDM     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
    put_ BinHandle
bh (GenericDM IfaceKind
t) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceKind -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceKind
t
    get :: BinHandle -> IO (DefMethSpec IfaceKind)
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> DefMethSpec IfaceKind -> IO (DefMethSpec IfaceKind)
forall (m :: * -> *) a. Monad m => a -> m a
return DefMethSpec IfaceKind
forall ty. DefMethSpec ty
VanillaDM
              Word8
_ -> do { IfaceKind
t <- BinHandle -> IO IfaceKind
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; DefMethSpec IfaceKind -> IO (DefMethSpec IfaceKind)
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceKind -> DefMethSpec IfaceKind
forall ty. ty -> DefMethSpec ty
GenericDM IfaceKind
t) }

instance NFData IfaceType where
  rnf :: IfaceKind -> ()
rnf = \case
    IfaceFreeTyVar TyVar
f1 -> TyVar
f1 TyVar -> () -> ()
`seq` ()
    IfaceTyVar IfLclName
f1 -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
f1
    IfaceLitTy IfaceTyLit
f1 -> IfaceTyLit -> ()
forall a. NFData a => a -> ()
rnf IfaceTyLit
f1
    IfaceAppTy IfaceKind
f1 IfaceAppArgs
f2 -> IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f1 () -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
    IfaceFunTy AnonArgFlag
f1 IfaceKind
f2 IfaceKind
f3 -> AnonArgFlag
f1 AnonArgFlag -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f2 () -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f3
    IfaceForAllTy IfaceForAllBndr
f1 IfaceKind
f2 -> IfaceForAllBndr
f1 IfaceForAllBndr -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f2
    IfaceTyConApp IfaceTyCon
f1 IfaceAppArgs
f2 -> IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f1 () -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f2
    IfaceCastTy IfaceKind
f1 IfaceCoercion
f2 -> IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f1 () -> () -> ()
`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 -> () -> ()
`seq` PromotionFlag
f2 PromotionFlag -> () -> ()
`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 IfLclName
f1 -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
f1

instance NFData IfaceCoercion where
  rnf :: IfaceCoercion -> ()
rnf = \case
    IfaceReflCo IfaceKind
f1 -> IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f1
    IfaceGReflCo Role
f1 IfaceKind
f2 IfaceMCoercion
f3 -> Role
f1 Role -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f2 () -> () -> ()
`seq` IfaceMCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceMCoercion
f3
    IfaceFunCo Role
f1 IfaceCoercion
f2 IfaceCoercion
f3 -> Role
f1 Role -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3
    IfaceTyConAppCo Role
f1 IfaceTyCon
f2 [IfaceCoercion]
f3 -> Role
f1 Role -> () -> ()
`seq` IfaceTyCon -> ()
forall a. NFData a => a -> ()
rnf IfaceTyCon
f2 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
    IfaceAppCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
`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 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3
    IfaceCoVarCo IfLclName
f1 -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
f1
    IfaceAxiomInstCo IfExtName
f1 BranchIndex
f2 [IfaceCoercion]
f3 -> IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
f1 () -> () -> ()
`seq` BranchIndex -> ()
forall a. NFData a => a -> ()
rnf BranchIndex
f2 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
    IfaceAxiomRuleCo IfLclName
f1 [IfaceCoercion]
f2 -> IfLclName -> ()
forall a. NFData a => a -> ()
rnf IfLclName
f1 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f2
    IfaceUnivCo IfaceUnivCoProv
f1 Role
f2 IfaceKind
f3 IfaceKind
f4 -> IfaceUnivCoProv -> ()
forall a. NFData a => a -> ()
rnf IfaceUnivCoProv
f1 () -> () -> ()
`seq` Role
f2 Role -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f3 () -> () -> ()
`seq` IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
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 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceNthCo BranchIndex
f1 IfaceCoercion
f2 -> BranchIndex -> ()
forall a. NFData a => a -> ()
rnf BranchIndex
f1 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceLRCo LeftOrRight
f1 IfaceCoercion
f2 -> LeftOrRight
f1 LeftOrRight -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2
    IfaceInstCo IfaceCoercion
f1 IfaceCoercion
f2 -> IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f1 () -> () -> ()
`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 TyVar
f1 -> TyVar
f1 TyVar -> () -> ()
`seq` ()
    IfaceHoleCo TyVar
f1 -> TyVar
f1 TyVar -> () -> ()
`seq` ()

instance NFData IfaceUnivCoProv where
  rnf :: IfaceUnivCoProv -> ()
rnf IfaceUnivCoProv
x = IfaceUnivCoProv -> () -> ()
seq IfaceUnivCoProv
x ()

instance NFData IfaceMCoercion where
  rnf :: IfaceMCoercion -> ()
rnf IfaceMCoercion
x = IfaceMCoercion -> () -> ()
seq IfaceMCoercion
x ()

instance NFData IfaceOneShot where
  rnf :: IfaceOneShot -> ()
rnf IfaceOneShot
x = IfaceOneShot -> () -> ()
seq IfaceOneShot
x ()

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

instance NFData IfaceTyConInfo where
  rnf :: IfaceTyConInfo -> ()
rnf (IfaceTyConInfo PromotionFlag
f IfaceTyConSort
s) = PromotionFlag
f PromotionFlag -> () -> ()
`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 () -> () -> ()
`seq` IfaceTyConInfo -> ()
forall a. NFData a => a -> ()
rnf IfaceTyConInfo
info

instance NFData IfaceBndr where
  rnf :: IfaceBndr -> ()
rnf = \case
    IfaceIdBndr IfaceTvBndr
id_bndr -> IfaceTvBndr -> ()
forall a. NFData a => a -> ()
rnf IfaceTvBndr
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 IfaceKind
f1 ArgFlag
f2 IfaceAppArgs
f3 -> IfaceKind -> ()
forall a. NFData a => a -> ()
rnf IfaceKind
f1 () -> () -> ()
`seq` ArgFlag
f2 ArgFlag -> () -> ()
`seq` IfaceAppArgs -> ()
forall a. NFData a => a -> ()
rnf IfaceAppArgs
f3