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


This module defines interface types and binders
-}

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

#if !MIN_VERSION_GLASGOW_HASKELL(8,10,0,0)
{-# OPTIONS_GHC -Wno-overlapping-patterns -Wno-incomplete-patterns #-}
  -- N.B. This can be dropped once GHC 8.8 can be dropped as a
  -- bootstrap compiler.
#endif

module GHC.Iface.Type (
        IfExtName, IfLclName,

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

        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
        ifTyConBinderVar, ifTyConBinderName,

        -- Equality testing
        isIfaceLiftedTypeKind,

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

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

        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,

        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst,

        many_ty
    ) where

#include "HsVersions.h"

import GHC.Prelude

import {-# SOURCE #-} GHC.Builtin.Types
                                 ( coercibleTyCon, heqTyCon
                                 , liftedRepDataConTyCon, tupleTyConName
                                 , manyDataConTyCon, oneDataConTyCon )
import {-# SOURCE #-} GHC.Core.Type ( isRuntimeRepTy, isMultiplicityTy )

import GHC.Core.TyCon hiding ( pprPromotionQuote )
import GHC.Core.Coercion.Axiom
import GHC.Types.Var
import GHC.Builtin.Names
import GHC.Types.Name
import GHC.Types.Basic
import GHC.Utils.Binary
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Utils.Misc

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

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

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

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

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

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

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

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

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

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

type IfaceLamBndr = (IfaceBndr, IfaceOneShot)

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

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

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

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

-- | A kind of universal type, used for types and kinds.
--
-- Any time a 'Type' is pretty-printed, it is first converted to an 'IfaceType'
-- before being printed. See Note [Pretty printing via Iface syntax] in "GHC.Core.Ppr.TyThing"
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 IfaceMult IfaceType IfaceType
  | IfaceForAllTy  IfaceForAllBndr IfaceType
  | IfaceTyConApp  IfaceTyCon IfaceAppArgs  -- Not necessarily saturated
                                            -- Includes newtypes, synonyms, tuples
  | IfaceCastTy     IfaceType IfaceCoercion
  | IfaceCoercionTy IfaceCoercion

  | IfaceTupleTy                  -- Saturated tuples (unsaturated ones use IfaceTyConApp)
       TupleSort                  -- What sort of tuple?
       PromotionFlag                 -- A bit like IfaceTyCon
       IfaceAppArgs               -- arity = length args
          -- For promoted data cons, the kind args are omitted

type IfaceMult = IfaceType

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
type IfaceForAllSpecBndr = VarBndr IfaceBndr Specificity

-- | 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 "GHC.Core.TyCon".
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceKind -> IfaceKind
mkIfaceTyConKind :: [IfaceTyConBinder] -> IfaceType -> IfaceType
mkIfaceTyConKind [IfaceTyConBinder]
bndrs IfaceType
res_kind = (IfaceTyConBinder -> IfaceType -> IfaceType)
-> IfaceType -> [IfaceTyConBinder] -> IfaceType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IfaceTyConBinder -> IfaceType -> IfaceType
mk IfaceType
res_kind [IfaceTyConBinder]
bndrs
  where
    mk :: IfaceTyConBinder -> IfaceKind -> IfaceKind
    mk :: IfaceTyConBinder -> IfaceType -> IfaceType
mk (Bndr IfaceBndr
tv (AnonTCB AnonArgFlag
af))   IfaceType
k = AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af IfaceType
many_ty (IfaceBndr -> IfaceType
ifaceBndrType IfaceBndr
tv) IfaceType
k
    mk (Bndr IfaceBndr
tv (NamedTCB ArgFlag
vis)) IfaceType
k = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr IfaceBndr
tv ArgFlag
vis) IfaceType
k

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

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

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

           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 IfaceType
ty ArgFlag
argf IfaceAppArgs
rest <> IfaceAppArgs
xs = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
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)

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

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

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

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

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

We do the same for covars, naturally.

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

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

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

This table adheres to the following rules:

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

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

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

data IfaceTyConInfo   -- Used 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 IfaceCoercion
  | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
  | IfaceAppCo        IfaceCoercion IfaceCoercion
  | IfaceForAllCo     IfaceBndr IfaceCoercion IfaceCoercion
  | IfaceCoVarCo      IfLclName
  | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]
  | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]
       -- There are only a fixed number of CoAxiomRules, so it suffices
       -- to use an IfaceLclName to distinguish them.
       -- See Note [Adding built-in type families] in GHC.Builtin.Types.Literals
  | IfaceUnivCo       IfaceUnivCoProv Role IfaceType IfaceType
  | IfaceSymCo        IfaceCoercion
  | IfaceTransCo      IfaceCoercion IfaceCoercion
  | 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
  = 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 :: IfaceType -> 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 IfaceType
_ = 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 :: IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
ty
  = case ([IfaceForAllBndr]
bndrs, [IfaceType]
theta) of
      ([], []) -> ([IfaceForAllBndr]
bndrs, [IfaceType]
theta, IfaceType
tau)
      ([IfaceForAllBndr], [IfaceType])
