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


This module defines interface types and binders
-}

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

module IfaceType (
        IfExtName, IfLclName,

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

        ifForAllBndrVar, ifForAllBndrName, ifaceBndrName,
        ifTyConBinderVar, ifTyConBinderName,

        -- Equality testing
        isIfaceLiftedTypeKind,

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

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

        suppressIfaceInvisibles,
        stripIfaceInvisVars,
        stripInvisArgs,

        mkIfaceTySubst, substIfaceTyVar, substIfaceAppArgs, inDomIfaceTySubst
    ) where

#include "HsVersions.h"

import GhcPrelude

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

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

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

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

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

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

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

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

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

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

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

type IfaceLamBndr = (IfaceBndr, IfaceOneShot)

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


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

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

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

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

type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]

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

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

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

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

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

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

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

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

We do the same for covars, naturally.

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

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

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

This table adheres to the following rules:

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

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

See Note [The equality types story] in TysPrim.
-}

data IfaceTyConInfo   -- Used to guide pretty-printing
                      -- and to disambiguate D from 'D (they share a name)
  = IfaceTyConInfo { IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted :: PromotionFlag
                   , IfaceTyConInfo -> IfaceTyConSort
ifaceTyConSort       :: IfaceTyConSort }
    deriving (IfaceTyConInfo -> IfaceTyConInfo -> Bool
(IfaceTyConInfo -> IfaceTyConInfo -> Bool)
-> (IfaceTyConInfo -> IfaceTyConInfo -> Bool) -> Eq IfaceTyConInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c/= :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
$c== :: IfaceTyConInfo -> IfaceTyConInfo -> Bool
Eq)

data IfaceMCoercion
  = IfaceMRefl
  | IfaceMCo IfaceCoercion

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

data IfaceUnivCoProv
  = IfaceUnsafeCoerceProv
  | IfacePhantomProv IfaceCoercion
  | IfaceProofIrrelProv IfaceCoercion
  | IfacePluginProv String

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


%************************************************************************
%*                                                                      *
                Functions over IFaceTypes
*                                                                      *
************************************************************************
-}

ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey tc :: IfaceTyCon
tc key :: 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 tc :: IfaceTyCon
tc IA_Nil)
  = IfExtName -> Bool
isLiftedTypeKindTyConName (IfaceTyCon -> IfExtName
ifaceTyConName IfaceTyCon
tc)
isIfaceLiftedTypeKind (IfaceTyConApp tc :: IfaceTyCon
tc
                       (IA_Arg (IfaceTyConApp ptr_rep_lifted :: IfaceTyCon
ptr_rep_lifted IA_Nil)
                               Required IA_Nil))
  =  IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
tYPETyConKey
  Bool -> Bool -> Bool
