Commit 6c0f10fa authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Kill Type pretty-printer

Here we consolidate the pretty-printing logic for types in IfaceType. We
need IfaceType regardless and the printer for Type can be implemented in
terms of that for IfaceType. See #11660.

Note that this is very much a work-in-progress. Namely I still have yet
to ponder how to ease the hs-boot file situation, still need to rip out
more dead code, need to move some of the special cases for, e.g., `*` to
the IfaceType printer, and need to get it to validate. That being said,
it comes close to validating as-is.

Test Plan: Validate

Reviewers: goldfire, austin

Subscribers: goldfire, thomie, simonpj

Differential Revision: https://phabricator.haskell.org/D2528

GHC Trac Issues: #11660
parent 8cb7bc5c
......@@ -19,6 +19,9 @@ types that
module BasicTypes(
Version, bumpVersion, initialVersion,
LeftOrRight(..),
pickLR,
ConTag, ConTagZ, fIRST_TAG,
Arity, RepArity,
......@@ -48,6 +51,8 @@ module BasicTypes(
Boxity(..), isBoxed,
TyPrec(..), maybeParen,
TupleSort(..), tupleSortBoxity, boxityTupleSort,
tupleParens,
......@@ -102,6 +107,25 @@ import StaticFlags( opt_PprStyle_Debug )
import Data.Data hiding (Fixity)
import Data.Function (on)
{-
************************************************************************
* *
Binary choice
* *
************************************************************************
-}
data LeftOrRight = CLeft | CRight
deriving( Eq, Data )
pickLR :: LeftOrRight -> (a,a) -> a
pickLR CLeft (l,_) = l
pickLR CRight (_,r) = r
instance Outputable LeftOrRight where
ppr CLeft = text "Left"
ppr CRight = text "Right"
{-
************************************************************************
* *
......@@ -624,6 +648,26 @@ pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap True = text "[safe]"
pprSafeOverlap False = empty
{-
************************************************************************
* *
Type precedence
* *
************************************************************************
-}
data TyPrec -- See Note [Prededence in types]
= TopPrec -- No parens
| FunPrec -- Function args; no parens for tycon apps
| TyOpPrec -- Infix operator
| TyConPrec -- Tycon args; no parens for atomic
deriving( Eq, Ord )
maybeParen :: TyPrec -> TyPrec -> SDoc -> SDoc
maybeParen ctxt_prec inner_prec pretty
| ctxt_prec < inner_prec = pretty
| otherwise = parens pretty
{-
************************************************************************
* *
......
......@@ -1003,7 +1003,7 @@ lintCoBndr cv thing_inside
; let (subst', cv') = substCoVarBndr subst cv
; lintKind (varType cv')
; lintL (isCoercionType (varType cv'))
(text "CoVar with non-coercion type:" <+> pprTvBndr cv)
(text "CoVar with non-coercion type:" <+> pprTyVar cv)
; updateTCvSubst subst' (thing_inside cv') }
lintIdBndr :: Id -> (Id -> LintM a) -> LintM a
......
......@@ -378,7 +378,7 @@ pprTypedLetBinder binder
pprKindedTyVarBndr :: TyVar -> SDoc
-- Print a type variable binder with its kind (but not if *)
pprKindedTyVarBndr tyvar
= text "@" <+> pprTvBndr tyvar
= text "@" <+> pprTyVar tyvar
-- pprIdBndr does *not* print the type
-- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
......
......@@ -314,6 +314,7 @@ Library
IfaceEnv
IfaceSyn
IfaceType
ToIface
LoadIface
MkIface
TcIface
......
......@@ -493,6 +493,7 @@ compiler_stage2_dll0_MODULES = \
IdInfo \
IfaceSyn \
IfaceType \
ToIface \
InstEnv \
Kind \
KnownUniques \
......
......@@ -62,6 +62,7 @@ import Fingerprint
import Binary
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
import Var( TyVarBndr(..) )
import Type ( TyPrec(..) )
import TyCon ( Role (..), Injectivity(..), HowAbstract(..) )
import StaticFlags (opt_PprStyle_Debug)
import Util( filterOut, filterByList )
......@@ -540,9 +541,10 @@ pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
where
ppr_binders
| null tvs && null cvs = empty
| null cvs = brackets (pprWithCommas pprIfaceTvBndr tvs)
| null cvs
= brackets (pprWithCommas (pprIfaceTvBndr True) tvs)
| otherwise
= brackets (pprWithCommas pprIfaceTvBndr tvs <> semi <+>
= brackets (pprWithCommas (pprIfaceTvBndr True) tvs <> semi <+>
pprWithCommas pprIfaceIdBndr cvs)
pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
maybe_incomps = ppUnless (null incomps) $ parens $
......@@ -876,7 +878,7 @@ pprIfaceTyConParent IfNoParent
pprIfaceTyConParent (IfDataInstance _ tc tys)
= sdocWithDynFlags $ \dflags ->
let ftys = stripInvisArgs dflags tys
in pprIfaceTypeApp tc ftys
in pprIfaceTypeApp TopPrec tc ftys
pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name
-> [IfaceTyConBinder] -- of the tycon, for invisible-suppression
......@@ -1336,6 +1338,7 @@ freeNamesIfProv IfaceUnsafeCoerceProv = emptyNameSet
freeNamesIfProv (IfacePhantomProv co) = freeNamesIfCoercion co
freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co
freeNamesIfProv (IfacePluginProv _) = emptyNameSet
freeNamesIfProv (IfaceHoleProv _) = emptyNameSet
freeNamesIfTyVarBndr :: TyVarBndr IfaceTvBndr vis -> NameSet
freeNamesIfTyVarBndr (TvBndr tv _) = freeNamesIfTvBndr tv
......
......@@ -6,7 +6,7 @@
This module defines interface types and binders
-}
{-# LANGUAGE CPP, FlexibleInstances #-}
{-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-}
-- FlexibleInstances for Binary (DefMethSpec IfaceType)
module IfaceType (
......@@ -14,39 +14,31 @@ module IfaceType (
IfaceType(..), IfacePredType, IfaceKind, IfaceCoercion(..),
IfaceUnivCoProv(..),
IfaceTyCon(..), IfaceTyConInfo(..),
IfaceTyCon(..), IfaceTyConInfo(..), IfaceTyConSort(..), IsPromoted(..),
IfaceTyLit(..), IfaceTcArgs(..),
IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
IfaceForAllBndr, ArgFlag(..),
ifConstraintKind, ifTyConBinderTyVar, ifTyConBinderName,
ifTyConBinderTyVar, ifTyConBinderName,
-- Equality testing
IfRnEnv2, emptyIfRnEnv2, eqIfaceType, eqIfaceTypes,
eqIfaceTcArgs, eqIfaceTvBndrs, isIfaceLiftedTypeKind,
-- Conversion from Type -> IfaceType
toIfaceType, toIfaceTypes, toIfaceKind, toIfaceTyVar,
toIfaceContext, toIfaceBndr, toIfaceIdBndr,
toIfaceTyCon, toIfaceTyCon_name,
toIfaceTcArgs, toIfaceTvBndr, toIfaceTvBndrs,
toIfaceForAllBndr,
-- Conversion from IfaceTcArgs -> IfaceType
-- Conversion from IfaceTcArgs -> [IfaceType]
tcArgsIfaceTypes,
-- Conversion from Coercion -> IfaceCoercion
toIfaceCoercion,
-- Printing
pprIfaceType, pprParendIfaceType,
pprIfaceContext, pprIfaceContextArr,
pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
pprIfaceBndrs, pprIfaceTcArgs, pprParendIfaceTcArgs,
pprIfaceForAllPart, pprIfaceForAll, pprIfaceSigmaType,
pprIfaceTyLit,
pprIfaceCoercion, pprParendIfaceCoercion,
splitIfaceSigmaTy, pprIfaceTypeApp, pprUserIfaceForAll,
pprIfaceCoTcApp, pprTyTcApp, pprIfacePrefixApp,
suppressIfaceInvisibles,
stripIfaceInvisVars,
......@@ -57,29 +49,26 @@ module IfaceType (
#include "HsVersions.h"
import Coercion
import DataCon ( isTupleDataCon )
import TcType
import {-# SOURCE #-} TysWiredIn ( ptrRepLiftedDataConTyCon )
import DynFlags
import TyCoRep -- needs to convert core types to iface types
import StaticFlags ( opt_PprStyle_Debug )
import TyCon hiding ( pprPromotionQuote )
import CoAxiom
import Id
import Var
-- import RnEnv( FastStringEnv, mkFsEnv, lookupFsEnv )
import TysWiredIn
import TysPrim
import PrelNames
import Name
import BasicTypes
import Binary
import Outputable
import FastString
import FastStringEnv
import UniqSet
import VarEnv
import UniqFM
import Util
import Data.List (foldl')
{-
************************************************************************
* *
......@@ -132,8 +121,10 @@ data IfaceType -- A kind of universal type, used for types and kinds
-- Includes newtypes, synonyms, tuples
| IfaceCastTy IfaceType IfaceCoercion
| IfaceCoercionTy IfaceCoercion
| IfaceTupleTy -- Saturated tuples (unsaturated ones use IfaceTyConApp)
TupleSort IfaceTyConInfo -- A bit like IfaceTyCon
TupleSort -- What sort of tuple?
IsPromoted -- A bit like IfaceTyCon
IfaceTcArgs -- arity = length args
-- For promoted data cons, the kind args are omitted
......@@ -159,6 +150,12 @@ data IfaceTcArgs
| ITC_Invis IfaceKind IfaceTcArgs -- "Invis" means don't show when pretty-printing
-- except with -fprint-explicit-kinds
instance Monoid IfaceTcArgs where
mempty = ITC_Nil
ITC_Nil `mappend` xs = xs
ITC_Vis ty rest `mappend` xs = ITC_Vis ty (rest `mappend` xs)
ITC_Invis ki rest `mappend` xs = ITC_Invis ki (rest `mappend` xs)
-- Encodes type constructors, kind constructors,
-- coercion constructors, the lot.
-- We have to tag them in order to pretty print them
......@@ -167,10 +164,58 @@ data IfaceTyCon = IfaceTyCon { ifaceTyConName :: IfExtName
, ifaceTyConInfo :: IfaceTyConInfo }
deriving (Eq)
-- | Is a TyCon a promoted data constructor or just a normal type constructor?
data IsPromoted = IsNotPromoted | IsPromoted
deriving (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 !Bool
-- ^ a type equality. 'True' indicates kind-homogeneous.
-- See Note [Equality predicates in IfaceType] for
-- details.
deriving (Eq)
{-
Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
in TysPrim for details) which all must be rendered with different surface syntax
during pretty-printing. Which syntax we use depends upon,
1. Which predicate tycon was used
2. Whether the types being compared are of the same kind.
Unfortunately, determining (2) from an IfaceType isn't possible since we can't
see through type synonyms. Consequently, we need to record whether the equality
is homogeneous or not in IfaceTyConSort for the purposes of pretty-printing.
Namely we handle these cases,
Predicate Homogeneous Heterogeneous
---------------- ----------- -------------
eqTyCon ~ N/A
heqTyCon ~ ~~
eqPrimTyCon ~# ~~
eqReprPrimTyCon Coercible Coercible
-}
data IfaceTyConInfo -- Used to guide pretty-printing
-- and to disambiguate D from 'D (they share a name)
= NoIfaceTyConInfo
| IfacePromotedDataCon
= IfaceTyConInfo { ifaceTyConIsPromoted :: IsPromoted
, ifaceTyConSort :: IfaceTyConSort }
deriving (Eq)
data IfaceCoercion
......@@ -197,12 +242,21 @@ data IfaceUnivCoProv
| IfacePhantomProv IfaceCoercion
| IfaceProofIrrelProv IfaceCoercion
| IfacePluginProv String
| IfaceHoleProv Unique
-- ^ See Note [Holes in IfaceUnivCoProv]
-- this constant is needed for dealing with pretty-printing classes
ifConstraintKind :: IfaceKind
ifConstraintKind = IfaceTyConApp (IfaceTyCon { ifaceTyConName = getName constraintKindTyCon
, ifaceTyConInfo = NoIfaceTyConInfo })
ITC_Nil
{-
Note [Holes in IfaceUnivCoProv]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When typechecking fails the typechecker will produce a HoleProv UnivCoProv 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 IfaceUnivCoProv has a IfaceHoleProv constructor; however, we fails when
asked to serialize to a IfaceHoleProv to ensure that they don't end up in an
interface file. To avoid an import loop between IfaceType and TyCoRep we only
keep the hole's Unique, since that is all we need to print.
-}
{-
%************************************************************************
......@@ -212,6 +266,9 @@ ifConstraintKind = IfaceTyConApp (IfaceTyCon { ifaceTyConName = getName constrai
************************************************************************
-}
ifaceTyConHasKey :: IfaceTyCon -> Unique -> Bool
ifaceTyConHasKey tc key = ifaceTyConName tc `hasKey` key
eqIfaceTvBndr :: IfaceTvBndr -> IfaceTvBndr -> Bool
eqIfaceTvBndr (occ1, _) (occ2, _) = occ1 == occ2
......@@ -220,8 +277,8 @@ isIfaceLiftedTypeKind (IfaceTyConApp tc ITC_Nil)
= isLiftedTypeKindTyConName (ifaceTyConName tc)
isIfaceLiftedTypeKind (IfaceTyConApp tc
(ITC_Vis (IfaceTyConApp ptr_rep_lifted ITC_Nil) ITC_Nil))
= ifaceTyConName tc == tYPETyConName
&& ifaceTyConName ptr_rep_lifted `hasKey` ptrRepLiftedDataConKey
= tc `ifaceTyConHasKey` tYPETyConKey
&& ptr_rep_lifted `ifaceTyConHasKey` ptrRepLiftedDataConKey
isIfaceLiftedTypeKind _ = False
splitIfaceSigmaTy :: IfaceType -> ([IfaceForAllBndr], [IfacePredType], IfaceType)
......@@ -327,6 +384,7 @@ ifTyVarsOfCoercion = go
go_prov (IfacePhantomProv co) = go co
go_prov (IfaceProofIrrelProv co) = go co
go_prov (IfacePluginProv _) = emptyUniqSet
go_prov (IfaceHoleProv _) = emptyUniqSet
ifTyVarsOfCoercions :: [IfaceCoercion] -> UniqSet IfLclName
ifTyVarsOfCoercions = foldr (unionUniqSets . ifTyVarsOfCoercion) emptyUniqSet
......@@ -381,6 +439,7 @@ substIfaceType env ty
go_prov (IfacePhantomProv co) = IfacePhantomProv (go_co co)
go_prov (IfaceProofIrrelProv co) = IfaceProofIrrelProv (go_co co)
go_prov (IfacePluginProv str) = IfacePluginProv str
go_prov (IfaceHoleProv h) = IfaceHoleProv h
substIfaceTcArgs :: IfaceTySubst -> IfaceTcArgs -> IfaceTcArgs
substIfaceTcArgs env args
......@@ -512,37 +571,18 @@ stripInvisArgs dflags tys
ITC_Invis _ ts -> suppress_invis ts
_ -> c
toIfaceTcArgs :: TyCon -> [Type] -> IfaceTcArgs
-- See Note [Suppressing invisible arguments]
toIfaceTcArgs tc ty_args
= go (mkEmptyTCvSubst in_scope) (tyConKind tc) ty_args
where
in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)
go _ _ [] = ITC_Nil
go env ty ts
| Just ty' <- coreView ty
= go env ty' ts
go env (ForAllTy (TvBndr tv vis) res) (t:ts)
| isVisibleArgFlag vis = ITC_Vis t' ts'
| otherwise = ITC_Invis t' ts'
where
t' = toIfaceType t
ts' = go (extendTvSubst env tv t) res ts
go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps
= ITC_Vis (toIfaceType t) (go env res ts)
go env (TyVarTy tv) ts
| Just ki <- lookupTyVar env tv = go env ki ts
go env kind (t:ts) = WARN( True, ppr tc $$ ppr (tyConKind tc) $$ ppr ty_args )
ITC_Vis (toIfaceType t) (go env kind ts) -- Ill-kinded
tcArgsIfaceTypes :: IfaceTcArgs -> [IfaceType]
tcArgsIfaceTypes ITC_Nil = []
tcArgsIfaceTypes (ITC_Invis t ts) = t : tcArgsIfaceTypes ts
tcArgsIfaceTypes (ITC_Vis t ts) = t : tcArgsIfaceTypes ts
ifaceVisTcArgsLength :: IfaceTcArgs -> Int
ifaceVisTcArgsLength = go 0
where
go !n ITC_Nil = n
go n (ITC_Vis _ rest) = go (n+1) rest
go n (ITC_Invis _ rest) = go n rest
{-
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -565,6 +605,17 @@ we want
************************************************************************
-}
if_print_coercions :: SDoc -- ^ if printing coercions
-> SDoc -- ^ otherwise
-> SDoc
if_print_coercions yes no
= sdocWithDynFlags $ \dflags ->
getPprStyle $ \style ->
if gopt Opt_PrintExplicitCoercions dflags
|| dumpStyle style || debugStyle style
then yes
else no
pprIfaceInfixApp :: (TyPrec -> a -> SDoc) -> TyPrec -> SDoc -> a -> a -> SDoc
pprIfaceInfixApp pp p pp_tc ty1 ty2
= maybeParen p FunPrec $
......@@ -580,7 +631,7 @@ pprIfacePrefixApp p pp_fun pp_tys
instance Outputable IfaceBndr where
ppr (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr bndr
ppr (IfaceTvBndr bndr) = char '@' <+> pprIfaceTvBndr False bndr
pprIfaceBndrs :: [IfaceBndr] -> SDoc
pprIfaceBndrs bs = sep (map ppr bs)
......@@ -589,18 +640,21 @@ pprIfaceLamBndr :: IfaceLamBndr -> SDoc
pprIfaceLamBndr (b, IfaceNoOneShot) = ppr b
pprIfaceLamBndr (b, IfaceOneShot) = ppr b <> text "[OneShot]"
pprIfaceIdBndr :: (IfLclName, IfaceType) -> SDoc
pprIfaceIdBndr :: IfaceIdBndr -> SDoc
pprIfaceIdBndr (name, ty) = parens (ppr name <+> dcolon <+> ppr ty)
pprIfaceTvBndr :: IfaceTvBndr -> SDoc
pprIfaceTvBndr (tv, ki)
pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
pprIfaceTvBndr use_parens (tv, ki)
| isIfaceLiftedTypeKind ki = ppr tv
| otherwise = parens (ppr tv <+> dcolon <+> ppr ki)
| otherwise = maybe_parens (ppr tv <+> dcolon <+> ppr ki)
where
maybe_parens | use_parens = parens
| otherwise = id
pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders = sep . map go
where
go tcb = pprIfaceTvBndr (ifTyConBinderTyVar tcb)
go tcb = pprIfaceTvBndr True (ifTyConBinderTyVar tcb)
instance Binary IfaceBndr where
put_ bh (IfaceIdBndr aa) = do
......@@ -634,15 +688,15 @@ instance Binary IfaceOneShot where
instance Outputable IfaceType where
ppr ty = pprIfaceType ty
pprIfaceType, pprParendIfaceType ::IfaceType -> SDoc
pprIfaceType = ppr_ty TopPrec
pprParendIfaceType = ppr_ty TyConPrec
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
pprIfaceType = eliminateRuntimeRep (ppr_ty TopPrec)
pprParendIfaceType = eliminateRuntimeRep (ppr_ty TyConPrec)
ppr_ty :: TyPrec -> IfaceType -> SDoc
ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = sdocWithDynFlags (pprTyTcApp ctxt_prec tc tys)
ppr_ty _ (IfaceTupleTy s i tys) = pprTuple s i tys
ppr_ty _ (IfaceLitTy n) = ppr_tylit n
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = pprTyTcApp ctxt_prec tc tys
ppr_ty _ (IfaceTupleTy i p tys) = pprTuple i p tys
ppr_ty _ (IfaceLitTy n) = pprIfaceTyLit n
-- Function types
ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
= -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
......@@ -655,19 +709,133 @@ ppr_ty ctxt_prec (IfaceFunTy ty1 ty2)
= [arrow <+> pprIfaceType other_ty]
ppr_ty ctxt_prec (IfaceAppTy ty1 ty2)
= maybeParen ctxt_prec TyConPrec $
ppr_ty FunPrec ty1 <+> pprParendIfaceType ty2
= if_print_coercions
ppr_app_ty
ppr_app_ty_no_casts
where
ppr_app_ty =
maybeParen ctxt_prec TyConPrec
$ ppr_ty FunPrec ty1 <+> ppr_ty TyConPrec ty2
-- Strip any casts from the head of the application
ppr_app_ty_no_casts =
case split_app_tys ty1 (ITC_Vis ty2 ITC_Nil) of
(IfaceCastTy head _, args) -> ppr_ty ctxt_prec (mk_app_tys head args)
_ -> ppr_app_ty
split_app_tys :: IfaceType -> IfaceTcArgs -> (IfaceType, IfaceTcArgs)
split_app_tys (IfaceAppTy t1 t2) args = split_app_tys t1 (t2 `ITC_Vis` args)
split_app_tys head args = (head, args)
mk_app_tys :: IfaceType -> IfaceTcArgs -> IfaceType
mk_app_tys (IfaceTyConApp tc tys1) tys2 =
IfaceTyConApp tc (tys1 `mappend` tys2)
mk_app_tys t1 tys2 =
foldl' IfaceAppTy t1 (tcArgsIfaceTypes tys2)
ppr_ty ctxt_prec (IfaceCastTy ty co)
= maybeParen ctxt_prec FunPrec $
sep [ppr_ty FunPrec ty, text "`cast`", ppr_co FunPrec co]
= if_print_coercions
(parens (ppr_ty TopPrec ty <+> text "|>" <+> ppr co))
(ppr_ty ctxt_prec ty)
ppr_ty ctxt_prec (IfaceCoercionTy co)
= ppr_co ctxt_prec co
= if_print_coercions
(ppr_co ctxt_prec co)
(text "<>")
ppr_ty ctxt_prec ty
= maybeParen ctxt_prec FunPrec (ppr_iface_sigma_type True 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
PtrLiftedRep. This is done in a pass right before pretty-printing
(defaultRuntimeRepVars, controlled by -fprint-explicit-runtime-reps)
-}
-- | 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 = go emptyFsEnv
where
go :: FastStringEnv () -> IfaceType -> IfaceType
go subs (IfaceForAllTy bndr ty)
| isRuntimeRep var_kind
= let subs' = extendFsEnv subs var ()
in go subs' ty
| otherwise
= IfaceForAllTy (TvBndr (var, go subs var_kind) (binderArgFlag bndr))
(go subs ty)
where
var :: IfLclName
(var, var_kind) = binderVar bndr
go subs (IfaceTyVar tv)
| tv `elemFsEnv` subs