_        -> let ([IfaceForAllBndr]
bndrs', [IfaceType]
theta', IfaceType
tau') = IfaceType -> ([IfaceForAllBndr], [IfaceType], IfaceType)
splitIfaceSigmaTy IfaceType
tau
                   in ([IfaceForAllBndr]
bndrs [IfaceForAllBndr] -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall a. [a] -> [a] -> [a]
++ [IfaceForAllBndr]
bndrs', [IfaceType]
theta [IfaceType] -> [IfaceType] -> [IfaceType]
forall a. [a] -> [a] -> [a]
++ [IfaceType]
theta', IfaceType
tau')
  where
    ([IfaceForAllBndr]
bndrs, IfaceType
rho)   = IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls IfaceType
ty
    ([IfaceType]
theta, IfaceType
tau)   = IfaceType -> ([IfaceType], IfaceType)
split_rho IfaceType
rho

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

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

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

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

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

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

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

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

ifTypeIsVarFree :: IfaceType -> Bool
-- Returns True if the type definitely has no variables at all
-- Just used to control pretty printing
ifTypeIsVarFree :: IfaceType -> Bool
ifTypeIsVarFree IfaceType
ty = IfaceType -> Bool
go IfaceType
ty
  where
    go :: IfaceType -> Bool
go (IfaceTyVar {})         = Bool
False
    go (IfaceFreeTyVar {})     = Bool
False
    go (IfaceAppTy IfaceType
fun IfaceAppArgs
args)   = IfaceType -> Bool
go IfaceType
fun Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args
    go (IfaceFunTy AnonArgFlag
_ IfaceType
w IfaceType
arg IfaceType
res) = IfaceType -> Bool
go IfaceType
w Bool -> Bool -> Bool
&& IfaceType -> Bool
go IfaceType
arg Bool -> Bool -> Bool
&& IfaceType -> Bool
go IfaceType
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 IfaceType
arg ArgFlag
_ IfaceAppArgs
args) = IfaceType -> Bool
go IfaceType
arg Bool -> Bool -> Bool
&& IfaceAppArgs -> Bool
go_args IfaceAppArgs
args

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

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

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

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

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

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

    go_prov :: IfaceUnivCoProv -> IfaceUnivCoProv
go_prov (IfacePhantomProv IfaceCoercion
co)    = IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_prov (IfaceProofIrrelProv IfaceCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_prov (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 IfaceType
ty ArgFlag
arg IfaceAppArgs
tys) = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfaceTySubst -> IfaceType -> IfaceType
substIfaceType IfaceTySubst
env IfaceType
ty) ArgFlag
arg (IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
tys)

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


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

stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (PrintExplicitKinds Bool
True)  IfaceAppArgs
tys = IfaceAppArgs
tys
stripInvisArgs (PrintExplicitKinds Bool
False) IfaceAppArgs
tys = IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
tys
    where
      suppress_invis :: IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
c
        = case IfaceAppArgs
c of
            IfaceAppArgs
IA_Nil -> IfaceAppArgs
IA_Nil
            IA_Arg IfaceType
t ArgFlag
argf IfaceAppArgs
ts
              |  ArgFlag -> Bool
isVisibleArgFlag ArgFlag
argf
              -> IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
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 GHC.Core.TyCo.Rep.
              |  Bool
otherwise
              -> IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts

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

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

ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength :: IfaceAppArgs -> Int
ifaceVisAppArgsLength = Int -> IfaceAppArgs -> Int
forall {t}. Num t => t -> IfaceAppArgs -> t
go Int
0
  where
    go :: t -> IfaceAppArgs -> t
go !t
n IfaceAppArgs
IA_Nil = t
n
    go t
n  (IA_Arg IfaceType
_ 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 GHC.Core.ToIface), we simply use the kind of
the TyCon (which is cached) to guide the process of converting the argument
Types into an IfaceAppArgs list.

We also want this behavior for IfaceAppTy, since given:

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

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

    data Type
      = ...
      | AppTy Type Type

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

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

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

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

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

As two running examples, consider the following code:

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

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

  T1 k a
  T2 k a

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

  T1 @{k} a
  T2 @k   a

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

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

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

pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp PprPrec
ctxt_prec SDoc
pp_tc SDoc
pp_ty1 SDoc
pp_ty2
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
opPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
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 -> Int -> SDoc -> SDoc
hang SDoc
pp_fun Int
2 ([SDoc] -> SDoc
sep [SDoc]
pp_tys)

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

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

instance Outputable IfaceBndr where
    ppr :: IfaceBndr -> SDoc
ppr (IfaceIdBndr IfaceIdBndr
bndr) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
bndr
    ppr (IfaceTvBndr IfaceTvBndr
bndr) = Char -> SDoc
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 :: IfaceIdBndr -> SDoc
pprIfaceIdBndr (IfaceType
w, FastString
name, IfaceType
ty) = SDoc -> SDoc
parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
name SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
w) SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)

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

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

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

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

Here we'd like to omit the kind annotation:

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

Note [Printing type abbreviations]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Normally, we pretty-print `TYPE 'LiftedRep` as `Type` (or `*`) and
`FUN 'Many` as `(->)`.
This way, error messages don't refer to levity polymorphism or linearity
if it is not necessary.