&& IfaceTyCon
ptr_rep_lifted IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepDataConKey
isIfaceLiftedTypeKind _ = 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 ty :: IfaceType
ty
  = case ([IfaceForAllBndr]
bndrs, [IfaceType]
theta) of
      ([], []) -> ([IfaceForAllBndr]
bndrs, [IfaceType]
theta, IfaceType
tau)
      _        -> let (bndrs' :: [IfaceForAllBndr]
bndrs', theta' :: [IfaceType]
theta', tau' :: 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
    (bndrs :: [IfaceForAllBndr]
bndrs, rho :: IfaceType
rho)   = IfaceType -> ([IfaceForAllBndr], IfaceType)
split_foralls IfaceType
ty
    (theta :: [IfaceType]
theta, tau :: IfaceType
tau)   = IfaceType -> ([IfaceType], IfaceType)
split_rho IfaceType
rho

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

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

suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles dflags :: DynFlags
dflags tys :: [IfaceTyConBinder]
tys xs :: [a]
xs
  | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = [a]
xs
  | Bool
otherwise = [IfaceTyConBinder] -> [a] -> [a]
forall tv a. [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [IfaceTyConBinder]
tys [a]
xs
    where
      suppress :: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress _       []      = []
      suppress []      a :: [a]
a       = [a]
a
      suppress (k :: VarBndr tv TyConBndrVis
k:ks :: [VarBndr tv TyConBndrVis]
ks) (x :: a
x:xs :: [a]
xs)
        | VarBndr tv TyConBndrVis -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder VarBndr tv TyConBndrVis
k =     [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs
        | Bool
otherwise                = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [VarBndr tv TyConBndrVis] -> [a] -> [a]
suppress [VarBndr tv TyConBndrVis]
ks [a]
xs

stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
stripIfaceInvisVars dflags :: DynFlags
dflags tyvars :: [IfaceTyConBinder]
tyvars
  | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = [IfaceTyConBinder]
tyvars
  | Bool
otherwise = (IfaceTyConBinder -> Bool)
-> [IfaceTyConBinder] -> [IfaceTyConBinder]
forall a. (a -> Bool) -> [a] -> [a]
filterOut IfaceTyConBinder -> Bool
forall tv. VarBndr tv TyConBndrVis -> Bool
isInvisibleTyConBinder [IfaceTyConBinder]
tyvars

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

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

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

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

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

    go_args :: IfaceAppArgs -> Bool
go_args IA_Nil = Bool
True
    go_args (IA_Arg arg :: IfaceType
arg _ args :: 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 eq_spec :: [IfaceTvBndr]
eq_spec = [IfaceTvBndr] -> IfaceTySubst
forall a. [(IfLclName, a)] -> FastStringEnv a
mkFsEnv [IfaceTvBndr]
eq_spec

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

substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
-- See Note [Substitution on IfaceType]
substIfaceType :: IfaceTySubst -> IfaceType -> IfaceType
substIfaceType env :: IfaceTySubst
env ty :: IfaceType
ty
  = IfaceType -> IfaceType
go IfaceType
ty
  where
    go :: IfaceType -> IfaceType
go (IfaceFreeTyVar tv :: TyVar
tv)    = TyVar -> IfaceType
IfaceFreeTyVar TyVar
tv
    go (IfaceTyVar tv :: IfLclName
tv)        = IfaceTySubst -> IfLclName -> IfaceType
substIfaceTyVar IfaceTySubst
env IfLclName
tv
    go (IfaceAppTy  t :: IfaceType
t ts :: IfaceAppArgs
ts)     = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy  (IfaceType -> IfaceType
go IfaceType
t) (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
ts)
    go (IfaceFunTy  t1 :: IfaceType
t1 t2 :: IfaceType
t2)    = IfaceType -> IfaceType -> IfaceType
IfaceFunTy  (IfaceType -> IfaceType
go IfaceType
t1) (IfaceType -> IfaceType
go IfaceType
t2)
    go (IfaceDFunTy t1 :: IfaceType
t1 t2 :: IfaceType
t2)    = IfaceType -> IfaceType -> IfaceType
IfaceDFunTy (IfaceType -> IfaceType
go IfaceType
t1) (IfaceType -> IfaceType
go IfaceType
t2)
    go ty :: IfaceType
ty@(IfaceLitTy {})     = IfaceType
ty
    go (IfaceTyConApp tc :: IfaceTyCon
tc tys :: IfaceAppArgs
tys) = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
env IfaceAppArgs
tys)
    go (IfaceTupleTy s :: TupleSort
s i :: PromotionFlag
i tys :: 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 "substIfaceType" (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
    go (IfaceCastTy ty :: IfaceType
ty co :: IfaceCoercion
co)    = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (IfaceType -> IfaceType
go IfaceType
ty) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go (IfaceCoercionTy co :: IfaceCoercion
co)   = IfaceCoercion -> IfaceType
IfaceCoercionTy (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)

    go_mco :: IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMRefl    = IfaceMCoercion
IfaceMRefl
    go_mco (IfaceMCo co :: 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 ty :: IfaceType
ty)           = IfaceType -> IfaceCoercion
IfaceReflCo (IfaceType -> IfaceType
go IfaceType
ty)
    go_co (IfaceGReflCo r :: Role
r ty :: IfaceType
ty mco :: IfaceMCoercion
mco)    = Role -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (IfaceType -> IfaceType
go IfaceType
ty) (IfaceMCoercion -> IfaceMCoercion
go_mco IfaceMCoercion
mco)
    go_co (IfaceFunCo r :: Role
r c1 :: IfaceCoercion
c1 c2 :: IfaceCoercion
c2)       = Role -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceTyConAppCo r :: Role
r tc :: IfaceTyCon
tc cos :: [IfaceCoercion]
cos) = Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r IfaceTyCon
tc ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
    go_co (IfaceAppCo c1 :: IfaceCoercion
c1 c2 :: 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 "substIfaceCoercion" (IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
    go_co (IfaceFreeCoVar cv :: TyVar
cv)        = TyVar -> IfaceCoercion
IfaceFreeCoVar TyVar
cv
    go_co (IfaceCoVarCo cv :: IfLclName
cv)          = IfLclName -> IfaceCoercion
IfaceCoVarCo IfLclName
cv
    go_co (IfaceHoleCo cv :: TyVar
cv)           = TyVar -> IfaceCoercion
IfaceHoleCo TyVar
cv
    go_co (IfaceAxiomInstCo a :: IfExtName
a i :: BranchIndex
i cos :: [IfaceCoercion]
cos) = IfExtName -> BranchIndex -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a BranchIndex
i ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)
    go_co (IfaceUnivCo prov :: IfaceUnivCoProv
prov r :: Role
r t1 :: IfaceType
t1 t2 :: 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 co :: IfaceCoercion
co)            = IfaceCoercion -> IfaceCoercion
IfaceSymCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceTransCo co1 :: IfaceCoercion
co1 co2 :: IfaceCoercion
co2)     = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co2)
    go_co (IfaceNthCo n :: BranchIndex
n co :: IfaceCoercion
co)          = BranchIndex -> IfaceCoercion -> IfaceCoercion
IfaceNthCo BranchIndex
n (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceLRCo lr :: LeftOrRight
lr co :: IfaceCoercion
co)          = LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
lr (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceInstCo c1 :: IfaceCoercion
c1 c2 :: IfaceCoercion
c2)        = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c1) (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
c2)
    go_co (IfaceKindCo co :: IfaceCoercion
co)           = IfaceCoercion -> IfaceCoercion
IfaceKindCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceSubCo co :: IfaceCoercion
co)            = IfaceCoercion -> IfaceCoercion
IfaceSubCo (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_co (IfaceAxiomRuleCo n :: IfLclName
n cos :: [IfaceCoercion]
cos)   = IfLclName -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo IfLclName
n ([IfaceCoercion] -> [IfaceCoercion]
go_cos [IfaceCoercion]
cos)

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

    go_prov :: IfaceUnivCoProv -> IfaceUnivCoProv
go_prov IfaceUnsafeCoerceProv    = IfaceUnivCoProv
IfaceUnsafeCoerceProv
    go_prov (IfacePhantomProv co :: IfaceCoercion
co)    = IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_prov (IfaceProofIrrelProv co :: IfaceCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv (IfaceCoercion -> IfaceCoercion
go_co IfaceCoercion
co)
    go_prov (IfacePluginProv str :: String
str)    = String -> IfaceUnivCoProv
IfacePluginProv String
str

substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs :: IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs env :: IfaceTySubst
env args :: IfaceAppArgs
args
  = IfaceAppArgs -> IfaceAppArgs
go IfaceAppArgs
args
  where
    go :: IfaceAppArgs -> IfaceAppArgs
go IA_Nil              = IfaceAppArgs
IA_Nil
    go (IA_Arg ty :: IfaceType
ty arg :: ArgFlag
arg tys :: 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 -> IfLclName -> IfaceType
substIfaceTyVar env :: IfaceTySubst
env tv :: IfLclName
tv
  | Just ty :: IfaceType
ty <- IfaceTySubst -> IfLclName -> Maybe IfaceType
forall a. FastStringEnv a -> IfLclName -> Maybe a
lookupFsEnv IfaceTySubst
env IfLclName
tv = IfaceType
ty
  | Bool
otherwise                     = IfLclName -> IfaceType
IfaceTyVar IfLclName
tv


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

stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs dflags :: DynFlags
dflags tys :: IfaceAppArgs
tys
  | GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags = IfaceAppArgs
tys
  | Bool
otherwise = IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
tys
    where
      suppress_invis :: IfaceAppArgs -> IfaceAppArgs
suppress_invis c :: IfaceAppArgs
c
        = case IfaceAppArgs
c of
            IA_Nil -> IfaceAppArgs
IA_Nil
            IA_Arg t :: IfaceType
t argf :: ArgFlag
argf ts :: 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 TyCoRep.
              |  Bool
otherwise
              -> IfaceAppArgs -> IfaceAppArgs
suppress_invis IfaceAppArgs
ts

appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IA_Nil = []
appArgsIfaceTypes (IA_Arg t :: IfaceType
t _ ts :: 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 IA_Nil = []
appArgsIfaceTypesArgFlags (IA_Arg t :: IfaceType
t a :: ArgFlag
a ts :: 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 -> BranchIndex
ifaceVisAppArgsLength = BranchIndex -> IfaceAppArgs -> BranchIndex
forall t. Num t => t -> IfaceAppArgs -> t
go 0
  where
    go :: t -> IfaceAppArgs -> t
go !t
n IA_Nil = t
n
    go n :: t
n  (IA_Arg _ argf :: ArgFlag
argf rest :: IfaceAppArgs
rest)
      | ArgFlag -> Bool
isVisibleArgFlag ArgFlag
argf = t -> IfaceAppArgs -> t
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+1) IfaceAppArgs
rest
      | Bool
otherwise             = t -> IfaceAppArgs -> t
go t
n IfaceAppArgs
rest

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

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

we want

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

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

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

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

We also want this behavior for IfaceAppTy, since given:

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

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

    data Type
      = ...
      | AppTy Type Type

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

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

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

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

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

As two running examples, consider the following code:

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

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

  T1 k a
  T2 k a

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

  T1 @{k} a
  T2 @k   a

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

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

if_print_coercions :: SDoc  -- ^ if printing coercions
                   -> SDoc  -- ^ otherwise
                   -> SDoc
if_print_coercions :: SDoc -> SDoc -> SDoc
if_print_coercions yes :: SDoc
yes no :: SDoc
no
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \style :: PprStyle
style ->
    if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitCoercions DynFlags
dflags
         Bool -> Bool -> Bool
|| PprStyle -> Bool
dumpStyle PprStyle
style Bool -> Bool -> Bool
|| PprStyle -> Bool
debugStyle PprStyle
style
    then SDoc
yes
    else SDoc
no

pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp :: PprPrec -> SDoc -> SDoc -> SDoc -> SDoc
pprIfaceInfixApp ctxt_prec :: PprPrec
ctxt_prec pp_tc :: SDoc
pp_tc pp_ty1 :: SDoc
pp_ty1 pp_ty2 :: 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 ctxt_prec :: PprPrec
ctxt_prec pp_fun :: SDoc
pp_fun pp_tys :: [SDoc]
pp_tys
  | [SDoc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SDoc]
pp_tys = SDoc
pp_fun
  | Bool
otherwise   = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                  SDoc -> BranchIndex -> SDoc -> SDoc
hang SDoc
pp_fun 2 ([SDoc] -> SDoc
sep [SDoc]
pp_tys)

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

instance Outputable IfaceBndr where
    ppr :: IfaceBndr -> SDoc
ppr (IfaceIdBndr bndr :: IfaceTvBndr
bndr) = IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
bndr
    ppr (IfaceTvBndr bndr :: IfaceTvBndr
bndr) = Char -> SDoc
char '@' SDoc -> SDoc -> SDoc
<+> Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr Bool
False IfaceTvBndr
bndr

pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs bs :: [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 (b :: IfaceBndr
b, IfaceNoOneShot) = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b
pprIfaceLamBndr (b :: IfaceBndr
b, IfaceOneShot)   = IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceBndr
b SDoc -> SDoc -> SDoc
<> String -> SDoc
text "[OneShot]"

pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr :: IfaceTvBndr -> SDoc
pprIfaceIdBndr (name :: IfLclName
name, ty :: IfaceType
ty) = SDoc -> SDoc
parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)

pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr use_parens :: Bool
use_parens (tv :: IfLclName
tv, ki :: IfaceType
ki)
  | IfaceType -> Bool
isIfaceLiftedTypeKind IfaceType
ki = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv
  | Bool
otherwise                = SDoc -> SDoc
maybe_parens (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> 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 :: [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders = [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 bndr :: IfaceTvBndr
bndr) _) = IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
bndr
    go (Bndr (IfaceTvBndr bndr :: IfaceTvBndr
bndr) vis :: TyConBndrVis
vis) =
      -- See Note [Pretty-printing invisible arguments]
      case TyConBndrVis
vis of
        AnonTCB            -> Bool -> SDoc
ppr_bndr Bool
True
        NamedTCB Required  -> Bool -> SDoc
ppr_bndr Bool
True
        NamedTCB Specified -> Char -> SDoc
char '@' SDoc -> SDoc -> SDoc
<> Bool -> SDoc
ppr_bndr Bool
True
        NamedTCB Inferred  -> Char -> SDoc
char '@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (Bool -> SDoc
ppr_bndr Bool
False)
      where
        ppr_bndr :: Bool -> SDoc
ppr_bndr use_parens :: Bool
use_parens = Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr Bool
use_parens IfaceTvBndr
bndr

instance Binary IfaceBndr where
    put_ :: BinHandle -> IfaceBndr -> IO ()
put_ bh :: BinHandle
bh (IfaceIdBndr aa :: IfaceTvBndr
aa) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
            BinHandle -> IfaceTvBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTvBndr
aa
    put_ bh :: BinHandle
bh (IfaceTvBndr ab :: IfaceTvBndr
ab) = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
            BinHandle -> IfaceTvBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTvBndr
ab
    get :: BinHandle -> IO IfaceBndr
get bh :: BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              0 -> do IfaceTvBndr
aa <- BinHandle -> IO IfaceTvBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceBndr -> IO IfaceBndr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTvBndr -> IfaceBndr
IfaceIdBndr IfaceTvBndr
aa)
              _ -> 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_ bh :: BinHandle
bh IfaceNoOneShot = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh IfaceOneShot = do
            BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
    get :: BinHandle -> IO IfaceOneShot
get bh :: BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              0 -> do IfaceOneShot -> IO IfaceOneShot
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceOneShot
IfaceNoOneShot
              _ -> 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 ty :: 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 `eliminateRuntimeRep`, since the `pprPrecIfaceType` maybe
-- called from other places, besides `:type` and `:info`.
pprPrecIfaceType :: PprPrec -> IfaceType -> SDoc
pprPrecIfaceType prec :: PprPrec
prec ty :: IfaceType
ty = (IfaceType -> SDoc) -> IfaceType -> SDoc
eliminateRuntimeRep (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
prec) IfaceType
ty

ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty :: PprPrec -> IfaceType -> SDoc
ppr_ty _         (IfaceFreeTyVar tyvar :: TyVar
tyvar) = TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tyvar  -- This is the main reason for IfaceFreeTyVar!
ppr_ty _         (IfaceTyVar tyvar :: IfLclName
tyvar)     = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
tyvar  -- See Note [TcTyVars in IfaceType]
ppr_ty ctxt_prec :: PprPrec
ctxt_prec (IfaceTyConApp tc :: IfaceTyCon
tc tys :: IfaceAppArgs
tys) = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys
ppr_ty ctxt_prec :: PprPrec
ctxt_prec (IfaceTupleTy i :: TupleSort
i p :: PromotionFlag
p tys :: IfaceAppArgs
tys) = PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc
pprTuple PprPrec
ctxt_prec TupleSort
i PromotionFlag
p IfaceAppArgs
tys
ppr_ty _         (IfaceLitTy n :: IfaceTyLit
n)         = IfaceTyLit -> SDoc
pprIfaceTyLit IfaceTyLit
n
        -- Function types
ppr_ty ctxt_prec :: PprPrec
ctxt_prec (IfaceFunTy ty1 :: IfaceType
ty1 ty2 :: IfaceType
ty2)
  = -- 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 -> [SDoc]
ppr_fun_tail IfaceType
ty2)]
  where
    ppr_fun_tail :: IfaceType -> [SDoc]
ppr_fun_tail (IfaceFunTy ty1 :: IfaceType
ty1 ty2 :: IfaceType
ty2)
      = (SDoc
arrow SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceType -> [SDoc]
ppr_fun_tail IfaceType
ty2
    ppr_fun_tail other_ty :: IfaceType
other_ty
      = [SDoc
arrow SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
pprIfaceType IfaceType
other_ty]

ppr_ty ctxt_prec :: PprPrec
ctxt_prec (IfaceAppTy t :: IfaceType
t ts :: IfaceAppArgs
ts)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      SDoc
ppr_app_ty
      SDoc
ppr_app_ty_no_casts
  where
    ppr_app_ty :: SDoc
ppr_app_ty =
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
        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) (DynFlags -> [(IfaceType, ArgFlag)]
tys_wo_kinds DynFlags
dflags))

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

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

    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
    mk_app_tys :: IfaceType -> IfaceAppArgs -> IfaceType
mk_app_tys (IfaceTyConApp tc :: IfaceTyCon
tc tys1 :: IfaceAppArgs
tys1) tys2 :: 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 t1 :: IfaceType
t1 tys2 :: IfaceAppArgs
tys2 = IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy IfaceType
t1 IfaceAppArgs
tys2

ppr_ty ctxt_prec :: PprPrec
ctxt_prec (IfaceCastTy ty :: IfaceType
ty co :: 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 "|>" 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 ctxt_prec :: PprPrec
ctxt_prec (IfaceCoercionTy co :: IfaceCoercion
co)
  = SDoc -> SDoc -> SDoc
if_print_coercions
      (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
ctxt_prec IfaceCoercion
co)
      (String -> SDoc
text "<>")

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

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

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

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

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

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

For this reason it was decided that we would hide RuntimeRep variables
for now (see #11549). We do this by defaulting all type variables of
kind RuntimeRep to LiftedRep. This is done in a pass right before
pretty-printing (defaultRuntimeRepVars, controlled by
-fprint-explicit-runtime-reps)

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

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

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

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

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

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

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

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

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

    go ink :: Bool
ink subs :: FastStringEnv ()
subs (IfaceFunTy arg :: IfaceType
arg res :: IfaceType
res)
      = IfaceType -> IfaceType -> IfaceType
IfaceFunTy (Bool -> FastStringEnv () -> IfaceType -> IfaceType
go Bool
ink FastStringEnv ()
subs IfaceType
arg) (Bool -> FastStringEnv () -> IfaceType -> IfaceType
go Bool
ink FastStringEnv ()
subs IfaceType
res)

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

    go ink :: Bool
ink subs :: FastStringEnv ()
subs (IfaceDFunTy x :: IfaceType
x y :: IfaceType
y)
      = IfaceType -> IfaceType -> IfaceType
IfaceDFunTy (Bool -> FastStringEnv () -> IfaceType -> IfaceType
go Bool
ink FastStringEnv ()
subs IfaceType
x) (Bool -> FastStringEnv () -> IfaceType -> IfaceType
go Bool
ink FastStringEnv ()
subs IfaceType
y)

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

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

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

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

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

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

eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
eliminateRuntimeRep f :: IfaceType -> SDoc
f ty :: IfaceType
ty
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \sty :: PprStyle
sty    ->
    if PprStyle -> Bool
userStyle PprStyle
sty Bool -> Bool -> Bool
&& Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitRuntimeReps DynFlags
dflags)
      then IfaceType -> SDoc
f (IfaceType -> IfaceType
defaultRuntimeRepVars IfaceType
ty)
      else IfaceType -> SDoc
f IfaceType
ty

instance Outputable IfaceAppArgs where
  ppr :: IfaceAppArgs -> SDoc
ppr tca :: 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 ctx_prec :: PprPrec
ctx_prec = IfaceAppArgs -> SDoc
go
  where
    go :: IfaceAppArgs -> SDoc
    go :: IfaceAppArgs -> SDoc
go IA_Nil             = SDoc
empty
    go (IA_Arg t :: IfaceType
t argf :: ArgFlag
argf ts :: 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 ctx_prec :: PprPrec
ctx_prec (t :: IfaceType
t, argf :: ArgFlag
argf) =
  (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
  let print_kinds :: Bool
print_kinds = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags
  in case ArgFlag
argf of
       Required  -> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
ctx_prec IfaceType
t
       Specified |  Bool
print_kinds
                 -> Char -> SDoc
char '@' SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
appPrec IfaceType
t
       Inferred  |  Bool
print_kinds
                 -> Char -> SDoc
char '@' SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
topPrec IfaceType
t)
       _         -> SDoc
empty

-------------------
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
pprIfaceForAllPart tvs :: [IfaceForAllBndr]
tvs ctxt :: [IfaceType]
ctxt sdoc :: 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 tvs :: [IfaceForAllBndr]
tvs ctxt :: [IfaceType]
ctxt sdoc :: 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 :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart tvs :: [(IfLclName, IfaceCoercion)]
tvs sdoc :: SDoc
sdoc
  = [SDoc] -> SDoc
sep [ [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCo [(IfLclName, IfaceCoercion)]
tvs, SDoc
sdoc ]

ppr_iface_forall_part :: ShowForAllFlag
                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
ppr_iface_forall_part :: ShowForAllFlag -> [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
ppr_iface_forall_part show_forall :: ShowForAllFlag
show_forall tvs :: [IfaceForAllBndr]
tvs ctxt :: [IfaceType]
ctxt sdoc :: SDoc
sdoc
  = [SDoc] -> SDoc
sep [ case ShowForAllFlag
show_forall of
            ShowForAllMust -> [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
            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 _ vis :: ArgFlag
vis : _)
  = [SDoc] -> SDoc
sep [ SDoc -> SDoc
add_separator (SDoc
forAllLit SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep [SDoc]
docs)
        , [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
bndrs' ]
  where
    (bndrs' :: [IfaceForAllBndr]
bndrs', docs :: [SDoc]
docs) = [IfaceForAllBndr] -> ArgFlag -> ([IfaceForAllBndr], [SDoc])
ppr_itv_bndrs [IfaceForAllBndr]
bndrs ArgFlag
vis

    add_separator :: SDoc -> SDoc
add_separator stuff :: SDoc
stuff = case ArgFlag
vis of
                            Required -> SDoc
stuff SDoc -> SDoc -> SDoc
<+> SDoc
arrow
                            _inv :: 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 _ vis :: ArgFlag
vis) : bndrs :: [IfaceForAllBndr]
bndrs) vis1 :: ArgFlag
vis1
  | ArgFlag
vis ArgFlag -> ArgFlag -> Bool
`sameVis` ArgFlag
vis1 = let (bndrs' :: [IfaceForAllBndr]
bndrs', doc :: [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 [] _ = ([], [])

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

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

pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr (Bndr (IfaceTvBndr tv :: IfaceTvBndr
tv) Inferred)
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
                          if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitForalls DynFlags
dflags
                          then SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr Bool
False IfaceTvBndr
tv
                          else Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr Bool
True IfaceTvBndr
tv
pprIfaceForAllBndr (Bndr (IfaceTvBndr tv :: IfaceTvBndr
tv) _)  = Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr Bool
True IfaceTvBndr
tv
pprIfaceForAllBndr (Bndr (IfaceIdBndr idv :: IfaceTvBndr
idv) _) = IfaceTvBndr -> SDoc
pprIfaceIdBndr IfaceTvBndr
idv

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

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

pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType :: ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType show_forall :: ShowForAllFlag
show_forall ty :: IfaceType
ty
  = (IfaceType -> SDoc) -> IfaceType -> SDoc
eliminateRuntimeRep IfaceType -> SDoc
ppr_fn IfaceType
ty
  where
    ppr_fn :: IfaceType -> SDoc
ppr_fn iface_ty :: IfaceType
iface_ty =
      let (tvs :: [IfaceForAllBndr]
tvs, theta :: [IfaceType]
theta, tau :: 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 tvs :: [IfaceForAllBndr]
tvs
   = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
     -- See Note [When to print foralls]
     Bool -> SDoc -> SDoc
ppWhen ((IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall argf. VarBndr IfaceBndr argf -> Bool
tv_has_kind_var [IfaceForAllBndr]
tvs
             Bool -> Bool -> Bool
|| (IfaceForAllBndr -> Bool) -> [IfaceForAllBndr] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any IfaceForAllBndr -> Bool
forall tv. VarBndr tv ArgFlag -> Bool
tv_is_required [IfaceForAllBndr]
tvs
             Bool -> Bool -> Bool
|| GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitForalls DynFlags
dflags) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
     [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs
   where
     tv_has_kind_var :: VarBndr IfaceBndr argf -> Bool
tv_has_kind_var (Bndr (IfaceTvBndr (_,kind :: IfaceType
kind)) _)
       = Bool -> Bool
not (IfaceType -> Bool
ifTypeIsVarFree IfaceType
kind)
     tv_has_kind_var _ = Bool
False

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

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

1. -fprint-explicit-foralls is on.

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

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

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

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

     T :: forall k -> k -> Type

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

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

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

   See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
   in TyCoRep.

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

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

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

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

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

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

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

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

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

That data family instance is pretty-printed as:

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

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

Note [Printing promoted type constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this GHCi session (Trac #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 tyCon :: IfaceTyCon
tyCon _)
  = case IfaceTyConInfo -> PromotionFlag
ifaceTyConIsPromoted (IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tyCon) of
      IsPromoted -> (SDoc
space SDoc -> SDoc -> SDoc
<>)
      _ -> SDoc -> SDoc
forall a. a -> a
id
pprSpaceIfPromotedTyCon _
  = SDoc -> SDoc
forall a. a -> a
id

-- See equivalent function in TyCoRep.hs
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
-- Given a type-level list (t1 ': t2), see if we can print
-- it in list notation [t1, ...].
-- Precondition: Opt_PrintExplicitKinds is off
pprIfaceTyList :: PprPrec -> IfaceType -> IfaceType -> SDoc
pprIfaceTyList ctxt_prec :: PprPrec
ctxt_prec ty1 :: IfaceType
ty1 ty2 :: IfaceType
ty2
  = case IfaceType -> ([IfaceType], Maybe IfaceType)
gather IfaceType
ty2 of
      (arg_tys :: [IfaceType]
arg_tys, Nothing)
        -> Char -> SDoc
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)))))
      (arg_tys :: [IfaceType]
arg_tys, Just tl :: IfaceType
tl)
        -> PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> BranchIndex -> SDoc -> SDoc
hang (PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
ty1)
           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 tc :: IfaceTyCon
tc tys :: IfaceAppArgs
tys)
      | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
      , IA_Arg _ argf :: ArgFlag
argf (IA_Arg ty1 :: IfaceType
ty1 Required (IA_Arg ty2 :: IfaceType
ty2 Required IA_Nil)) <- IfaceAppArgs
tys
      , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
argf
      , (args :: [IfaceType]
args, tl :: 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 ty :: IfaceType
ty = ([], IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
ty)

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

pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprTyTcApp ctxt_prec :: PprPrec
ctxt_prec tc :: IfaceTyCon
tc tys :: IfaceAppArgs
tys =
    (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
    (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \style :: PprStyle
style ->
    PprPrec
-> IfaceTyCon -> IfaceAppArgs -> DynFlags -> PprStyle -> SDoc
pprTyTcApp' PprPrec
ctxt_prec IfaceTyCon
tc IfaceAppArgs
tys DynFlags
dflags PprStyle
style

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

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

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

  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
consDataConKey
  , Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintExplicitKinds DynFlags
dflags)
  , IA_Arg _ argf :: ArgFlag
argf (IA_Arg ty1 :: IfaceType
ty1 Required (IA_Arg ty2 :: IfaceType
ty2 Required 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 rep :: IfaceTyCon
rep IA_Nil) Required IA_Nil <- IfaceAppArgs
tys
  , IfaceTyCon
rep IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedRepDataConKey
  = SDoc
kindType

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

       | Just doc :: 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)]
tys_wo_kinds
  where
    info :: IfaceTyConInfo
info = IfaceTyCon -> IfaceTyConInfo
ifaceTyConInfo IfaceTyCon
tc
    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
$ DynFlags -> IfaceAppArgs -> IfaceAppArgs
stripInvisArgs DynFlags
dflags IfaceAppArgs
tys

-- | Pretty-print a type-level equality.
-- Returns (Just doc) if the argument is a /saturated/ application
-- of   eqTyCon          (~)
--      eqPrimTyCon      (~#)
--      eqReprPrimTyCon  (~R#)
--      heqTyCon         (~~)
--
-- See Note [Equality predicates in IfaceType]
-- and Note [The equality types story] in TysPrim
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality :: PprPrec -> IfaceTyCon -> [IfaceType] -> Maybe SDoc
ppr_equality ctxt_prec :: PprPrec
ctxt_prec tc :: IfaceTyCon
tc args :: [IfaceType]
args
  | Bool
hetero_eq_tc
  , [k1 :: IfaceType
k1, k2 :: IfaceType
k2, t1 :: IfaceType
t1, t2 :: 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
  , [k :: IfaceType
k, t1 :: IfaceType
t1, t2 :: 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
                          IfaceEqualityTyCon -> Bool
True
                          _other :: 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 args :: (IfaceType, IfaceType, IfaceType, IfaceType)
args =
        (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
        (PprStyle -> SDoc) -> SDoc
getPprStyle      ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \style :: PprStyle
style  ->
        (IfaceType, IfaceType, IfaceType, IfaceType)
-> PprStyle -> DynFlags -> SDoc
print_equality' (IfaceType, IfaceType, IfaceType, IfaceType)
args PprStyle
style DynFlags
dflags

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

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

      | -- 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 eq_op :: 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 ty :: IfaceType
ty ki :: 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

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


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

-- | Pretty-prints an application of a type constructor to some arguments
-- (whose visibilities are known). This is polymorphic (over @a@) since we use
-- this function to pretty-print two different things:
--
-- 1. Types (from `pprTyTcApp'`)
--
-- 2. Coercions (from 'pprIfaceCoTcApp')
ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
                 -> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app :: (PprPrec -> (a, ArgFlag) -> SDoc)
-> PprPrec -> IfaceTyCon -> [(a, ArgFlag)] -> SDoc
ppr_iface_tc_app pp :: PprPrec -> (a, ArgFlag) -> SDoc
pp _ tc :: IfaceTyCon
tc [ty :: (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 pp :: PprPrec -> (a, ArgFlag) -> SDoc
pp ctxt_prec :: PprPrec
ctxt_prec tc :: IfaceTyCon
tc tys :: [(a, ArgFlag)]
tys
  | IfaceTyCon
tc IfaceTyCon -> Unique -> Bool
`ifaceTyConHasKey` Unique
liftedTypeKindTyConKey
  = SDoc
kindType

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

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

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

pprSum :: Arity -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum :: BranchIndex -> PromotionFlag -> IfaceAppArgs -> SDoc
pprSum _arity :: BranchIndex
_arity is_promoted :: PromotionFlag
is_promoted args :: IfaceAppArgs
args
  =   -- drop the RuntimeRep vars.
      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
    let tys :: [IfaceType]
tys   = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
        args' :: [IfaceType]
args' = BranchIndex -> [IfaceType] -> [IfaceType]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceType] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceType]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` 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 ctxt_prec :: PprPrec
ctxt_prec ConstraintTuple NotPromoted IA_Nil
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    String -> SDoc
text "() :: Constraint"

-- All promoted constructors have kind arguments
pprTuple _ sort :: TupleSort
sort IsPromoted args :: IfaceAppArgs
args
  = let tys :: [IfaceType]
tys = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
        args' :: [IfaceType]
args' = BranchIndex -> [IfaceType] -> [IfaceType]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceType] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceType]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` 2) [IfaceType]
tys
        spaceIfPromoted :: SDoc -> SDoc
spaceIfPromoted = case [IfaceType]
args' of
          arg0 :: IfaceType
arg0:_ -> IfaceType -> SDoc -> SDoc
pprSpaceIfPromotedTyCon IfaceType
arg0
          _ -> SDoc -> SDoc
forall a. a -> a
id
    in 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'))

pprTuple _ sort :: TupleSort
sort promoted :: PromotionFlag
promoted args :: IfaceAppArgs
args
  =   -- drop the RuntimeRep vars.
      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
    let tys :: [IfaceType]
tys   = IfaceAppArgs -> [IfaceType]
appArgsIfaceTypes IfaceAppArgs
args
        args' :: [IfaceType]
args' = case TupleSort
sort of
                  UnboxedTuple -> BranchIndex -> [IfaceType] -> [IfaceType]
forall a. BranchIndex -> [a] -> [a]
drop ([IfaceType] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceType]
tys BranchIndex -> BranchIndex -> BranchIndex
forall a. Integral a => a -> a -> a
`div` 2) [IfaceType]
tys
                  _            -> [IfaceType]
tys
    in
    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')

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

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

ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co :: PprPrec -> IfaceCoercion -> SDoc
ppr_co _         (IfaceReflCo ty :: 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 _         (IfaceGReflCo r :: Role
r ty :: IfaceType
ty 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 ctxt_prec :: PprPrec
ctxt_prec (IfaceGReflCo r :: Role
r ty :: IfaceType
ty (IfaceMCo co :: IfaceCoercion
co))
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec
    (String -> SDoc
text "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 ctxt_prec :: PprPrec
ctxt_prec (IfaceFunCo r :: Role
r co1 :: IfaceCoercion
co1 co2 :: IfaceCoercion
co2)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
sep (PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1 SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co2)
  where
    ppr_fun_tail :: IfaceCoercion -> [SDoc]
ppr_fun_tail (IfaceFunCo r :: Role
r co1 :: IfaceCoercion
co1 co2 :: IfaceCoercion
co2)
      = (SDoc
arrow SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> PprPrec -> IfaceCoercion -> SDoc
ppr_co PprPrec
funPrec IfaceCoercion
co1) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: IfaceCoercion -> [SDoc]
ppr_fun_tail IfaceCoercion
co2
    ppr_fun_tail other_co :: IfaceCoercion
other_co
      = [SDoc
arrow SDoc -> SDoc -> SDoc
<> Role -> SDoc
ppr_role Role
r SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
other_co]

ppr_co _         (IfaceTyConAppCo r :: Role
r tc :: IfaceTyCon
tc cos :: [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 ctxt_prec :: PprPrec
ctxt_prec (IfaceAppCo co1 :: IfaceCoercion
co1 co2 :: 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 ctxt_prec :: PprPrec
ctxt_prec co :: IfaceCoercion
co@(IfaceForAllCo {})
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
pprIfaceForAllCoPart [(IfLclName, IfaceCoercion)]
tvs (IfaceCoercion -> SDoc
pprIfaceCoercion IfaceCoercion
inner_co)
  where
    (tvs :: [(IfLclName, IfaceCoercion)]
tvs, inner_co :: IfaceCoercion
inner_co) = IfaceCoercion -> ([(IfLclName, IfaceCoercion)], IfaceCoercion)
split_co IfaceCoercion
co

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

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

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

ppr_co _ (IfaceUnivCo prov :: IfaceUnivCoProv
prov role :: Role
role ty1 :: IfaceType
ty1 ty2 :: IfaceType
ty2)
  = String -> SDoc
text "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 ctxt_prec :: PprPrec
ctxt_prec (IfaceInstCo co :: IfaceCoercion
co ty :: 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 "Inst" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co
                        SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
ty

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

ppr_co ctxt_prec :: PprPrec
ctxt_prec (IfaceAxiomInstCo n :: IfExtName
n i :: BranchIndex
i cos :: [IfaceCoercion]
cos)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (IfExtName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfExtName
n SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
brackets (BranchIndex -> SDoc
forall a. Outputable a => a -> SDoc
ppr BranchIndex
i)) [IfaceCoercion]
cos
ppr_co ctxt_prec :: PprPrec
ctxt_prec (IfaceSymCo co :: IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text "Sym") [IfaceCoercion
co]
ppr_co ctxt_prec :: PprPrec
ctxt_prec (IfaceTransCo co1 :: IfaceCoercion
co1 co2 :: 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 ctxt_prec :: PprPrec
ctxt_prec (IfaceNthCo d :: BranchIndex
d co :: IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text "Nth:" SDoc -> SDoc -> SDoc
<> BranchIndex -> SDoc
int BranchIndex
d) [IfaceCoercion
co]
ppr_co ctxt_prec :: PprPrec
ctxt_prec (IfaceLRCo lr :: LeftOrRight
lr co :: 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 ctxt_prec :: PprPrec
ctxt_prec (IfaceSubCo co :: IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text "Sub") [IfaceCoercion
co]
ppr_co ctxt_prec :: PprPrec
ctxt_prec (IfaceKindCo co :: IfaceCoercion
co)
  = PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co PprPrec
ctxt_prec (String -> SDoc
text "Kind") [IfaceCoercion
co]

ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co :: PprPrec -> SDoc -> [IfaceCoercion] -> SDoc
ppr_special_co ctxt_prec :: PprPrec
ctxt_prec doc :: SDoc
doc cos :: [IfaceCoercion]
cos
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
ctxt_prec PprPrec
appPrec
               ([SDoc] -> SDoc
sep [SDoc
doc, BranchIndex -> SDoc -> SDoc
nest 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 r :: Role
r = SDoc
underscore SDoc -> SDoc -> SDoc
<> SDoc
pp_role
  where pp_role :: SDoc
pp_role = case Role
r of
                    Nominal          -> Char -> SDoc
char 'N'
                    Representational -> Char -> SDoc
char 'R'
                    Phantom          -> Char -> SDoc
char 'P'

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

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

pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote :: IfaceTyCon -> SDoc
pprPromotionQuote tc :: 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 NotPromoted = SDoc
empty
pprPromotionQuoteI IsPromoted    = Char -> SDoc
char '\''

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

instance Binary IfaceTyCon where
   put_ :: BinHandle -> IfaceTyCon -> IO ()
put_ bh :: BinHandle
bh (IfaceTyCon n :: IfExtName
n i :: 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 bh :: 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_ bh :: BinHandle
bh IfaceNormalTyCon             = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
   put_ bh :: BinHandle
bh (IfaceTupleTyCon arity :: BranchIndex
arity sort :: TupleSort
sort) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
arity IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> TupleSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
sort
   put_ bh :: BinHandle
bh (IfaceSumTyCon arity :: BranchIndex
arity)        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
arity
   put_ bh :: BinHandle
bh IfaceEqualityTyCon           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3

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

instance Binary IfaceTyConInfo where
   put_ :: BinHandle -> IfaceTyConInfo -> IO ()
put_ bh :: BinHandle
bh (IfaceTyConInfo i :: PromotionFlag
i s :: 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 bh :: 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_ bh :: BinHandle
bh (IfaceNumTyLit n :: Integer
n)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceStrTyLit n :: IfLclName
n)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
n

  get :: BinHandle -> IO IfaceTyLit
get bh :: BinHandle
bh =
    do Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
       case Word8
tag of
         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) }
         2 -> do { IfLclName
n <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                 ; IfaceTyLit -> IO IfaceTyLit
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> IfaceTyLit
IfaceStrTyLit IfLclName
n) }
         _ -> String -> IO IfaceTyLit
forall a. String -> a
panic ("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_ bh :: BinHandle
bh tk :: IfaceAppArgs
tk =
    case IfaceAppArgs
tk of
      IA_Arg t :: IfaceType
t a :: ArgFlag
a ts :: IfaceAppArgs
ts -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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
      IA_Nil        -> BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1

  get :: BinHandle -> IO IfaceAppArgs
get bh :: BinHandle
bh =
    do Word8
c <- BinHandle -> IO Word8
getByte BinHandle
bh
       case Word8
c of
         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
         1 -> IfaceAppArgs -> IO IfaceAppArgs
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceAppArgs
IA_Nil
         _ -> String -> IO IfaceAppArgs
forall a. String -> a
panic ("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 [pred :: IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
funPrec IfaceType
pred SDoc -> SDoc -> SDoc
<+> SDoc
darrow
pprIfaceContextArr preds :: [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 _    []     = String -> SDoc
text "()"
pprIfaceContext prec :: PprPrec
prec [pred :: IfaceType
pred] = PprPrec -> IfaceType -> SDoc
ppr_ty PprPrec
prec IfaceType
pred
pprIfaceContext _    preds :: [IfaceType]
preds  = [IfaceType] -> SDoc
ppr_parend_preds [IfaceType]
preds

ppr_parend_preds :: [IfacePredType] -> SDoc
ppr_parend_preds :: [IfaceType] -> SDoc
ppr_parend_preds 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_ _ (IfaceFreeTyVar tv :: TyVar
tv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic "Can't serialise IfaceFreeTyVar" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
tv)

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

    get :: BinHandle -> IO IfaceType
get bh :: BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              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)
              1 -> do IfLclName
ad <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                      IfaceType -> IO IfaceType
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> IfaceType
IfaceTyVar IfLclName
ad)
              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)
              3 -> do 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 (IfaceType -> IfaceType -> IfaceType
IfaceFunTy IfaceType
ag IfaceType
ah)
              4 -> do 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 (IfaceType -> IfaceType -> IfaceType
IfaceDFunTy IfaceType
ag IfaceType
ah)
              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) }
              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) }
              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) }

              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) }
              _  -> 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_ bh :: BinHandle
bh IfaceMRefl = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
  put_ bh :: BinHandle
bh (IfaceMCo co :: IfaceCoercion
co) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
co

  get :: BinHandle -> IO IfaceMCoercion
get bh :: BinHandle
bh = do
    Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
    case Word8
tag of
         1 -> IfaceMCoercion -> IO IfaceMCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceMCoercion
IfaceMRefl
         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
         _ -> String -> IO IfaceMCoercion
forall a. String -> a
panic ("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_ bh :: BinHandle
bh (IfaceReflCo a :: IfaceType
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
          BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a
  put_ bh :: BinHandle
bh (IfaceGReflCo a :: Role
a b :: IfaceType
b c :: IfaceMCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceFunCo a :: Role
a b :: IfaceCoercion
b c :: IfaceCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3
          BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
c
  put_ bh :: BinHandle
bh (IfaceTyConAppCo a :: Role
a b :: IfaceTyCon
b c :: [IfaceCoercion]
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceAppCo a :: IfaceCoercion
a b :: IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceForAllCo a :: IfaceBndr
a b :: IfaceCoercion
b c :: IfaceCoercion
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceCoVarCo a :: IfLclName
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 7
          BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a
  put_ bh :: BinHandle
bh (IfaceAxiomInstCo a :: IfExtName
a b :: BranchIndex
b c :: [IfaceCoercion]
c) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 8
          BinHandle -> IfExtName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfExtName
a
          BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
b
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
c
  put_ bh :: BinHandle
bh (IfaceUnivCo a :: IfaceUnivCoProv
a b :: Role
b c :: IfaceType
c d :: IfaceType
d) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceSymCo a :: IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 10
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ bh :: BinHandle
bh (IfaceTransCo a :: IfaceCoercion
a b :: IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceNthCo a :: BranchIndex
a b :: IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 12
          BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
a
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
b
  put_ bh :: BinHandle
bh (IfaceLRCo a :: LeftOrRight
a b :: IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceInstCo a :: IfaceCoercion
a b :: IfaceCoercion
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 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_ bh :: BinHandle
bh (IfaceKindCo a :: IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 15
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ bh :: BinHandle
bh (IfaceSubCo a :: IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 16
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ bh :: BinHandle
bh (IfaceAxiomRuleCo a :: IfLclName
a b :: [IfaceCoercion]
b) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 17
          BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a
          BinHandle -> [IfaceCoercion] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceCoercion]
b
  put_ _ (IfaceFreeCoVar cv :: TyVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic "Can't serialise IfaceFreeCoVar" (TyVar -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyVar
cv)
  put_ _  (IfaceHoleCo cv :: TyVar
cv)
       = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic "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 bh :: BinHandle
bh = do
      Word8
tag <- BinHandle -> IO Word8
getByte BinHandle
bh
      case Word8
tag of
           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
           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
           3 -> do Role
a <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
c <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ Role -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
a IfaceCoercion
b IfaceCoercion
c
           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
           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
           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
           7 -> do IfLclName
a <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfLclName -> IfaceCoercion
IfaceCoVarCo IfLclName
a
           8 -> do IfExtName
a <- BinHandle -> IO IfExtName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   BranchIndex
b <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
c <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfExtName -> BranchIndex -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo IfExtName
a BranchIndex
b [IfaceCoercion]
c
           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
           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
           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
           12-> do BranchIndex
a <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion
b <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ BranchIndex -> IfaceCoercion -> IfaceCoercion
IfaceNthCo BranchIndex
a IfaceCoercion
b
           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
           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
           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
           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
           17-> do IfLclName
a <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   [IfaceCoercion]
b <- BinHandle -> IO [IfaceCoercion]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                   IfaceCoercion -> IO IfaceCoercion
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IO IfaceCoercion)
-> IfaceCoercion -> IO IfaceCoercion
forall a b. (a -> b) -> a -> b
$ IfLclName -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo IfLclName
a [IfaceCoercion]
b
           _ -> String -> IO IfaceCoercion
forall a. String -> a
panic ("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_ bh :: BinHandle
bh IfaceUnsafeCoerceProv = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
  put_ bh :: BinHandle
bh (IfacePhantomProv a :: IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ bh :: BinHandle
bh (IfaceProofIrrelProv a :: IfaceCoercion
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3
          BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
a
  put_ bh :: BinHandle
bh (IfacePluginProv a :: String
a) = do
          BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 4
          BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
a

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