However, when printing the definition of Type or (->) with :info,
this would give confusing output: `type (->) = (->)` (#18594).
Solution: detect when we are in :info and disable displaying the synonym
with the SDoc option sdocPrintTypeAbbreviations.

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

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

newtype UseBndrParens      = UseBndrParens Bool
newtype PrintExplicitKinds = PrintExplicitKinds Bool

pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr (FastString
tv, IfaceType
ki) (SuppressBndrSig Bool
suppress_sig) (UseBndrParens Bool
use_parens)
  | Bool
suppress_sig             = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv
  | IfaceType -> Bool
isIfaceLiftedTypeKind IfaceType
ki = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv
  | Bool
otherwise                = SDoc -> SDoc
maybe_parens (FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
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 IfaceIdBndr
bndr) TyConBndrVis
_) = IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
bndr
    go (Bndr (IfaceTvBndr IfaceTvBndr
bndr) TyConBndrVis
vis) =
      -- See Note [Pretty-printing invisible arguments]
      case TyConBndrVis
vis of
        AnonTCB  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 GHC.Core.TyCon.)
          -- Should we print these differently?
        NamedTCB ArgFlag
Required  -> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
        -- See Note [Explicit Case Statement for Specificity]
        NamedTCB (Invisible Specificity
spec) -> case Specificity
spec of
          Specificity
SpecifiedSpec    -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> UseBndrParens -> SDoc
ppr_bndr (Bool -> UseBndrParens
UseBndrParens Bool
True)
          Specificity
InferredSpec     -> 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 IfaceIdBndr
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
0
            BinHandle -> IfaceIdBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceIdBndr
aa
    put_ BinHandle
bh (IfaceTvBndr IfaceTvBndr
ab) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> IfaceTvBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTvBndr
ab
    get :: BinHandle -> IO IfaceBndr
get BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              Word8
0 -> do IfaceIdBndr
aa <- BinHandle -> IO IfaceIdBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceBndr -> IO IfaceBndr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceIdBndr -> IfaceBndr
IfaceIdBndr IfaceIdBndr
aa)
              Word8
_ -> do IfaceTvBndr
ab <- BinHandle -> IO IfaceTvBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceBndr -> IO IfaceBndr
forall (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 :: IfaceType -> SDoc
ppr IfaceType
ty = IfaceType -> SDoc
pprIfaceType IfaceType
ty

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

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

ppr_fun_arrow :: IfaceMult -> SDoc
ppr_fun_arrow :: IfaceType -> SDoc
ppr_fun_arrow IfaceType
w
  | (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) <- IfaceType
w
  , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` (TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
manyDataConTyCon) = SDoc
arrow
  | (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
_) <- IfaceType
w
  , IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` (TyCon -> Unique
forall a. Uniquable a => a -> Unique
getUnique TyCon
oneDataConTyCon) = SDoc
lollipop
  | Bool
otherwise = SDoc -> SDoc
mulArrow (IfaceType -> SDoc
pprIfaceType IfaceType
w)

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

ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec ty :: IfaceType
ty@(IfaceForAllTy {})          = PprPrec -> IfaceType -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceType
ty
ppr_ty PprPrec
ctxt_prec ty :: IfaceType
ty@(IfaceFunTy AnonArgFlag
InvisArg IfaceType
_ IfaceType
_ IfaceType
_) = PprPrec -> IfaceType -> SDoc
ppr_sigma PprPrec
ctxt_prec IfaceType
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 FastString
tyvar)     = FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
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
_ IfaceType
w IfaceType
ty1 IfaceType
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 -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1, [SDoc] -> SDoc
sep (IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
w IfaceType
ty2)]
  where
    ppr_fun_tail :: IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
wthis (IfaceFunTy AnonArgFlag
VisArg IfaceType
wnext IfaceType
ty1 IfaceType
ty2)
      = (IfaceType -> SDoc
ppr_fun_arrow IfaceType
wthis SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceType -> IfaceType -> [SDoc]
ppr_fun_tail IfaceType
wnext IfaceType
ty2
    ppr_fun_tail IfaceType
wthis IfaceType
other_ty
      = [IfaceType -> SDoc
ppr_fun_arrow IfaceType
wthis SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
pprIfaceType IfaceType
other_ty]

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


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

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

ppr_ty PprPrec
ctxt_prec (IfaceCastTy IfaceType
ty IfaceCoercion
co)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      (SDoc -> SDoc
parens (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
ty SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"|>" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceCoercion
co))
      (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctxt_prec IfaceType
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
significant and understandable push-back from those with pedagogy in
mind, which argued that RuntimeRep variables would throw a wrench into
nearly any teach approach since they appear in even the lowly ($)
function's type,

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

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

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

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

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

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

This applies to /quantified/ variables like 'w' above.  What about
variables that are /free/ in the type being printed, which certainly
happens in error messages.  Suppose (#16074) 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 are in the kind of a
binder; only if so, convert free RuntimeRep variables to LiftedRep.
-}

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

    go Bool
ink IfaceTySubst
subs (IfaceForAllTy IfaceForAllBndr
bndr IfaceType
ty)
      = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (IfaceTySubst -> IfaceForAllBndr -> IfaceForAllBndr
go_ifacebndr IfaceTySubst
subs IfaceForAllBndr
bndr) (Bool -> IfaceTySubst -> IfaceType -> IfaceType
go Bool
ink IfaceTySubst
subs IfaceType
ty)

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

    go Bool
in_kind IfaceTySubst
_ ty :: IfaceType
ty@(IfaceFreeTyVar TyVar
tv)
      -- See Note [Defaulting RuntimeRep variables], about free vars
      | Bool
in_kind Bool -> Bool -> Bool
&& Bool
do_runtimereps Bool -> Bool -> Bool
&& Type -> Bool
GHC.Core.Type.isRuntimeRepTy (TyVar -> Type
tyVarKind TyVar
tv)
      = IfaceType
liftedRep_ty
      | Bool
do_multiplicities Bool -> Bool -> Bool
&& Type -> Bool
GHC.Core.Type.isMultiplicityTy (TyVar -> Type
tyVarKind TyVar
tv)
      = IfaceType
many_ty
      | Bool
otherwise
      = IfaceType
ty

    go Bool
ink IfaceTySubst
subs (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tc_args)
      = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (Bool -> IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink IfaceTySubst
subs IfaceAppArgs
tc_args)

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

    go Bool
ink IfaceTySubst
subs (IfaceFunTy AnonArgFlag
af IfaceType
w IfaceType
arg IfaceType
res)
      = AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af (Bool -> IfaceTySubst -> IfaceType -> IfaceType
go Bool
ink IfaceTySubst
subs IfaceType
w) (Bool -> IfaceTySubst -> IfaceType -> IfaceType
go Bool
ink IfaceTySubst
subs IfaceType
arg) (Bool -> IfaceTySubst -> IfaceType -> IfaceType
go Bool
ink IfaceTySubst
subs IfaceType
res)

    go Bool
ink IfaceTySubst
subs (IfaceAppTy IfaceType
t IfaceAppArgs
ts)
      = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (Bool -> IfaceTySubst -> IfaceType -> IfaceType
go Bool
ink IfaceTySubst
subs IfaceType
t) (Bool -> IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
go_args Bool
ink IfaceTySubst
subs IfaceAppArgs
ts)

    go Bool
ink IfaceTySubst
subs (IfaceCastTy IfaceType
x IfaceCoercion
co)
      = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (Bool -> IfaceTySubst -> IfaceType -> IfaceType
go Bool
ink IfaceTySubst
subs IfaceType
x) IfaceCoercion
co

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

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

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

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

liftedRep_ty :: IfaceType
liftedRep_ty :: IfaceType
liftedRep_ty =
    IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon))
                  IfaceAppArgs
IA_Nil
  where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
liftedRepDataConTyCon

many_ty :: IfaceType
many_ty :: IfaceType
many_ty =
    IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
dc_name (PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
IsPromoted IfaceTyConSort
IfaceNormalTyCon))
                  IfaceAppArgs
IA_Nil
  where dc_name :: IfExtName
dc_name = TyCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName TyCon
manyDataConTyCon

hideNonStandardTypes :: (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes :: (IfaceType -> SDoc) -> IfaceType -> SDoc
hideNonStandardTypes IfaceType -> SDoc
f IfaceType
ty
  = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
printExplicitRuntimeReps ->
    (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocLinearTypes ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
linearTypes ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty    ->
    let do_runtimerep :: Bool
do_runtimerep = Bool -> Bool
not Bool
printExplicitRuntimeReps
        do_multiplicity :: Bool
do_multiplicity = Bool -> Bool
not Bool
linearTypes
    in if PprStyle -> Bool
userStyle PprStyle
sty
       then IfaceType -> SDoc
f (Bool -> Bool -> IfaceType -> IfaceType
defaultNonStandardVars Bool
do_runtimerep Bool
do_multiplicity IfaceType
ty)
       else IfaceType -> SDoc
f IfaceType
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 IfaceType
t ArgFlag
argf IfaceAppArgs
ts) = PprPrec -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceType
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 -> (IfaceType, ArgFlag) -> SDoc
ppr_app_arg PprPrec
ctx_prec (IfaceType
t, ArgFlag
argf) =
  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
  case ArgFlag
argf of
       ArgFlag
Required  -> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctx_prec IfaceType
t
       ArgFlag
Specified |  Bool
print_kinds
                 -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
appPrec IfaceType
t
       ArgFlag
Inferred  |  Bool
print_kinds
                 -> Char -> SDoc
char Char
'@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
t)
       ArgFlag
_         -> SDoc
empty

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

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

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

ppr_iface_forall_part :: ShowForAllFlag
                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part :: ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part ShowForAllFlag
show_forall [IfaceForAllBndr]
tvs [IfaceType]
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
        , [IfaceType] -> SDoc
pprIfaceContextArr [IfaceType]
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 :: [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCo []  = SDoc
empty
pprIfaceForAllCo [(FastString, IfaceCoercion)]
tvs = String -> SDoc
text String
"forall" SDoc -> SDoc -> SDoc
<+> [(FastString, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs [(FastString, IfaceCoercion)]
tvs SDoc -> SDoc -> SDoc
<> SDoc
dot

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

pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr IfaceForAllBndr
bndr =
  case IfaceForAllBndr
bndr of
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
Inferred ->
      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)
    Bndr (IfaceTvBndr IfaceTvBndr
tv) ArgFlag
_ ->
      IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
pprIfaceTvBndr IfaceTvBndr
tv SuppressBndrSig
suppress_sig (Bool -> UseBndrParens
UseBndrParens Bool
True)
    Bndr (IfaceIdBndr IfaceIdBndr
idv) ArgFlag
_ -> IfaceIdBndr -> SDoc
pprIfaceIdBndr IfaceIdBndr
idv
  where
    -- See Note [Suppressing binder signatures]
    suppress_sig :: SuppressBndrSig
suppress_sig = Bool -> SuppressBndrSig
SuppressBndrSig Bool
False

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

pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
tvs
   = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitForalls ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_foralls ->
     -- See Note [When to print foralls] in this module.
     Bool -> SDoc -> SDoc
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
|| Bool
print_foralls) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
     [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
   where
     tv_has_kind_var :: VarBndr IfaceBndr argf -> Bool
tv_has_kind_var (Bndr (IfaceTvBndr (FastString
_,IfaceType
kind)) argf
_)
       = Bool -> Bool
not (IfaceType -> Bool
ifTypeIsVarFree IfaceType
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 GHC.Core.TyCo.Rep.

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

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

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

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

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

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

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

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

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

That data family instance is pretty-printed as:

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

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

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

This would be bad, because the '[' looks like a character literal.
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 :: IfaceType -> 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 IfaceType
_
  = SDoc -> SDoc
forall a. a -> a
id

-- See equivalent function in "GHC.Core.TyCo.Rep"
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
-- Given a type-level list (t1 ': t2), see if we can print
-- it in list notation [t1, ...].
-- Precondition: Opt_PrintExplicitKinds is off
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceType
ty1 IfaceType
ty2
  = case IfaceType -> ([IfaceType], Maybe IfaceType)
gather IfaceType
ty2 of
      ([IfaceType]
arg_tys, Maybe IfaceType
Nothing)
        -> Char -> SDoc
char Char
'\'' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (IfaceType -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceType
ty1 ([SDoc] -> SDoc
fsep
                        (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((IfaceType -> SDoc) -> [IfaceType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec) (IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
arg_tys)))))
      ([IfaceType]
arg_tys, Just IfaceType
tl)
        -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> Int -> SDoc -> SDoc
hang (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1)
           Int
2 ([SDoc] -> SDoc
fsep [ SDoc
colon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty | IfaceType
ty <- [IfaceType]
arg_tys [IfaceType] -> [IfaceType] -> [IfaceType]
forall a. [a] -> [a] -> [a]
++ [IfaceType
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 :: IfaceType -> ([IfaceType], Maybe IfaceType)
gather (IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
      , IA_Arg IfaceType
_ ArgFlag
argf (IA_Arg IfaceType
ty1 ArgFlag
Required (IA_Arg IfaceType
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
      , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
      , ([IfaceType]
args, Maybe IfaceType
tl) <- IfaceType -> ([IfaceType], Maybe IfaceType)
gather IfaceType
ty2
      = (IfaceType
ty1IfaceType -> [IfaceType] -> [IfaceType]
forall a. a -> [a] -> [a]
:[IfaceType]
args, Maybe IfaceType
tl)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
nilDataConKey
      = ([], Maybe IfaceType
forall a. Maybe a
Nothing)
    gather IfaceType
ty = ([], IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
ty)

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

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

    if | IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc IfExtName -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
ipClassKey
       , IA_Arg (IfaceLitTy (IfaceStrTyLit FastString
n))
                ArgFlag
Required (IA_Arg IfaceType
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
<> FastString -> SDoc
ftext FastString
n SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"::" SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
ty

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

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

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
       , Bool
False <- Bool
print_kinds
       , IA_Arg IfaceType
_ ArgFlag
argf (IA_Arg IfaceType
ty1 ArgFlag
Required (IA_Arg IfaceType
ty2 ArgFlag
Required IfaceAppArgs
IA_Nil)) <- IfaceAppArgs
tys
       , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
       -> PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList PprPrec
ctxt_prec IfaceType
ty1 IfaceType
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
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec

       | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
funTyConKey
       , IA_Arg (IfaceTyConApp IfaceTyCon
rep IfaceAppArgs
IA_Nil) ArgFlag
Required IfaceAppArgs
args <- IfaceAppArgs
tys
       , IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
manyDataConKey
       , Bool
print_type_abbreviations  -- See Note [Printing type abbreviations]
       -> PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (SDoc -> SDoc
parens SDoc
arrow) ((IfaceType -> SDoc) -> [IfaceType] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
appPrec) ([IfaceType] -> [SDoc]) -> [IfaceType] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
          IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes (IfaceAppArgs -> [IfaceType]) -> IfaceAppArgs -> [IfaceType]
forall a b. (a -> b) -> a -> b
$ PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs (Bool -> PrintExplicitKinds
PrintExplicitKinds Bool
print_kinds) IfaceAppArgs
args)

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

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

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

ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type :: PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocStarIsType ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \case
   Bool
False -> String -> SDoc
text String
"Type"
   Bool
True  -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
starPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
              SDoc -> SDoc -> SDoc
unicodeSyntax (Char -> SDoc
char Char
'★') (Char -> SDoc
char Char
'*')

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

  | Bool
hom_eq_tc
  , [IfaceType
k, IfaceType
t1, IfaceType
t2] <- [IfaceType]
args
  = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType
k, IfaceType
k, IfaceType
t1, IfaceType
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 -> IfaceType -> SDoc
pp = PprPrec -> IfaceType -> 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 :: (IfaceType, IfaceType, IfaceType, IfaceType) -> SDoc
print_equality (IfaceType, IfaceType, IfaceType, IfaceType)
args =
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintExplicitKinds ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_kinds ->
        (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
sdocOption SDocContext -> Bool
sdocPrintEqualityRelations ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
print_eqs ->
        (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
style  ->
        (Bool -> SDoc) -> SDoc
getPprDebug      ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug  ->
        (IfaceType, IfaceType, IfaceType, IfaceType)
-> Bool -> Bool -> SDoc
print_equality' (IfaceType, IfaceType, IfaceType, IfaceType)
args Bool
print_kinds
          (Bool
print_eqs Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| Bool
debug)

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

      | -- Homogeneous use of heterogeneous equality (ty1 ~~ ty2)
        --                 or unlifted equality      (ty1 ~# ty2)
        Bool
nominal_eq_tc, Bool
homogeneous
      = SDoc -> SDoc
ppr_infix_eq (String -> SDoc
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 -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
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 -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
ty1, PprPrec -> IfaceType -> SDoc
pp PprPrec
appPrec IfaceType
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
                               (IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty1 IfaceType
ki1) (IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty2 IfaceType
ki2)
          where
            pp_ty_ki :: IfaceType -> IfaceType -> SDoc
pp_ty_ki IfaceType
ty IfaceType
ki
              | Bool
print_kinds
              = SDoc -> SDoc
parens (PprPrec -> IfaceType -> SDoc
pp PprPrec
topPrec IfaceType
ty SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceType -> SDoc
pp PprPrec
opPrec IfaceType
ki)
              | Bool
otherwise
              = PprPrec -> IfaceType -> SDoc
pp PprPrec
opPrec IfaceType
ty


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 :: forall a.
(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
  = PprPrec -> SDoc
ppr_kind_type PprPrec
ctxt_prec

  | Bool -> Bool
not (OccName -> Bool
isSymOcc (IfExtName -> OccName
nameOccName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)))
  = PprPrec -> SDoc -> [SDoc] -> SDoc
pprIfacePrefixApp PprPrec
ctxt_prec (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc) (((a, 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 :: Int -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum Int
_arity PromotionFlag
is_promoted IfaceAppArgs
args
  =   -- drop the RuntimeRep vars.
      -- See Note [Unboxed tuple RuntimeRep vars] in GHC.Core.TyCon
    let tys :: [IfaceType]
tys   = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
        args' :: [IfaceType]
args' = Int -> [IfaceType] -> [IfaceType]
forall a. Int -> [a] -> [a]
drop ([IfaceType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
    in PromotionFlag -> SDoc
pprPromotionQuoteI PromotionFlag
is_promoted
       SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
sumParens ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithBars (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec) [IfaceType]
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 :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
             args' :: [IfaceType]
args' = Int -> [IfaceType] -> [IfaceType]
forall a. Int -> [a] -> [a]
drop ([IfaceType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
             spaceIfPromoted :: SDoc -> SDoc
spaceIfPromoted = case [IfaceType]
args' of
               IfaceType
arg0:[IfaceType]
_ -> IfaceType -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceType
arg0
               [IfaceType]
_ -> SDoc -> SDoc
forall a. a -> a
id
         in [IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
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 ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
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 GHC.Core.TyCon
         let tys :: [IfaceType]
tys   = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
             args' :: [IfaceType]
args' = case TupleSort
sort of
                       TupleSort
UnboxedTuple -> Int -> [IfaceType] -> [IfaceType]
forall a. Int -> [a] -> [a]
drop ([IfaceType] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [IfaceType]
tys Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [IfaceType]
tys
                       TupleSort
_            -> [IfaceType]
tys
         in
         [IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
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 ((IfaceType -> SDoc) -> [IfaceType] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceType -> SDoc
pprIfaceType [IfaceType]
args')
  where
    ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
    ppr_tuple_app :: [IfaceType] -> SDoc -> SDoc
ppr_tuple_app [IfaceType]
args_wo_runtime_reps SDoc
ppr_args_w_parens
        -- Special-case unary boxed tuples so that they are pretty-printed as
        -- `Solo x`, not `(x)`
      | [IfaceType
_] <- [IfaceType]
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 -> Int -> IfExtName
tupleTyConName TupleSort
sort Int
1) IfaceTyConInfo
unit_tc_info in
        PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
ctxt_prec (IfaceType -> SDoc) -> IfaceType -> SDoc
forall a b. (a -> b) -> a -> b
$ IfaceTyCon -> IfaceAppArgs -> IfaceType
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 FastString
n) = String -> SDoc
text (FastString -> String
forall a. Show a => a -> String
show FastString
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 IfaceType
ty) = SDoc -> SDoc
angleBrackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
Nominal
ppr_co PprPrec
_         (IfaceGReflCo Role
r IfaceType
ty IfaceMCoercion
IfaceMRefl)
  = SDoc -> SDoc
angleBrackets (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r
ppr_co PprPrec
ctxt_prec (IfaceGReflCo Role
r IfaceType
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
<+> IfaceType -> SDoc
pprParendIfaceType IfaceType
ty) [IfaceCoercion
co]
ppr_co PprPrec
ctxt_prec (IfaceFunCo Role
r IfaceCoercion
cow 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 -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
cow IfaceCoercion
co2)
  where
    ppr_fun_tail :: IfaceCoercion -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
cow' (IfaceFunCo Role
r IfaceCoercion
cow IfaceCoercion
co1 IfaceCoercion
co2)
      = (IfaceCoercion -> SDoc
coercionArrow IfaceCoercion
cow' 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 -> IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
cow IfaceCoercion
co2
    ppr_fun_tail IfaceCoercion
cow' IfaceCoercion
other_co
      = [IfaceCoercion -> SDoc
coercionArrow IfaceCoercion
cow' SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]
    coercionArrow :: IfaceCoercion -> SDoc
coercionArrow IfaceCoercion
w = SDoc -> SDoc
mulArrow (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
topPrec IfaceCoercion
w)

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
$
    [(FastString, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(FastString, IfaceCoercion)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
  where
    ([(FastString, IfaceCoercion)]
tvs, IfaceCoercion
inner_co) = IfaceCoercion -> ([(FastString, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co

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

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

ppr_co PprPrec
_ (IfaceUnivCo IfaceUnivCoProv
prov Role
role IfaceType
ty1 IfaceType
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
<+>  IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty1 SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
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 FastString
tc [IfaceCoercion]
cos)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ FastString -> SDoc
forall a. Outputable a => a -> SDoc
ppr FastString
tc SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens ([IfaceCoercion] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [IfaceCoercion]
cos)

ppr_co PprPrec
ctxt_prec (IfaceAxiomInstCo IfExtName
n Int
i [IfaceCoercion]
cos)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfExtName
n SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
i)) [IfaceCoercion]
cos
ppr_co PprPrec
ctxt_prec (IfaceSymCo IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
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 Int
d IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text String
"Nth:" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
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, Int -> SDoc -> SDoc
nest Int
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 (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)

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

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 Int
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 -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
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 Int
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 -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
arity
   put_ BinHandle
bh IfaceTyConSort
IfaceEqualityTyCon           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3

   get :: BinHandle -> IO IfaceTyConSort
get BinHandle
bh = do
       Word8
n <- BinHandle -> IO Word8
getByte BinHandle
bh
       case Word8
n of
         Word8
0 -> IfaceTyConSort -> IO IfaceTyConSort
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConSort
IfaceNormalTyCon
         Word8
1 -> Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon (Int -> TupleSort -> IfaceTyConSort)
-> IO Int -> IO (TupleSort -> IfaceTyConSort)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (TupleSort -> IfaceTyConSort)
-> IO TupleSort -> IO IfaceTyConSort
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO TupleSort
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
         Word8
2 -> Int -> IfaceTyConSort
IfaceSumTyCon (Int -> IfaceTyConSort) -> IO Int -> IO IfaceTyConSort
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
         Word8
_ -> IfaceTyConSort -> IO IfaceTyConSort
forall (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 FastString
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 -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
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 { FastString
n <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceTyLit
IfaceStrTyLit FastString
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 IfaceType
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
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
           IfaceType
t  <- BinHandle -> IO IfaceType
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
$! IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
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 :: [IfaceType] -> SDoc
pprIfaceContextArr []     = SDoc
empty
pprIfaceContextArr [IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
pred SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprIfaceContextArr [IfaceType]
preds  = [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds SDoc -> SDoc -> SDoc
<+> SDoc
darrow

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

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

instance Binary IfaceType where
    put_ :: BinHandle -> IfaceType -> 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 IfaceType
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ab
    put_ BinHandle
bh (IfaceTyVar FastString
ad) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
            BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
ad
    put_ BinHandle
bh (IfaceAppTy IfaceType
ae IfaceAppArgs
af) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
2
            BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ae
            BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
af
    put_ BinHandle
bh (IfaceFunTy AnonArgFlag
af IfaceType
aw IfaceType
ag IfaceType
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
aw
            BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ag
            BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
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 IfaceType
a IfaceCoercion
b)
      = do { BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6; BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
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 IfaceType
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
                      IfaceType
ab <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy IfaceForAllBndr
aa IfaceType
ab)
              Word8
1 -> do FastString
ad <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> IfaceType
IfaceTyVar FastString
ad)
              Word8
2 -> do IfaceType
ae <- BinHandle -> IO IfaceType
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
                      IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy IfaceType
ae IfaceAppArgs
af)
              Word8
3 -> do AnonArgFlag
af <- BinHandle -> IO AnonArgFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceType
aw <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceType
ag <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceType
ah <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (AnonArgFlag -> IfaceType -> IfaceType -> IfaceType -> IfaceType
IfaceFunTy AnonArgFlag
af IfaceType
aw IfaceType
ag IfaceType
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
                      ; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc IfaceAppArgs
tys) }
              Word8
6 -> do { IfaceType
a <- BinHandle -> IO IfaceType
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
                      ; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy IfaceType
a IfaceCoercion
b) }
              Word8
7 -> do { IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      ; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfaceType
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
                      ; IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
s PromotionFlag
i IfaceAppArgs
tys) }
              Word8
_  -> do IfaceTyLit
n <- BinHandle -> IO IfaceTyLit
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                       IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyLit -> IfaceType
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 IfaceType
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
1
          BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a
  put_ BinHandle
bh (IfaceGReflCo Role
a IfaceType
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
b
          BinHandle -> IfaceMCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceMCoercion
c
  put_ BinHandle
bh (IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
3
          BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
w
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
  put_ BinHandle
bh (IfaceTyConAppCo Role
a IfaceTyCon
b [IfaceCoercion]
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
4
          BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
          BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
b
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
  put_ BinHandle
bh (IfaceAppCo IfaceCoercion
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
5
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceForAllCo IfaceBndr
a IfaceCoercion
b IfaceCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
6
          BinHandle -> IfaceBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceBndr
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
  put_ BinHandle
bh (IfaceCoVarCo FastString
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
7
          BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
  put_ BinHandle
bh (IfaceAxiomInstCo IfExtName
a Int
b [IfaceCoercion]
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
8
          BinHandle -> IfExtName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
a
          BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
b
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
  put_ BinHandle
bh (IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceType
c IfaceType
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 -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
c
          BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
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 Int
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
12
          BinHandle -> Int -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Int
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceLRCo LeftOrRight
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
13
          BinHandle -> LeftOrRight -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh LeftOrRight
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceInstCo IfaceCoercion
a IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
14
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ BinHandle
bh (IfaceKindCo IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
15
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ BinHandle
bh (IfaceSubCo IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
16
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ BinHandle
bh (IfaceAxiomRuleCo FastString
a [IfaceCoercion]
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh Word8
17
          BinHandle -> FastString -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh FastString
a
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
b
  put_ BinHandle
_ (IfaceFreeCoVar 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 IfaceType
a <- BinHandle -> IO IfaceType
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
$ IfaceType -> IfaceCoercion
IfaceReflCo IfaceType
a
           Word8
2 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceType
b <- BinHandle -> IO IfaceType
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 -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
a IfaceType
b IfaceMCoercion
c
           Word8
3 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
w <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
c <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role
-> IfaceCoercion -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
a IfaceCoercion
w IfaceCoercion
b IfaceCoercion
c
           Word8
4 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceTyCon
b <- BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
c <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (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 FastString
a <- BinHandle -> IO FastString
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
$ FastString -> IfaceCoercion
IfaceCoVarCo FastString
a
           Word8
8 -> do IfExtName
a <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   Int
b <- BinHandle -> IO Int
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
c <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfExtName -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a Int
b [IfaceCoercion]
c
           Word8
9 -> do IfaceUnivCoProv
a <- BinHandle -> IO IfaceUnivCoProv
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   Role
b <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceType
c <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceType
d <- BinHandle -> IO IfaceType
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 -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo IfaceUnivCoProv
a Role
b IfaceType
c IfaceType
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 Int
a <- BinHandle -> IO Int
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
$ Int -> IfaceCoercion -> IfaceCoercion
IfaceNthCo Int
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 FastString
a <- BinHandle -> IO FastString
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
b <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo FastString
a [IfaceCoercion]
b
           Word8
_ -> String -> IO IfaceCoercion
forall a. String -> a
panic (String
"get IfaceCoercion " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
tag)

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

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

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

instance NFData IfaceCoercion where
  rnf :: IfaceCoercion -> ()
rnf = \case
    IfaceReflCo IfaceType
f1 -> IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f1
    IfaceGReflCo Role
f1 IfaceType
f2 IfaceMCoercion
f3 -> Role
f1 Role -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f2 () -> () -> ()
`seq` IfaceMCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceMCoercion
f3
    IfaceFunCo Role
f1 IfaceCoercion
f2 IfaceCoercion
f3 IfaceCoercion
f4 -> Role
f1 Role -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f2 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f3 () -> () -> ()
`seq` IfaceCoercion -> ()
forall a. NFData a => a -> ()
rnf IfaceCoercion
f4
    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 FastString
f1 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1
    IfaceAxiomInstCo IfExtName
f1 Int
f2 [IfaceCoercion]
f3 -> IfExtName -> ()
forall a. NFData a => a -> ()
rnf IfExtName
f1 () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
f2 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f3
    IfaceAxiomRuleCo FastString
f1 [IfaceCoercion]
f2 -> FastString -> ()
forall a. NFData a => a -> ()
rnf FastString
f1 () -> () -> ()
`seq` [IfaceCoercion] -> ()
forall a. NFData a => a -> ()
rnf [IfaceCoercion]
f2
    IfaceUnivCo IfaceUnivCoProv
f1 Role
f2 IfaceType
f3 IfaceType
f4 -> IfaceUnivCoProv -> ()
forall a. NFData a => a -> ()
rnf IfaceUnivCoProv
f1 () -> () -> ()
`seq` Role
f2 Role -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
f3 () -> () -> ()
`seq` IfaceType -> ()
forall a. NFData a => a -> ()
rnf IfaceType
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 Int
f1 IfaceCoercion
f2 -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
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 Int
arity TupleSort
sort -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity () -> () -> ()
`seq` TupleSort
sort TupleSort -> () -> ()
`seq` ()
    IfaceSumTyCon Int
arity -> Int -> ()
forall a. NFData a => a -> ()
rnf Int
arity
    IfaceTyConSort
IfaceEqualityTyCon -> ()

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

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