Kill Type pretty-printer
authorBen Gamari <bgamari.foss@gmail.com>
Sun, 13 Nov 2016 21:17:37 +0000 (16:17 -0500)
committerBen Gamari <ben@smart-cactus.org>
Sun, 13 Nov 2016 21:17:38 +0000 (16:17 -0500)
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

48 files changed:
compiler/basicTypes/BasicTypes.hs
compiler/coreSyn/CoreLint.hs
compiler/coreSyn/PprCore.hs
compiler/ghc.cabal.in
compiler/ghc.mk
compiler/iface/IfaceSyn.hs
compiler/iface/IfaceType.hs
compiler/iface/IfaceType.hs-boot [new file with mode: 0644]
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/iface/ToIface.hs [new file with mode: 0644]
compiler/iface/ToIface.hs-boot [new file with mode: 0644]
compiler/main/GHC.hs
compiler/prelude/TysWiredIn.hs
compiler/prelude/TysWiredIn.hs-boot
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcDerivInfer.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcInteract.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcPat.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcValidity.hs
compiler/types/Coercion.hs-boot
compiler/types/TyCoRep.hs
compiler/types/TyCoRep.hs-boot
compiler/types/TyCon.hs
compiler/types/Type.hs
compiler/utils/Binary.hs
testsuite/tests/deSugar/should_compile/T2431.stderr
testsuite/tests/dependent/should_fail/TypeSkolEscape.stderr
testsuite/tests/ghci/scripts/T11252.stdout
testsuite/tests/ghci/scripts/T2766.stdout
testsuite/tests/ghci/scripts/ghci059.stdout
testsuite/tests/roles/should_compile/T8958.stderr
testsuite/tests/typecheck/should_compile/T10632.stderr
testsuite/tests/typecheck/should_fail/ClassOperator.stderr
testsuite/tests/typecheck/should_fail/IPFail.stderr
testsuite/tests/typecheck/should_fail/T7019a.stderr
testsuite/tests/typecheck/should_fail/T7525.stderr
testsuite/tests/typecheck/should_fail/T8912.stderr
testsuite/tests/typecheck/should_fail/tcfail041.stderr
testsuite/tests/typecheck/should_fail/tcfail130.stderr
testsuite/tests/typecheck/should_fail/tcfail211.stderr
testsuite/tests/typecheck/should_run/tcrun045.stderr

index 4f57435..ce00c45 100644 (file)
@@ -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,
 
@@ -105,6 +110,25 @@ 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"
+
+{-
+************************************************************************
+*                                                                      *
 \subsection[Arity]{Arity}
 *                                                                      *
 ************************************************************************
@@ -627,6 +651,26 @@ 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
+
+{-
+************************************************************************
+*                                                                      *
                 Tuples
 *                                                                      *
 ************************************************************************
index 74f8a61..314bf3e 100644 (file)
@@ -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
index ce8a68b..9129c90 100644 (file)
@@ -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
index ba7f619..0a85ff1 100644 (file)
@@ -314,6 +314,7 @@ Library
         IfaceEnv
         IfaceSyn
         IfaceType
+        ToIface
         LoadIface
         MkIface
         TcIface
index 91a0277..2b85e42 100644 (file)
@@ -493,6 +493,7 @@ compiler_stage2_dll0_MODULES = \
        IdInfo \
        IfaceSyn \
        IfaceType \
+       ToIface \
        InstEnv \
        Kind \
        KnownUniques \
index 795e5b1..4a5672a 100644 (file)
@@ -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
index f200872..d6a9a21 100644 (file)
@@ -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
+      = IfaceTyConApp ptrRepLifted ITC_Nil
+
+    go subs (IfaceFunTy kind ty)
+      = IfaceFunTy (go subs kind) (go subs ty)
+
+    go subs (IfaceAppTy x y)
+      = IfaceAppTy (go subs x) (go subs y)
+
+    go subs (IfaceDFunTy x y)
+      = IfaceDFunTy (go subs x) (go subs y)
+
+    go subs (IfaceCastTy x co)
+      = IfaceCastTy (go subs x) co
+
+    go _ other = other
+
+    ptrRepLifted :: IfaceTyCon
+    ptrRepLifted =
+        IfaceTyCon dc_name (IfaceTyConInfo IsPromoted IfaceNormalTyCon)
+      where dc_name = getName ptrRepLiftedDataConTyCon
+
+    isRuntimeRep :: IfaceType -> Bool
+    isRuntimeRep (IfaceTyConApp tc _) =
+        tc `ifaceTyConHasKey` runtimeRepTyConKey
+    isRuntimeRep _ = False
+
+eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
+eliminateRuntimeRep f ty = sdocWithDynFlags $ \dflags ->
+    if gopt Opt_PrintExplicitRuntimeReps dflags
+      then f ty
+      else f (defaultRuntimeRepVars ty)
+
 instance Outputable IfaceTcArgs where
   ppr tca = pprIfaceTcArgs tca
 
@@ -691,15 +859,15 @@ ppr_iface_sigma_type show_foralls_unconditionally ty
     (tvs, theta, tau) = splitIfaceSigmaTy ty
 
 -------------------
-pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfaceType] -> SDoc -> SDoc
+pprIfaceForAllPart :: [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
 pprIfaceForAllPart tvs ctxt sdoc = ppr_iface_forall_part False tvs ctxt sdoc
 
 pprIfaceForAllCoPart :: [(IfLclName, IfaceCoercion)] -> SDoc -> SDoc
-pprIfaceForAllCoPart tvs sdoc = sep [ pprIfaceForAllCo tvs
-                                    , sdoc ]
+pprIfaceForAllCoPart tvs sdoc =
+    sep [ pprIfaceForAllCo tvs, sdoc ]
 
-ppr_iface_forall_part :: Outputable a
-                      => Bool -> [IfaceForAllBndr] -> [a] -> SDoc -> SDoc
+ppr_iface_forall_part :: Bool
+                      -> [IfaceForAllBndr] -> [IfacePredType] -> SDoc -> SDoc
 ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
   = sep [ if show_foralls_unconditionally
           then pprIfaceForAll tvs
@@ -711,7 +879,7 @@ ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprIfaceForAll [] = empty
 pprIfaceForAll bndrs@(TvBndr _ vis : _)
-  = add_separator (text "forall" <+> doc) <+> pprIfaceForAll bndrs'
+  = add_separator (forAllLit <+> doc) <+> pprIfaceForAll bndrs'
   where
     (bndrs', doc) = ppr_itv_bndrs bndrs vis
 
@@ -742,9 +910,9 @@ pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
 pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
 pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
                                            if gopt Opt_PrintExplicitForalls dflags
-                                           then braces $ pprIfaceTvBndr tv
-                                           else pprIfaceTvBndr tv
-pprIfaceForAllBndr (TvBndr tv _)        = pprIfaceTvBndr tv
+                                           then braces $ pprIfaceTvBndr False tv
+                                           else pprIfaceTvBndr True tv
+pprIfaceForAllBndr (TvBndr tv _)        = pprIfaceTvBndr True tv
 
 pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
 pprIfaceForAllCoBndr (tv, kind_co)
@@ -782,53 +950,129 @@ pprIfaceTyList ctxt_prec ty1 ty2
      -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
      --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl
     gather (IfaceTyConApp tc tys)
-      | tcname == consDataConName
+      | tc `ifaceTyConHasKey` consDataConKey
       , (ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil))) <- tys
       , (args, tl) <- gather ty2
       = (ty1:args, tl)
-      | tcname == nilDataConName
+      | tc `ifaceTyConHasKey` nilDataConKey
       = ([], Nothing)
-      where tcname = ifaceTyConName tc
     gather ty = ([], Just ty)
 
-pprIfaceTypeApp :: IfaceTyCon -> IfaceTcArgs -> SDoc
-pprIfaceTypeApp tc args = sdocWithDynFlags (pprTyTcApp TopPrec tc args)
+pprIfaceTypeApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
+pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args
+
+pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
+pprTyTcApp ctxt_prec tc tys =
+    sdocWithDynFlags $ \dflags ->
+    getPprStyle $ \style ->
+    pprTyTcApp' ctxt_prec tc tys dflags style
 
-pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> DynFlags -> SDoc
-pprTyTcApp ctxt_prec tc tys dflags
+pprTyTcApp' :: TyPrec -> IfaceTyCon -> IfaceTcArgs
+            -> DynFlags -> PprStyle -> SDoc
+pprTyTcApp' ctxt_prec tc tys dflags style
   | ifaceTyConName tc `hasKey` ipClassKey
   , ITC_Vis (IfaceLitTy (IfaceStrTyLit n)) (ITC_Vis ty ITC_Nil) <- tys
-  = char '?' <> ftext n <> text "::" <> ppr_ty TopPrec ty
+  = maybeParen ctxt_prec FunPrec
+    $ char '?' <> ftext n <> text "::" <> ppr_ty TopPrec ty
 
-  | ifaceTyConName tc == consDataConName
+  | IfaceTupleTyCon arity sort <- ifaceTyConSort info
+  , not (debugStyle style)
+  , arity == ifaceVisTcArgsLength tys
+  = pprTuple sort (ifaceTyConIsPromoted info) tys
+
+  | IfaceSumTyCon arity <- ifaceTyConSort info
+  = pprSum arity (ifaceTyConIsPromoted info) tys
+
+  | tc `ifaceTyConHasKey` consDataConKey
   , not (gopt Opt_PrintExplicitKinds dflags)
   , ITC_Invis _ (ITC_Vis ty1 (ITC_Vis ty2 ITC_Nil)) <- tys
   = pprIfaceTyList ctxt_prec ty1 ty2
 
-  | ifaceTyConName tc == tYPETyConName
-  , ITC_Vis (IfaceTyConApp ptr_rep ITC_Nil) ITC_Nil <- tys
-  , ifaceTyConName ptr_rep `hasKey` ptrRepLiftedDataConKey
-  = char '*'
+  | tc `ifaceTyConHasKey` tYPETyConKey
+  , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
+  , rep `ifaceTyConHasKey` ptrRepLiftedDataConKey
+  = unicodeSyntax (char '★') (char '*')
 
-  | ifaceTyConName tc == tYPETyConName
-  , ITC_Vis (IfaceTyConApp ptr_rep ITC_Nil) ITC_Nil <- tys
-  , ifaceTyConName ptr_rep `hasKey` ptrRepUnliftedDataConKey
+  | tc `ifaceTyConHasKey` tYPETyConKey
+  , ITC_Vis (IfaceTyConApp rep ITC_Nil) ITC_Nil <- tys
+  , rep `ifaceTyConHasKey` ptrRepUnliftedDataConKey
   = char '#'
 
+  | not opt_PprStyle_Debug
+  , tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey
+  = text "(TypeError ...)"   -- Suppress detail unles you _really_ want to see
+
+  | Just doc <- ppr_equality tc (tcArgsIfaceTypes tys)
+  = doc
+
   | otherwise
   = ppr_iface_tc_app ppr_ty ctxt_prec tc tys_wo_kinds
   where
+    info = ifaceTyConInfo tc
     tys_wo_kinds = tcArgsIfaceTypes $ stripInvisArgs dflags tys
 
+-- | Pretty-print a type-level equality.
+--
+-- See Note [Equality predicates in IfaceType].
+ppr_equality :: IfaceTyCon -> [IfaceType] -> Maybe SDoc
+ppr_equality tc args
+  | hetero_eq_tc
+  , [k1, k2, t1, t2] <- args
+  = Just $ print_equality (k1, k2, t1, t2)
+
+  | hom_eq_tc
+  , [k, t1, t2] <- args
+  = Just $ print_equality (k, k, t1, t2)
+
+  | otherwise
+  = Nothing
+  where
+    homogeneous = case ifaceTyConSort $ ifaceTyConInfo tc of
+                    IfaceEqualityTyCon hom -> hom
+                    _other -> pprPanic "ppr_equality: homogeneity" (ppr tc)
+    tc_name = ifaceTyConName tc
+    pp = ppr_ty
+    hom_eq_tc = tc_name `hasKey` eqTyConKey            -- (~)
+    hetero_eq_tc = tc_name `hasKey` eqPrimTyConKey     -- (~#)
+                || tc_name `hasKey` eqReprPrimTyConKey -- (~R#)
+                || tc_name `hasKey` heqTyConKey        -- (~~)
+
+    print_equality args =
+        sdocWithDynFlags
+        $ \dflags -> getPprStyle
+        $ \style -> print_equality' args style dflags
+
+    print_equality' (ki1, ki2, ty1, ty2) style dflags
+      | print_eqs
+      = ppr_infix_eq (ppr tc)
+
+      | hetero_eq_tc
+      , print_kinds || not homogeneous
+      = ppr_infix_eq (text "~~")
+
+      | otherwise
+      = if tc_name `hasKey` eqReprPrimTyConKey
+        then text "Coercible"
+             <+> sep [ pp TyConPrec ty1, pp TyConPrec ty2 ]
+        else sep [pp TyOpPrec ty1, char '~', pp TyOpPrec ty2]
+      where
+        ppr_infix_eq eq_op
+           = sep [ parens (pp TyOpPrec ty1 <+> dcolon <+> pp TyOpPrec ki1)
+                 , eq_op
+                 , parens (pp TyOpPrec ty2 <+> dcolon <+> pp TyOpPrec ki2) ]
+
+        print_kinds = gopt Opt_PrintExplicitKinds dflags
+        print_eqs   = gopt Opt_PrintEqualityRelations dflags ||
+                      dumpStyle style || debugStyle style
+
+
 pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
 pprIfaceCoTcApp ctxt_prec tc tys = ppr_iface_tc_app ppr_co ctxt_prec tc tys
 
 ppr_iface_tc_app :: (TyPrec -> a -> SDoc) -> TyPrec -> IfaceTyCon -> [a] -> SDoc
 ppr_iface_tc_app pp _ tc [ty]
-  | n == listTyConName = pprPromotionQuote tc <> brackets (pp TopPrec ty)
-  | n == parrTyConName = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
-  where
-    n = ifaceTyConName tc
+  | tc `ifaceTyConHasKey` listTyConKey = pprPromotionQuote tc <> brackets (pp TopPrec ty)
+  | tc `ifaceTyConHasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
 
 ppr_iface_tc_app pp ctxt_prec tc tys
   | not (isSymOcc (nameOccName tc_name))
@@ -838,8 +1082,9 @@ ppr_iface_tc_app pp ctxt_prec tc tys
                       -- we know nothing of precedence though
   = pprIfaceInfixApp pp ctxt_prec (ppr tc) ty1 ty2
 
-  |  tc_name == starKindTyConName || tc_name == unliftedTypeKindTyConName
-  || tc_name == unicodeStarKindTyConName
+  |  tc `ifaceTyConHasKey` starKindTyConKey
+  || tc `ifaceTyConHasKey` unliftedTypeKindTyConKey
+  || tc `ifaceTyConHasKey` unicodeStarKindTyConKey
   = ppr tc   -- Do not wrap *, # in parens
 
   | otherwise
@@ -847,8 +1092,27 @@ ppr_iface_tc_app pp ctxt_prec tc tys
   where
     tc_name = ifaceTyConName tc
 
-pprTuple :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> SDoc
-pprTuple sort info args
+pprSum :: Arity -> IsPromoted -> IfaceTcArgs -> SDoc
+pprSum _arity is_promoted args
+  =   -- drop the RuntimeRep vars.
+      -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
+    let tys   = tcArgsIfaceTypes args
+        args' = drop (length tys `div` 2) tys
+    in pprPromotionQuoteI is_promoted
+       <> sumParens (pprWithBars (ppr_ty TopPrec) args')
+
+pprTuple :: TupleSort -> IsPromoted -> IfaceTcArgs -> SDoc
+pprTuple ConstraintTuple IsNotPromoted ITC_Nil
+  = text "() :: Constraint"
+
+-- All promoted constructors have kind arguments
+pprTuple sort IsPromoted args
+  = let tys = tcArgsIfaceTypes args
+        args' = drop (length tys `div` 2) tys
+    in pprPromotionQuoteI IsPromoted <>
+       tupleParens sort (pprWithCommas pprIfaceType args')
+
+pprTuple sort promoted args
   =   -- drop the RuntimeRep vars.
       -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
     let tys   = tcArgsIfaceTypes args
@@ -856,12 +1120,12 @@ pprTuple sort info args
                   UnboxedTuple -> drop (length tys `div` 2) tys
                   _            -> tys
     in
-    pprPromotionQuoteI info <>
+    pprPromotionQuoteI promoted <>
     tupleParens sort (pprWithCommas pprIfaceType args')
 
-ppr_tylit :: IfaceTyLit -> SDoc
-ppr_tylit (IfaceNumTyLit n) = integer n
-ppr_tylit (IfaceStrTyLit n) = text (show n)
+pprIfaceTyLit :: IfaceTyLit -> SDoc
+pprIfaceTyLit (IfaceNumTyLit n) = integer n
+pprIfaceTyLit (IfaceStrTyLit n) = text (show n)
 
 pprIfaceCoercion, pprParendIfaceCoercion :: IfaceCoercion -> SDoc
 pprIfaceCoercion = ppr_co TopPrec
@@ -899,6 +1163,13 @@ ppr_co ctxt_prec (IfaceUnivCo IfaceUnsafeCoerceProv r ty1 ty2)
     text "UnsafeCo" <+> ppr r <+>
     pprParendIfaceType ty1 <+> pprParendIfaceType ty2
 
+ppr_co ctxt_prec (IfaceUnivCo (IfaceHoleProv u) _ _ _)
+ = maybeParen ctxt_prec TyConPrec $
+   sdocWithDynFlags $ \dflags ->
+     if gopt Opt_PrintExplicitCoercions dflags
+       then braces $ ppr u
+       else braces $ text "a hole"
+
 ppr_co _         (IfaceUnivCo _ _ ty1 ty2)
   = angleBrackets ( ppr ty1 <> comma <+> ppr ty2 )
 
@@ -944,11 +1215,12 @@ instance Outputable IfaceTyCon where
   ppr tc = pprPromotionQuote tc <> ppr (ifaceTyConName tc)
 
 pprPromotionQuote :: IfaceTyCon -> SDoc
-pprPromotionQuote tc = pprPromotionQuoteI (ifaceTyConInfo tc)
+pprPromotionQuote tc =
+    pprPromotionQuoteI $ ifaceTyConIsPromoted $ ifaceTyConInfo tc
 
-pprPromotionQuoteI  :: IfaceTyConInfo -> SDoc
-pprPromotionQuoteI NoIfaceTyConInfo     = empty
-pprPromotionQuoteI IfacePromotedDataCon = char '\''
+pprPromotionQuoteI  :: IsPromoted -> SDoc
+pprPromotionQuoteI IsNotPromoted = empty
+pprPromotionQuoteI IsPromoted    = char '\''
 
 instance Outputable IfaceCoercion where
   ppr = pprIfaceCoercion
@@ -960,18 +1232,42 @@ instance Binary IfaceTyCon where
                i <- get bh
                return (IfaceTyCon n i)
 
+instance Binary IsPromoted where
+   put_ bh IsNotPromoted = putByte bh 0
+   put_ bh IsPromoted    = putByte bh 1
+
+   get bh = do
+       n <- getByte bh
+       case n of
+         0 -> return IsNotPromoted
+         1 -> return IsPromoted
+         _ -> fail "Binary(IsPromoted): fail)"
+
+instance Binary IfaceTyConSort where
+   put_ bh IfaceNormalTyCon             = putByte bh 0
+   put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort
+   put_ bh (IfaceSumTyCon arity)        = putByte bh 2 >> put_ bh arity
+   put_ bh (IfaceEqualityTyCon hom)
+     | hom                              = putByte bh 3
+     | otherwise                        = putByte bh 4
+
+   get bh = do
+       n <- getByte bh
+       case n of
+         0 -> return IfaceNormalTyCon
+         1 -> IfaceTupleTyCon <$> get bh <*> get bh
+         2 -> IfaceSumTyCon <$> get bh
+         3 -> return $ IfaceEqualityTyCon True
+         4 -> return $ IfaceEqualityTyCon False
+         _ -> fail "Binary(IfaceTyConSort): fail"
+
 instance Binary IfaceTyConInfo where
-   put_ bh NoIfaceTyConInfo     = putByte bh 0
-   put_ bh IfacePromotedDataCon = putByte bh 1
+   put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
 
-   get bh =
-     do i <- getByte bh
-        case i of
-          0 -> return NoIfaceTyConInfo
-          _ -> return IfacePromotedDataCon
+   get bh = IfaceTyConInfo <$> get bh <*> get bh
 
 instance Outputable IfaceTyLit where
-  ppr = ppr_tylit
+  ppr = pprIfaceTyLit
 
 instance Binary IfaceTyLit where
   put_ bh (IfaceNumTyLit n)  = putByte bh 1 >> put_ bh n
@@ -1008,14 +1304,51 @@ instance Binary IfaceTcArgs where
          _ -> panic ("get IfaceTcArgs " ++ show c)
 
 -------------------
-pprIfaceContextArr :: Outputable a => [a] -> SDoc
--- Prints "(C a, D b) =>", including the arrow
-pprIfaceContextArr []    = empty
-pprIfaceContextArr preds = pprIfaceContext preds <+> darrow
 
-pprIfaceContext :: Outputable a => [a] -> SDoc
+-- 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 TyOpPrec, 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. This is used when we want to
+-- print a context in a type.
+pprIfaceContextArr :: [IfacePredType] -> SDoc
+pprIfaceContextArr []     = empty
+pprIfaceContextArr [pred] = ppr_ty TyOpPrec pred <+> darrow
+pprIfaceContextArr preds  =
+    parens (fsep (punctuate comma (map ppr preds))) <+> darrow
+
+-- | Prints a context or @()@ if empty. This is used when, e.g., we want to
+-- display a context in an error message.
+pprIfaceContext :: [IfacePredType] -> SDoc
 pprIfaceContext []     = parens empty
-pprIfaceContext [pred] = ppr pred -- No parens
+pprIfaceContext [pred] = ppr_ty TyOpPrec pred
 pprIfaceContext preds  = parens (fsep (punctuate comma (map ppr preds)))
 
 instance Binary IfaceType where
@@ -1219,6 +1552,9 @@ instance Binary IfaceUnivCoProv where
   put_ bh (IfacePluginProv a) = do
           putByte bh 4
           put_ bh a
+  put_ _  (IfaceHoleProv _) =
+          pprPanic "Binary(IfaceUnivCoProv) hit a hole" empty
+  -- See Note [Holes in IfaceUnivCoProv]
 
   get bh = do
       tag <- getByte bh
@@ -1241,136 +1577,3 @@ instance Binary (DefMethSpec IfaceType) where
             case h of
               0 -> return VanillaDM
               _ -> do { t <- get bh; return (GenericDM t) }
-
-{-
-************************************************************************
-*                                                                      *
-        Conversion from Type to IfaceType
-*                                                                      *
-************************************************************************
--}
-
-----------------
-toIfaceTvBndr :: TyVar -> IfaceTvBndr
-toIfaceTvBndr tyvar   = ( occNameFS (getOccName tyvar)
-                        , toIfaceKind (tyVarKind tyvar)
-                        )
-
-toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
-toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
-
-toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
-toIfaceTvBndrs = map toIfaceTvBndr
-
-toIfaceBndr :: Var -> IfaceBndr
-toIfaceBndr var
-  | isId var  = IfaceIdBndr (toIfaceIdBndr var)
-  | otherwise = IfaceTvBndr (toIfaceTvBndr var)
-
-toIfaceKind :: Type -> IfaceType
-toIfaceKind = toIfaceType
-
----------------------
-toIfaceType :: Type -> IfaceType
--- Synonyms are retained in the interface type
-toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
-toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
-toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
-toIfaceType (ForAllTy b t)    = IfaceForAllTy (toIfaceForAllBndr b) (toIfaceType t)
-toIfaceType (FunTy t1 t2)
-  | isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
-  | otherwise   = IfaceFunTy  (toIfaceType t1) (toIfaceType t2)
-toIfaceType (CastTy ty co)      = IfaceCastTy (toIfaceType ty) (toIfaceCoercion co)
-toIfaceType (CoercionTy co)     = IfaceCoercionTy (toIfaceCoercion co)
-
-toIfaceType (TyConApp tc tys)  -- Look for the two sorts of saturated tuple
-  | Just sort <- tyConTuple_maybe tc
-  , n_tys == arity
-  = IfaceTupleTy sort NoIfaceTyConInfo (toIfaceTcArgs tc tys)
-
-  | Just dc <- isPromotedDataCon_maybe tc
-  , isTupleDataCon dc
-  , n_tys == 2*arity
-  = IfaceTupleTy BoxedTuple IfacePromotedDataCon (toIfaceTcArgs tc (drop arity tys))
-
-  | otherwise
-  = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgs tc tys)
-  where
-    arity = tyConArity tc
-    n_tys = length tys
-
-toIfaceTyVar :: TyVar -> FastString
-toIfaceTyVar = occNameFS . getOccName
-
-toIfaceCoVar :: CoVar -> FastString
-toIfaceCoVar = occNameFS . getOccName
-
-toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
-toIfaceForAllBndr (TvBndr v vis) = TvBndr (toIfaceTvBndr v) vis
-
-----------------
-toIfaceTyCon :: TyCon -> IfaceTyCon
-toIfaceTyCon tc
-  = IfaceTyCon tc_name info
-  where
-    tc_name = tyConName tc
-    info | isPromotedDataCon tc = IfacePromotedDataCon
-         | otherwise            = NoIfaceTyConInfo
-
-toIfaceTyCon_name :: Name -> IfaceTyCon
-toIfaceTyCon_name n = IfaceTyCon n NoIfaceTyConInfo
-  -- Used for the "rough-match" tycon stuff,
-  -- where pretty-printing is not an issue
-
-toIfaceTyLit :: TyLit -> IfaceTyLit
-toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x
-toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x
-
-----------------
-toIfaceTypes :: [Type] -> [IfaceType]
-toIfaceTypes ts = map toIfaceType ts
-
-----------------
-toIfaceContext :: ThetaType -> IfaceContext
-toIfaceContext = toIfaceTypes
-
-----------------
-toIfaceCoercion :: Coercion -> IfaceCoercion
-toIfaceCoercion (Refl r ty)         = IfaceReflCo r (toIfaceType ty)
-toIfaceCoercion (TyConAppCo r tc cos)
-  | tc `hasKey` funTyConKey
-  , [arg,res] <- cos                = IfaceFunCo r (toIfaceCoercion arg) (toIfaceCoercion res)
-  | otherwise                       = IfaceTyConAppCo r (toIfaceTyCon tc)
-                                                        (map toIfaceCoercion cos)
-toIfaceCoercion (AppCo co1 co2)     = IfaceAppCo  (toIfaceCoercion co1)
-                                                  (toIfaceCoercion co2)
-toIfaceCoercion (ForAllCo tv k co)  = IfaceForAllCo (toIfaceTvBndr tv)
-                                                    (toIfaceCoercion k)
-                                                    (toIfaceCoercion co)
-toIfaceCoercion (CoVarCo cv)        = IfaceCoVarCo  (toIfaceCoVar cv)
-toIfaceCoercion (AxiomInstCo con ind cos)
-                                    = IfaceAxiomInstCo (coAxiomName con) ind
-                                                       (map toIfaceCoercion cos)
-toIfaceCoercion (UnivCo p r t1 t2)  = IfaceUnivCo (toIfaceUnivCoProv p) r
-                                                  (toIfaceType t1)
-                                                  (toIfaceType t2)
-toIfaceCoercion (SymCo co)          = IfaceSymCo (toIfaceCoercion co)
-toIfaceCoercion (TransCo co1 co2)   = IfaceTransCo (toIfaceCoercion co1)
-                                                   (toIfaceCoercion co2)
-toIfaceCoercion (NthCo d co)        = IfaceNthCo d (toIfaceCoercion co)
-toIfaceCoercion (LRCo lr co)        = IfaceLRCo lr (toIfaceCoercion co)
-toIfaceCoercion (InstCo co arg)     = IfaceInstCo (toIfaceCoercion co)
-                                                  (toIfaceCoercion arg)
-toIfaceCoercion (CoherenceCo c1 c2) = IfaceCoherenceCo (toIfaceCoercion c1)
-                                                       (toIfaceCoercion c2)
-toIfaceCoercion (KindCo c)          = IfaceKindCo (toIfaceCoercion c)
-toIfaceCoercion (SubCo co)          = IfaceSubCo (toIfaceCoercion co)
-toIfaceCoercion (AxiomRuleCo co cs) = IfaceAxiomRuleCo (coaxrName co)
-                                          (map toIfaceCoercion cs)
-
-toIfaceUnivCoProv :: UnivCoProvenance -> IfaceUnivCoProv
-toIfaceUnivCoProv UnsafeCoerceProv    = IfaceUnsafeCoerceProv
-toIfaceUnivCoProv (PhantomProv co)    = IfacePhantomProv (toIfaceCoercion co)
-toIfaceUnivCoProv (ProofIrrelProv co) = IfaceProofIrrelProv (toIfaceCoercion co)
-toIfaceUnivCoProv (PluginProv str)    = IfacePluginProv str
-toIfaceUnivCoProv (HoleProv h) = pprPanic "toIfaceUnivCoProv hit a hole" (ppr h)
diff --git a/compiler/iface/IfaceType.hs-boot b/compiler/iface/IfaceType.hs-boot
new file mode 100644 (file)
index 0000000..a030c55
--- /dev/null
@@ -0,0 +1,36 @@
+-- Exists to allow TyCoRep to import pretty-printers
+module IfaceType where
+
+import Var (TyVarBndr, ArgFlag)
+import TyCon (TyConBndrVis)
+import BasicTypes (TyPrec)
+import Outputable (Outputable, SDoc)
+import FastString (FastString)
+
+type IfLclName = FastString
+type IfaceKind = IfaceType
+type IfacePredType = IfaceType
+
+data IfaceType
+data IfaceTyCon
+data IfaceTyLit
+data IfaceCoercion
+data IfaceTcArgs
+type IfaceTvBndr = (IfLclName, IfaceKind)
+type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
+type IfaceForAllBndr  = TyVarBndr IfaceTvBndr ArgFlag
+
+instance Outputable IfaceType
+
+pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
+pprIfaceSigmaType :: IfaceType -> SDoc
+pprIfaceTyLit :: IfaceTyLit -> SDoc
+pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
+pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
+pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
+pprIfaceContext :: [IfacePredType] -> SDoc
+pprIfaceContextArr :: [IfacePredType] -> SDoc
+pprIfaceTypeApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
+pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
+pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
+pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
index 9eac21c..4651418 100644 (file)
@@ -61,13 +61,11 @@ Basic idea:
 import IfaceSyn
 import BinFingerprint
 import LoadIface
+import ToIface
 import FlagChecker
 
 import Desugar ( mkUsageInfo, mkUsedNames, mkDependencies )
 import Id
-import IdInfo
-import Demand
-import Coercion( tidyCo )
 import Annotations
 import CoreSyn
 import Class
@@ -75,7 +73,6 @@ import TyCon
 import CoAxiom
 import ConLike
 import DataCon
-import PatSyn
 import Type
 import TcType
 import InstEnv
@@ -110,7 +107,6 @@ import Fingerprint
 import Exception
 import UniqFM
 import UniqDFM
-import MkId
 
 import Control.Monad
 import Data.Function
@@ -1459,29 +1455,6 @@ dataConToIfaceDecl dataCon
               ifIdInfo    = NoInfo }
 
 --------------------------
-patSynToIfaceDecl :: PatSyn -> IfaceDecl
-patSynToIfaceDecl ps
-  = IfacePatSyn { ifName          = getName $ ps
-                , ifPatMatcher    = to_if_pr (patSynMatcher ps)
-                , ifPatBuilder    = fmap to_if_pr (patSynBuilder ps)
-                , ifPatIsInfix    = patSynIsInfix ps
-                , ifPatUnivBndrs  = map toIfaceForAllBndr univ_bndrs'
-                , ifPatExBndrs    = map toIfaceForAllBndr ex_bndrs'
-                , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta
-                , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta
-                , ifPatArgs       = map (tidyToIfaceType env2) args
-                , ifPatTy         = tidyToIfaceType env2 rhs_ty
-                , ifFieldLabels   = (patSynFieldLabels ps)
-                }
-  where
-    (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
-    univ_bndrs = patSynUnivTyVarBinders ps
-    ex_bndrs   = patSynExTyVarBinders ps
-    (env1, univ_bndrs') = tidyTyVarBinders emptyTidyEnv univ_bndrs
-    (env2, ex_bndrs')   = tidyTyVarBinders env1 ex_bndrs
-    to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
-
---------------------------
 coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
 -- We *do* tidy Axioms, because they are not (and cannot
 -- conveniently be) built in tidy form
@@ -1658,15 +1631,6 @@ tyConToIfaceDecl env tycon
                              []   -> False
     ifaceFields flds = map flLabel $ dFsEnvElts flds
 
-toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
-toIfaceBang _    HsLazy              = IfNoBang
-toIfaceBang _   (HsUnpack Nothing)   = IfUnpack
-toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))
-toIfaceBang _   HsStrict             = IfStrict
-
-toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
-toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang
-
 classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
 classToIfaceDecl env clas
   = ( env1
@@ -1713,20 +1677,6 @@ classToIfaceDecl env clas
                              ,map (tidyTyVar env1) tvs2)
 
 --------------------------
-tidyToIfaceType :: TidyEnv -> Type -> IfaceType
-tidyToIfaceType env ty = toIfaceType (tidyType env ty)
-
-tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceTcArgs
-tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
-
-tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
-tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
-
-toIfaceTyVarBinder :: TyVarBndr TyVar vis -> TyVarBndr IfaceTvBndr vis
-toIfaceTyVarBinder (TvBndr tv vis) = TvBndr (toIfaceTvBndr tv) vis
-
-toIfaceTyVarBinders :: [TyVarBndr TyVar vis] -> [TyVarBndr IfaceTvBndr vis]
-toIfaceTyVarBinders = map toIfaceTyVarBinder
 
 tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
 -- If the type variable "binder" is in scope, don't re-bind it
@@ -1788,94 +1738,6 @@ famInstToIfaceFamInst (FamInst { fi_axiom    = axiom,
          = chooseOrphanAnchor lhs_names
 
 --------------------------
-toIfaceLetBndr :: Id -> IfaceLetBndr
-toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
-                               (toIfaceType (idType id))
-                               (toIfaceIdInfo (idInfo id))
-  -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr
-  -- has left on the Id.  See Note [IdInfo on nested let-bindings] in IfaceSyn
-
---------------------------t
-toIfaceIdDetails :: IdDetails -> IfaceIdDetails
-toIfaceIdDetails VanillaId                      = IfVanillaId
-toIfaceIdDetails (DFunId {})                    = IfDFunId
-toIfaceIdDetails (RecSelId { sel_naughty = n
-                           , sel_tycon = tc })  =
-  let iface = case tc of
-                RecSelData ty_con -> Left (toIfaceTyCon ty_con)
-                RecSelPatSyn pat_syn -> Right (patSynToIfaceDecl pat_syn)
-  in IfRecSelId iface n
-
-  -- The remaining cases are all "implicit Ids" which don't
-  -- appear in interface files at all
-toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
-                         IfVanillaId   -- Unexpected; the other
-
-toIfaceIdInfo :: IdInfo -> IfaceIdInfo
-toIfaceIdInfo id_info
-  = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
-                    inline_hsinfo,  unfold_hsinfo] of
-       []    -> NoInfo
-       infos -> HasInfo infos
-               -- NB: strictness and arity must appear in the list before unfolding
-               -- See TcIface.tcUnfolding
-  where
-    ------------  Arity  --------------
-    arity_info = arityInfo id_info
-    arity_hsinfo | arity_info == 0 = Nothing
-                 | otherwise       = Just (HsArity arity_info)
-
-    ------------ Caf Info --------------
-    caf_info   = cafInfo id_info
-    caf_hsinfo = case caf_info of
-                   NoCafRefs -> Just HsNoCafRefs
-                   _other    -> Nothing
-
-    ------------  Strictness  --------------
-        -- No point in explicitly exporting TopSig
-    sig_info = strictnessInfo id_info
-    strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
-                  | otherwise               = Nothing
-
-    ------------  Unfolding  --------------
-    unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
-    loop_breaker  = isStrongLoopBreaker (occInfo id_info)
-
-    ------------  Inline prag  --------------
-    inline_prag = inlinePragInfo id_info
-    inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
-                  | otherwise = Just (HsInline inline_prag)
-
---------------------------
-toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
-toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
-                                , uf_src = src
-                                , uf_guidance = guidance })
-  = Just $ HsUnfold lb $
-    case src of
-        InlineStable
-          -> case guidance of
-               UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok =  boring_ok }
-                      -> IfInlineRule arity unsat_ok boring_ok if_rhs
-               _other -> IfCoreUnfold True if_rhs
-        InlineCompulsory -> IfCompulsory if_rhs
-        InlineRhs        -> IfCoreUnfold False if_rhs
-        -- Yes, even if guidance is UnfNever, expose the unfolding
-        -- If we didn't want to expose the unfolding, TidyPgm would
-        -- have stuck in NoUnfolding.  For supercompilation we want
-        -- to see that unfolding!
-  where
-    if_rhs = toIfaceExpr rhs
-
-toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
-  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
-      -- No need to serialise the data constructor;
-      -- we can recover it from the type of the dfun
-
-toIfUnfolding _ _
-  = Nothing
-
---------------------------
 coreRuleToIfaceRule :: CoreRule -> IfaceRule
 coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
   = pprTrace "toHsRule: builtin" (ppr fn) $
@@ -1909,89 +1771,6 @@ bogusIfaceRule id_name
         ifRuleAuto = True }
 
 ---------------------
-toIfaceExpr :: CoreExpr -> IfaceExpr
-toIfaceExpr (Var v)         = toIfaceVar v
-toIfaceExpr (Lit l)         = IfaceLit l
-toIfaceExpr (Type ty)       = IfaceType (toIfaceType ty)
-toIfaceExpr (Coercion co)   = IfaceCo   (toIfaceCoercion co)
-toIfaceExpr (Lam x b)       = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b)
-toIfaceExpr (App f a)       = toIfaceApp f [a]
-toIfaceExpr (Case s x ty as)
-  | null as                 = IfaceECase (toIfaceExpr s) (toIfaceType ty)
-  | otherwise               = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)
-toIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e)
-toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)
-toIfaceExpr (Tick t e)
-  | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e)
-  | otherwise                   = toIfaceExpr e
-
-toIfaceOneShot :: Id -> IfaceOneShot
-toIfaceOneShot id | isId id
-                  , OneShotLam <- oneShotInfo (idInfo id)
-                  = IfaceOneShot
-                  | otherwise
-                  = IfaceNoOneShot
-
----------------------
-toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
-toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
-toIfaceTickish (HpcTick modl ix)       = Just (IfaceHpcTick modl ix)
-toIfaceTickish (SourceNote src names)  = Just (IfaceSource src names)
-toIfaceTickish (Breakpoint {})         = Nothing
-   -- Ignore breakpoints, since they are relevant only to GHCi, and
-   -- should not be serialised (Trac #8333)
-
----------------------
-toIfaceBind :: Bind Id -> IfaceBinding
-toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
-toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
-
----------------------
-toIfaceAlt :: (AltCon, [Var], CoreExpr)
-           -> (IfaceConAlt, [FastString], IfaceExpr)
-toIfaceAlt (c,bs,r) = (toIfaceCon c, map getOccFS bs, toIfaceExpr r)
-
----------------------
-toIfaceCon :: AltCon -> IfaceConAlt
-toIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)
-toIfaceCon (LitAlt l)   = IfaceLitAlt l
-toIfaceCon DEFAULT      = IfaceDefault
-
----------------------
-toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
-toIfaceApp (App f a) as = toIfaceApp f (a:as)
-toIfaceApp (Var v) as
-  = case isDataConWorkId_maybe v of
-        -- We convert the *worker* for tuples into IfaceTuples
-        Just dc |  saturated
-                ,  Just tup_sort <- tyConTuple_maybe tc
-                -> IfaceTuple tup_sort tup_args
-          where
-            val_args  = dropWhile isTypeArg as
-            saturated = val_args `lengthIs` idArity v
-            tup_args  = map toIfaceExpr val_args
-            tc        = dataConTyCon dc
-
-        _ -> mkIfaceApps (toIfaceVar v) as
-
-toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
-
-mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
-mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
-
----------------------
-toIfaceVar :: Id -> IfaceExpr
-toIfaceVar v
-    | Just fcall <- isFCallId_maybe v            = IfaceFCall fcall (toIfaceType (idType v))
-       -- Foreign calls have special syntax
-    | isBootUnfolding (idUnfolding v)
-    = IfaceApp (IfaceApp (IfaceExt noinlineIdName) (IfaceType (toIfaceType (idType v))))
-               (IfaceExt name) -- don't use mkIfaceApps, or infinite loop
-       -- See Note [Inlining and hs-boot files]
-    | isExternalName name                        = IfaceExt name
-    | otherwise                                  = IfaceLcl (getOccFS name)
-  where name = idName v
-
 {-
 Note [Inlining and hs-boot files]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 1ad5114..98a5f27 100644 (file)
@@ -1114,16 +1114,16 @@ tcIfaceType = go
     go (IfaceCastTy ty co)   = CastTy <$> go ty <*> tcIfaceCo co
     go (IfaceCoercionTy co)  = CoercionTy <$> tcIfaceCo co
 
-tcIfaceTupleTy :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> IfL Type
-tcIfaceTupleTy sort info args
+tcIfaceTupleTy :: TupleSort -> IsPromoted -> IfaceTcArgs -> IfL Type
+tcIfaceTupleTy sort is_promoted args
  = do { args' <- tcIfaceTcArgs args
       ; let arity = length args'
       ; base_tc <- tcTupleTyCon True sort arity
-      ; case info of
-          NoIfaceTyConInfo
+      ; case is_promoted of
+          IsNotPromoted
             -> return (mkTyConApp base_tc args')
 
-          IfacePromotedDataCon
+          IsPromoted
             -> do { let tc        = promoteDataCon (tyConSingleDataCon base_tc)
                         kind_args = map typeKind args'
                   ; return (mkTyConApp tc (kind_args ++ args')) } }
@@ -1206,6 +1206,8 @@ tcIfaceUnivCoProv IfaceUnsafeCoerceProv     = return UnsafeCoerceProv
 tcIfaceUnivCoProv (IfacePhantomProv kco)    = PhantomProv <$> tcIfaceCo kco
 tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco
 tcIfaceUnivCoProv (IfacePluginProv str)     = return $ PluginProv str
+tcIfaceUnivCoProv (IfaceHoleProv _)         =
+    pprPanic "tcIfaceUnivCoProv" (text "holes can't occur in interface files")
 
 {-
 ************************************************************************
@@ -1596,9 +1598,9 @@ tcIfaceTyConByName name
 tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
 tcIfaceTyCon (IfaceTyCon name info)
   = do { thing <- tcIfaceGlobal name
-       ; return $ case info of
-           NoIfaceTyConInfo     -> tyThingTyCon thing
-           IfacePromotedDataCon -> promoteDataCon $ tyThingDataCon thing }
+       ; return $ case ifaceTyConIsPromoted info of
+           IsNotPromoted -> tyThingTyCon thing
+           IsPromoted    -> promoteDataCon $ tyThingDataCon thing }
 
 tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
 tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs
new file mode 100644 (file)
index 0000000..48a95a9
--- /dev/null
@@ -0,0 +1,497 @@
+{-# LANGUAGE CPP #-}
+
+-- | Functions for converting Core things to interface file things.
+module ToIface
+    ( -- * Binders
+      toIfaceTvBndr
+    , toIfaceTvBndrs
+    , toIfaceIdBndr
+    , toIfaceBndr
+    , toIfaceForAllBndr
+    , toIfaceTyVarBinders
+    , toIfaceTyVar
+      -- * Types
+    , toIfaceType
+    , toIfaceKind
+    , toIfaceTcArgs
+    , toIfaceTyCon
+    , toIfaceTyCon_name
+    , toIfaceTyLit
+      -- * Tidying types
+    , tidyToIfaceType
+    , tidyToIfaceContext
+    , tidyToIfaceTcArgs
+      -- * Coercions
+    , toIfaceCoercion
+      -- * Pattern synonyms
+    , patSynToIfaceDecl
+      -- * Expressions
+    , toIfaceExpr
+    , toIfaceBang
+    , toIfaceSrcBang
+    , toIfaceLetBndr
+    , toIfaceIdDetails
+    , toIfaceIdInfo
+    , toIfUnfolding
+    , toIfaceOneShot
+    , toIfaceTickish
+    , toIfaceBind
+    , toIfaceAlt
+    , toIfaceCon
+    , toIfaceApp
+    , toIfaceVar
+    ) where
+
+#include "HsVersions.h"
+
+import IfaceSyn
+import DataCon
+import Id
+import IdInfo
+import CoreSyn
+import TyCon hiding ( pprPromotionQuote )
+import CoAxiom
+import TysPrim ( eqPrimTyCon, eqReprPrimTyCon )
+import TysWiredIn ( heqTyCon )
+import MkId ( noinlineIdName )
+import PrelNames
+import Name
+import BasicTypes
+import Type
+import PatSyn
+import Outputable
+import FastString
+import Util
+import Var
+import VarEnv
+import TyCoRep
+import Demand ( isTopSig )
+
+import Data.Maybe ( catMaybes )
+
+----------------
+toIfaceTvBndr :: TyVar -> IfaceTvBndr
+toIfaceTvBndr tyvar   = ( occNameFS (getOccName tyvar)
+                        , toIfaceKind (tyVarKind tyvar)
+                        )
+
+toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
+toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
+
+toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
+toIfaceTvBndrs = map toIfaceTvBndr
+
+toIfaceBndr :: Var -> IfaceBndr
+toIfaceBndr var
+  | isId var  = IfaceIdBndr (toIfaceIdBndr var)
+  | otherwise = IfaceTvBndr (toIfaceTvBndr var)
+
+toIfaceTyVarBinder :: TyVarBndr TyVar vis -> TyVarBndr IfaceTvBndr vis
+toIfaceTyVarBinder (TvBndr tv vis) = TvBndr (toIfaceTvBndr tv) vis
+
+toIfaceTyVarBinders :: [TyVarBndr TyVar vis] -> [TyVarBndr IfaceTvBndr vis]
+toIfaceTyVarBinders = map toIfaceTyVarBinder
+
+{-
+************************************************************************
+*                                                                      *
+        Conversion from Type to IfaceType
+*                                                                      *
+************************************************************************
+-}
+
+toIfaceKind :: Type -> IfaceType
+toIfaceKind = toIfaceType
+
+---------------------
+toIfaceType :: Type -> IfaceType
+-- Synonyms are retained in the interface type
+toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
+toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
+toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
+toIfaceType (ForAllTy b t)    = IfaceForAllTy (toIfaceForAllBndr b) (toIfaceType t)
+toIfaceType (FunTy t1 t2)
+  | isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
+  | otherwise   = IfaceFunTy  (toIfaceType t1) (toIfaceType t2)
+toIfaceType (CastTy ty co)      = IfaceCastTy (toIfaceType ty) (toIfaceCoercion co)
+toIfaceType (CoercionTy co)     = IfaceCoercionTy (toIfaceCoercion co)
+
+toIfaceType (TyConApp tc tys)
+    -- tuples
+  | Just sort <- tyConTuple_maybe tc
+  , n_tys == arity
+  = IfaceTupleTy sort IsNotPromoted (toIfaceTcArgs tc tys)
+
+  | Just dc <- isPromotedDataCon_maybe tc
+  , isTupleDataCon dc
+  , n_tys == 2*arity
+  = IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgs tc (drop arity tys))
+
+    -- type equalities: see Note [Equality predicates in IfaceType]
+  | tyConName tc == eqTyConName
+  = let info = IfaceTyConInfo IsNotPromoted (IfaceEqualityTyCon True)
+    in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgs tc tys)
+
+  | tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ]
+  , [k1, k2, _t1, _t2] <- tys
+  = let homogeneous = k1 `eqType` k2
+        info = IfaceTyConInfo IsNotPromoted (IfaceEqualityTyCon homogeneous)
+    in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgs tc tys)
+
+    -- other applications
+  | otherwise
+  = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTcArgs tc tys)
+  where
+    arity = tyConArity tc
+    n_tys = length tys
+
+toIfaceTyVar :: TyVar -> FastString
+toIfaceTyVar = occNameFS . getOccName
+
+toIfaceCoVar :: CoVar -> FastString
+toIfaceCoVar = occNameFS . getOccName
+
+toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+toIfaceForAllBndr (TvBndr v vis) = TvBndr (toIfaceTvBndr v) vis
+
+----------------
+toIfaceTyCon :: TyCon -> IfaceTyCon
+toIfaceTyCon tc
+  = IfaceTyCon tc_name info
+  where
+    tc_name = tyConName tc
+    info    = IfaceTyConInfo promoted sort
+    promoted | isPromotedDataCon tc = IsPromoted
+             | otherwise            = IsNotPromoted
+
+    tupleSort :: TyCon -> Maybe IfaceTyConSort
+    tupleSort tc' =
+        case tyConTuple_maybe tc' of
+          Just UnboxedTuple -> let arity = tyConArity tc' `div` 2
+                               in Just $ IfaceTupleTyCon arity UnboxedTuple
+          Just sort         -> let arity = tyConArity tc'
+                               in Just $ IfaceTupleTyCon arity sort
+          Nothing           -> Nothing
+
+    sort
+      | Just tsort <- tupleSort tc           = tsort
+
+      | Just dcon <- isPromotedDataCon_maybe tc
+      , let tc' = dataConTyCon dcon
+      , Just tsort <- tupleSort tc'          = tsort
+
+      | isUnboxedSumTyCon tc
+      , Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons)
+
+      | otherwise                            = IfaceNormalTyCon
+
+
+toIfaceTyCon_name :: Name -> IfaceTyCon
+toIfaceTyCon_name n = IfaceTyCon n info
+  where info = IfaceTyConInfo IsNotPromoted IfaceNormalTyCon
+  -- Used for the "rough-match" tycon stuff,
+  -- where pretty-printing is not an issue
+
+toIfaceTyLit :: TyLit -> IfaceTyLit
+toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x
+toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x
+
+----------------
+toIfaceCoercion :: Coercion -> IfaceCoercion
+toIfaceCoercion (Refl r ty)         = IfaceReflCo r (toIfaceType ty)
+toIfaceCoercion (TyConAppCo r tc cos)
+  | tc `hasKey` funTyConKey
+  , [arg,res] <- cos                = IfaceFunCo r (toIfaceCoercion arg) (toIfaceCoercion res)
+  | otherwise                       = IfaceTyConAppCo r (toIfaceTyCon tc)
+                                                        (map toIfaceCoercion cos)
+toIfaceCoercion (AppCo co1 co2)     = IfaceAppCo  (toIfaceCoercion co1)
+                                                  (toIfaceCoercion co2)
+toIfaceCoercion (ForAllCo tv k co)  = IfaceForAllCo (toIfaceTvBndr tv)
+                                                    (toIfaceCoercion k)
+                                                    (toIfaceCoercion co)
+toIfaceCoercion (CoVarCo cv)        = IfaceCoVarCo  (toIfaceCoVar cv)
+toIfaceCoercion (AxiomInstCo con ind cos)
+                                    = IfaceAxiomInstCo (coAxiomName con) ind
+                                                       (map toIfaceCoercion cos)
+toIfaceCoercion (UnivCo p r t1 t2)  = IfaceUnivCo (toIfaceUnivCoProv p) r
+                                                  (toIfaceType t1)
+                                                  (toIfaceType t2)
+toIfaceCoercion (SymCo co)          = IfaceSymCo (toIfaceCoercion co)
+toIfaceCoercion (TransCo co1 co2)   = IfaceTransCo (toIfaceCoercion co1)
+                                                   (toIfaceCoercion co2)
+toIfaceCoercion (NthCo d co)        = IfaceNthCo d (toIfaceCoercion co)
+toIfaceCoercion (LRCo lr co)        = IfaceLRCo lr (toIfaceCoercion co)
+toIfaceCoercion (InstCo co arg)     = IfaceInstCo (toIfaceCoercion co)
+                                                  (toIfaceCoercion arg)
+toIfaceCoercion (CoherenceCo c1 c2) = IfaceCoherenceCo (toIfaceCoercion c1)
+                                                       (toIfaceCoercion c2)
+toIfaceCoercion (KindCo c)          = IfaceKindCo (toIfaceCoercion c)
+toIfaceCoercion (SubCo co)          = IfaceSubCo (toIfaceCoercion co)
+toIfaceCoercion (AxiomRuleCo co cs) = IfaceAxiomRuleCo (coaxrName co)
+                                          (map toIfaceCoercion cs)
+
+toIfaceUnivCoProv :: UnivCoProvenance -> IfaceUnivCoProv
+toIfaceUnivCoProv UnsafeCoerceProv    = IfaceUnsafeCoerceProv
+toIfaceUnivCoProv (PhantomProv co)    = IfacePhantomProv (toIfaceCoercion co)
+toIfaceUnivCoProv (ProofIrrelProv co) = IfaceProofIrrelProv (toIfaceCoercion co)
+toIfaceUnivCoProv (PluginProv str)    = IfacePluginProv str
+toIfaceUnivCoProv (HoleProv h)        = IfaceHoleProv (chUnique h)
+
+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
+
+tidyToIfaceType :: TidyEnv -> Type -> IfaceType
+tidyToIfaceType env ty = toIfaceType (tidyType env ty)
+
+tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceTcArgs
+tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
+
+tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
+tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
+
+{-
+************************************************************************
+*                                                                      *
+        Conversion of pattern synonyms
+*                                                                      *
+************************************************************************
+-}
+
+patSynToIfaceDecl :: PatSyn -> IfaceDecl
+patSynToIfaceDecl ps
+  = IfacePatSyn { ifName          = getName $ ps
+                , ifPatMatcher    = to_if_pr (patSynMatcher ps)
+                , ifPatBuilder    = fmap to_if_pr (patSynBuilder ps)
+                , ifPatIsInfix    = patSynIsInfix ps
+                , ifPatUnivBndrs  = map toIfaceForAllBndr univ_bndrs'
+                , ifPatExBndrs    = map toIfaceForAllBndr ex_bndrs'
+                , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta
+                , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta
+                , ifPatArgs       = map (tidyToIfaceType env2) args
+                , ifPatTy         = tidyToIfaceType env2 rhs_ty
+                , ifFieldLabels   = (patSynFieldLabels ps)
+                }
+  where
+    (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
+    univ_bndrs = patSynUnivTyVarBinders ps
+    ex_bndrs   = patSynExTyVarBinders ps
+    (env1, univ_bndrs') = tidyTyVarBinders emptyTidyEnv univ_bndrs
+    (env2, ex_bndrs')   = tidyTyVarBinders env1 ex_bndrs
+    to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
+
+{-
+************************************************************************
+*                                                                      *
+        Conversion of other things
+*                                                                      *
+************************************************************************
+-}
+
+toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
+toIfaceBang _    HsLazy              = IfNoBang
+toIfaceBang _   (HsUnpack Nothing)   = IfUnpack
+toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))
+toIfaceBang _   HsStrict             = IfStrict
+
+toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
+toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang
+
+toIfaceLetBndr :: Id -> IfaceLetBndr
+toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
+                               (toIfaceType (idType id))
+                               (toIfaceIdInfo (idInfo id))
+  -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr
+  -- has left on the Id.  See Note [IdInfo on nested let-bindings] in IfaceSyn
+
+toIfaceIdDetails :: IdDetails -> IfaceIdDetails
+toIfaceIdDetails VanillaId                      = IfVanillaId
+toIfaceIdDetails (DFunId {})                    = IfDFunId
+toIfaceIdDetails (RecSelId { sel_naughty = n
+                           , sel_tycon = tc })  =
+  let iface = case tc of
+                RecSelData ty_con -> Left (toIfaceTyCon ty_con)
+                RecSelPatSyn pat_syn -> Right (patSynToIfaceDecl pat_syn)
+  in IfRecSelId iface n
+
+  -- The remaining cases are all "implicit Ids" which don't
+  -- appear in interface files at all
+toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
+                         IfVanillaId   -- Unexpected; the other
+
+toIfaceIdInfo :: IdInfo -> IfaceIdInfo
+toIfaceIdInfo id_info
+  = case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
+                    inline_hsinfo,  unfold_hsinfo] of
+       []    -> NoInfo
+       infos -> HasInfo infos
+               -- NB: strictness and arity must appear in the list before unfolding
+               -- See TcIface.tcUnfolding
+  where
+    ------------  Arity  --------------
+    arity_info = arityInfo id_info
+    arity_hsinfo | arity_info == 0 = Nothing
+                 | otherwise       = Just (HsArity arity_info)
+
+    ------------ Caf Info --------------
+    caf_info   = cafInfo id_info
+    caf_hsinfo = case caf_info of
+                   NoCafRefs -> Just HsNoCafRefs
+                   _other    -> Nothing
+
+    ------------  Strictness  --------------
+        -- No point in explicitly exporting TopSig
+    sig_info = strictnessInfo id_info
+    strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
+                  | otherwise               = Nothing
+
+    ------------  Unfolding  --------------
+    unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
+    loop_breaker  = isStrongLoopBreaker (occInfo id_info)
+
+    ------------  Inline prag  --------------
+    inline_prag = inlinePragInfo id_info
+    inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
+                  | otherwise = Just (HsInline inline_prag)
+
+--------------------------
+toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
+toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
+                                , uf_src = src
+                                , uf_guidance = guidance })
+  = Just $ HsUnfold lb $
+    case src of
+        InlineStable
+          -> case guidance of
+               UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok =  boring_ok }
+                      -> IfInlineRule arity unsat_ok boring_ok if_rhs
+               _other -> IfCoreUnfold True if_rhs
+        InlineCompulsory -> IfCompulsory if_rhs
+        InlineRhs        -> IfCoreUnfold False if_rhs
+        -- Yes, even if guidance is UnfNever, expose the unfolding
+        -- If we didn't want to expose the unfolding, TidyPgm would
+        -- have stuck in NoUnfolding.  For supercompilation we want
+        -- to see that unfolding!
+  where
+    if_rhs = toIfaceExpr rhs
+
+toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
+  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
+      -- No need to serialise the data constructor;
+      -- we can recover it from the type of the dfun
+
+toIfUnfolding _ _
+  = Nothing
+
+{-
+************************************************************************
+*                                                                      *
+        Conversion of expressions
+*                                                                      *
+************************************************************************
+-}
+
+toIfaceExpr :: CoreExpr -> IfaceExpr
+toIfaceExpr (Var v)         = toIfaceVar v
+toIfaceExpr (Lit l)         = IfaceLit l
+toIfaceExpr (Type ty)       = IfaceType (toIfaceType ty)
+toIfaceExpr (Coercion co)   = IfaceCo   (toIfaceCoercion co)
+toIfaceExpr (Lam x b)       = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b)
+toIfaceExpr (App f a)       = toIfaceApp f [a]
+toIfaceExpr (Case s x ty as)
+  | null as                 = IfaceECase (toIfaceExpr s) (toIfaceType ty)
+  | otherwise               = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)
+toIfaceExpr (Let b e)       = IfaceLet (toIfaceBind b) (toIfaceExpr e)
+toIfaceExpr (Cast e co)     = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)
+toIfaceExpr (Tick t e)
+  | Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e)
+  | otherwise                   = toIfaceExpr e
+
+toIfaceOneShot :: Id -> IfaceOneShot
+toIfaceOneShot id | isId id
+                  , OneShotLam <- oneShotInfo (idInfo id)
+                  = IfaceOneShot
+                  | otherwise
+                  = IfaceNoOneShot
+
+---------------------
+toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
+toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
+toIfaceTickish (HpcTick modl ix)       = Just (IfaceHpcTick modl ix)
+toIfaceTickish (SourceNote src names)  = Just (IfaceSource src names)
+toIfaceTickish (Breakpoint {})         = Nothing
+   -- Ignore breakpoints, since they are relevant only to GHCi, and
+   -- should not be serialised (Trac #8333)
+
+---------------------
+toIfaceBind :: Bind Id -> IfaceBinding
+toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
+toIfaceBind (Rec prs)    = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
+
+---------------------
+toIfaceAlt :: (AltCon, [Var], CoreExpr)
+           -> (IfaceConAlt, [FastString], IfaceExpr)
+toIfaceAlt (c,bs,r) = (toIfaceCon c, map getOccFS bs, toIfaceExpr r)
+
+---------------------
+toIfaceCon :: AltCon -> IfaceConAlt
+toIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)
+toIfaceCon (LitAlt l)   = IfaceLitAlt l
+toIfaceCon DEFAULT      = IfaceDefault
+
+---------------------
+toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
+toIfaceApp (App f a) as = toIfaceApp f (a:as)
+toIfaceApp (Var v) as
+  = case isDataConWorkId_maybe v of
+        -- We convert the *worker* for tuples into IfaceTuples
+        Just dc |  saturated
+                ,  Just tup_sort <- tyConTuple_maybe tc
+                -> IfaceTuple tup_sort tup_args
+          where
+            val_args  = dropWhile isTypeArg as
+            saturated = val_args `lengthIs` idArity v
+            tup_args  = map toIfaceExpr val_args
+            tc        = dataConTyCon dc
+
+        _ -> mkIfaceApps (toIfaceVar v) as
+
+toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
+
+mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
+mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
+
+---------------------
+toIfaceVar :: Id -> IfaceExpr
+toIfaceVar v
+    | Just fcall <- isFCallId_maybe v            = IfaceFCall fcall (toIfaceType (idType v))
+       -- Foreign calls have special syntax
+    | isBootUnfolding (idUnfolding v)
+    = IfaceApp (IfaceApp (IfaceExt noinlineIdName) (IfaceType (toIfaceType (idType v))))
+               (IfaceExt name) -- don't use mkIfaceApps, or infinite loop
+       -- See Note [Inlining and hs-boot files]
+    | isExternalName name                        = IfaceExt name
+    | otherwise                                  = IfaceLcl (getOccFS name)
+  where name = idName v
diff --git a/compiler/iface/ToIface.hs-boot b/compiler/iface/ToIface.hs-boot
new file mode 100644 (file)
index 0000000..bf6c120
--- /dev/null
@@ -0,0 +1,15 @@
+module ToIface where
+
+import {-# SOURCE #-} TyCoRep
+import {-# SOURCE #-} IfaceType
+import Var ( TyVar, TyVarBinder )
+import TyCon ( TyCon )
+
+-- For TyCoRep
+toIfaceType :: Type -> IfaceType
+toIfaceTyLit :: TyLit -> IfaceTyLit
+toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+toIfaceTvBndr :: TyVar -> IfaceTvBndr
+toIfaceTyCon :: TyCon -> IfaceTyCon
+toIfaceTcArgs :: TyCon -> [Type] -> IfaceTcArgs
+toIfaceCoercion :: Coercion -> IfaceCoercion
index 8eb77ef..3345ddf 100644 (file)
@@ -219,7 +219,7 @@ module GHC (
         pprParendType, pprTypeApp,
         Kind,
         PredType,
-        ThetaType, pprForAll, pprForAllImplicit, pprThetaArrowTy,
+        ThetaType, pprForAll, pprThetaArrowTy,
 
         -- ** Entities
         TyThing(..),
index d3ba85e..1c47922 100644 (file)
@@ -102,7 +102,7 @@ module TysWiredIn (
         -- * RuntimeRep and friends
         runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
 
-        runtimeRepTy, ptrRepLiftedTy,
+        runtimeRepTy, ptrRepLiftedTy, ptrRepLiftedDataCon, ptrRepLiftedDataConTyCon,
 
         vecRepDataConTyCon, ptrRepUnliftedDataConTyCon,
 
@@ -1161,9 +1161,12 @@ int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy,
   doubleElemRepDataConTy] = map (mkTyConTy . promoteDataCon)
                                 vecElemDataCons
 
+ptrRepLiftedDataConTyCon :: TyCon
+ptrRepLiftedDataConTyCon = promoteDataCon ptrRepLiftedDataCon
+
 -- The type ('PtrRepLifted)
 ptrRepLiftedTy :: Type
-ptrRepLiftedTy = mkTyConTy $ promoteDataCon ptrRepLiftedDataCon
+ptrRepLiftedTy = mkTyConTy ptrRepLiftedDataConTyCon
 
 {- *********************************************************************
 *                                                                      *
index b759644..7b7229c 100644 (file)
@@ -19,7 +19,7 @@ runtimeRepTyCon, vecCountTyCon, vecElemTyCon :: TyCon
 runtimeRepTy :: Type
 ptrRepLiftedTy :: Type
 
-ptrRepUnliftedDataConTyCon, vecRepDataConTyCon :: TyCon
+ptrRepLiftedDataConTyCon, ptrRepUnliftedDataConTyCon, vecRepDataConTyCon :: TyCon
 
 voidRepDataConTy, intRepDataConTy,
   wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy,
index 837f4e8..7c1857a 100644 (file)
@@ -657,8 +657,9 @@ deriveTyData tvs tc tc_args deriv_strat deriv_pred
         ; traceTc "Deriving strategy (deriving clause)" $
             vcat [ppr deriv_strat, ppr deriv_pred]
 
-        ; traceTc "derivTyData1" (vcat [ pprTvBndrs tvs, ppr tc, ppr tc_args, ppr deriv_pred
-                                       , pprTvBndrs (tyCoVarsOfTypesList tc_args)
+        ; traceTc "derivTyData1" (vcat [ pprTyVars tvs, ppr tc, ppr tc_args
+                                       , ppr deriv_pred
+                                       , pprTyVars (tyCoVarsOfTypesList tc_args)
                                        , ppr n_args_to_keep, ppr n_args_to_drop
                                        , ppr inst_ty_kind, ppr cls_arg_kind, ppr mb_match
                                        , ppr final_tc_args, ppr final_cls_tys ])
index 63ff904..109e634 100644 (file)
@@ -526,7 +526,7 @@ simplifyDeriv pred tvs theta
        ; (wanted, tclvl) <- pushTcLevelM (mapM mk_ct theta)
 
        ; traceTc "simplifyDeriv inputs" $
-         vcat [ pprTvBndrs tvs $$ ppr theta $$ ppr wanted, doc ]
+         vcat [ pprTyVars tvs $$ ppr theta $$ ppr wanted, doc ]
        -- Simplify the constraints
        ; residual_wanted <- simplifyWantedsTcM wanted
             -- Result is zonked
index 783b6ef..d73c94f 100644 (file)
@@ -194,7 +194,7 @@ report_unsolved mb_binds_var err_as_warn type_errors expr_holes
              free_tvs = tyCoVarsOfWCList wanted
 
        ; traceTc "reportUnsolved (after zonking and tidying):" $
-         vcat [ pprTvBndrs free_tvs
+         vcat [ pprTyVars free_tvs
               , ppr wanted ]
 
        ; warn_redundant <- woptM Opt_WarnRedundantConstraints
index 9e7eed1..2632fd1 100644 (file)
@@ -1207,7 +1207,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
                           kind = tyVarKind tv
                     ; MASSERT2( vis == Specified
                         , (vcat [ ppr fun_ty, ppr upsilon_ty, ppr tvb
-                                , ppr inner_ty, pprTvBndr tv
+                                , ppr inner_ty, pprTyVar tv
                                 , ppr vis ]) )
                     ; ty_arg <- tcHsTypeApp hs_ty_arg kind
                     ; let insted_ty = substTyWithUnchecked [tv] [ty_arg] inner_ty
index 6e6bcd0..8fb5d16 100644 (file)
@@ -1468,7 +1468,7 @@ tcExplicitTKBndrsX new_tv orig_hs_tvs thing_inside
 
        ; traceTc "tcExplicitTKBndrs" $
            vcat [ text "Hs vars:" <+> ppr orig_hs_tvs
-                , text "tvs:" <+> sep (map pprTvBndr tvs) ]
+                , text "tvs:" <+> sep (map pprTyVar tvs) ]
 
        ; return (result, bound_tvs `unionVarSet` mkVarSet tvs)
        }
index 22556ed..9a94eef 100644 (file)
@@ -396,7 +396,7 @@ runSolverPipeline pipeline workItem
            ContinueWith ct -> do { traceFireTcS (ctEvidence ct) (text "Kept as inert")
                                  ; traceTcS "End solver pipeline (kept as inert) }" $
                                        vcat [ text "final_item =" <+> ppr ct
-                                            , pprTvBndrs $ tyCoVarsOfCtList ct
+                                            , pprTyVars $ tyCoVarsOfCtList ct
                                             , text "inerts     =" <+> ppr final_is]
                                  ; addInertCan ct }
        }
index 0892f64..af87483 100644 (file)
@@ -1411,7 +1411,7 @@ zonkTcTyCoVarBndr :: TcTyCoVar -> TcM TcTyCoVar
 -- unification variables.
 zonkTcTyCoVarBndr tyvar
     -- can't use isCoVar, because it looks at a TyCon. Argh.
-  = ASSERT2( isImmutableTyVar tyvar || (not $ isTyVar tyvar), pprTvBndr tyvar )
+  = ASSERT2( isImmutableTyVar tyvar || (not $ isTyVar tyvar), pprTyVar tyvar )
     updateTyVarKindM zonkTcType tyvar
 
 -- | Zonk a TyBinder
index 9a5fd7d..b1d444a 100644 (file)
@@ -29,6 +29,7 @@ import RdrName
 import TcEnv
 import TcMType
 import TcValidity( arityErr )
+import Type ( pprTyVars )
 import TcType
 import TcUnify
 import TcHsType
@@ -757,11 +758,11 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty arg_pats thing_inside
               arg_tys' = substTys tenv arg_tys
 
         ; traceTc "tcConPat" (vcat [ ppr con_name
-                                   , pprTvBndrs univ_tvs
-                                   , pprTvBndrs ex_tvs
+                                   , pprTyVars univ_tvs
+                                   , pprTyVars ex_tvs
                                    , ppr eq_spec
                                    , ppr theta
-                                   , pprTvBndrs ex_tvs'
+                                   , pprTyVars ex_tvs'
                                    , ppr ctxt_res_tys
                                    , ppr arg_tys'
                                    , ppr arg_pats ])
index c3d1897..9c4bc75 100644 (file)
@@ -2174,7 +2174,7 @@ instance Outputable Implication where
               , ic_binds = binds, ic_info = info })
    = hang (text "Implic" <+> lbrace)
         2 (sep [ text "TcLevel =" <+> ppr tclvl
-               , text "Skolems =" <+> pprTvBndrs skols
+               , text "Skolems =" <+> pprTyVars skols
                , text "No-eqs =" <+> ppr no_eqs
                , text "Status =" <+> ppr status
                , hang (text "Given =")  2 (pprEvVars given)
index 0b471d2..c009bc9 100644 (file)
@@ -1129,7 +1129,7 @@ tcTyFamInstEqn fam_tc_shape@(fam_tc_name,_,_,_) mb_clsinfo
        ; (ze, tvs') <- zonkTyBndrsX emptyZonkEnv tvs
        ; pats'      <- zonkTcTypeToTypes ze pats
        ; rhs_ty'    <- zonkTcTypeToType ze rhs_ty
-       ; traceTc "tcTyFamInstEqn" (ppr fam_tc_name <+> pprTvBndrs tvs')
+       ; traceTc "tcTyFamInstEqn" (ppr fam_tc_name <+> pprTyVars tvs')
           -- don't print out the pats here, as they might be zonked inside the knot
        ; return (mkCoAxBranch tvs' [] pats' rhs_ty'
                               (map (const Nominal) tvs')
@@ -2236,7 +2236,7 @@ checkValidTyConTyVars tc
                    = text "NB: Implicitly declared kind variables are put first."
                    | otherwise
                    = empty
-       ; checkValidTelescope (pprTvBndrs vis_tvs) stripped_tvs extra
+       ; checkValidTelescope (pprTyVars vis_tvs) stripped_tvs extra
          `and_if_that_doesn't_error`
            -- This triggers on test case dependent/should_fail/InferDependency
            -- It reports errors around Note [Dependent LHsQTyVars] in TcHsType
index b316fe2..6cc40a5 100644 (file)
@@ -1790,7 +1790,7 @@ checkZonkValidTelescope hs_tvs orig_tvs extra
          addErr $
          vcat [ hang (text "These kind and type variables:" <+> hs_tvs $$
                       text "are out of dependency order. Perhaps try this ordering:")
-                   2 (sep (map pprTvBndr sorted_tidied_tvs))
+                   2 (sep (map pprTyVar sorted_tidied_tvs))
               , extra ]
        ; return orig_tvs }
 
index acd6aaf..807d855 100644 (file)
@@ -3,6 +3,7 @@ module Coercion where
 import {-# SOURCE #-} TyCoRep
 import {-# SOURCE #-} TyCon
 
+import BasicTypes ( LeftOrRight )
 import CoAxiom
 import Var
 import Outputable
index 62c186c..9979853 100644 (file)
@@ -32,7 +32,7 @@ module TyCoRep (
         ArgFlag(..),
 
         -- * Coercions
-        Coercion(..), LeftOrRight(..),
+        Coercion(..),
         UnivCoProvenance(..), CoercionHole(..),
         CoercionN, CoercionR, CoercionP, KindCoercion,
 
@@ -58,11 +58,12 @@ module TyCoRep (
         -- * Pretty-printing
         pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs,
         pprSigmaType,
-        pprTheta, pprForAll, pprForAllImplicit, pprUserForAll,
+        pprTheta, pprForAll, pprUserForAll,
+        pprTyVar, pprTyVars,
         pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprTyLit,
         TyPrec(..), maybeParen, pprTcAppCo, pprTcAppTy,
-        pprPrefixApp, pprArrowChain, ppr_type,
+        pprPrefixApp, pprArrowChain,
         pprDataCons, ppSuggestExplicitKinds,
 
         -- * Free variables
@@ -127,36 +128,34 @@ module TyCoRep (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} DataCon( dataConTyCon, dataConFullSig
-                              , dataConUnivTyVarBinders, dataConExTyVarBinders
-                              , DataCon, filterEqSpec )
+import {-# SOURCE #-} DataCon( dataConFullSig
+                             , dataConUnivTyVarBinders, dataConExTyVarBinders
+                             , DataCon, filterEqSpec )
 import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy
                           , tyCoVarsOfTypesWellScoped
-                          , partitionInvisibles, coreView, typeKind
-                          , eqType )
+                          , coreView, typeKind )
    -- Transitively pulls in a LOT of stuff, better to break the loop
 
 import {-# SOURCE #-} Coercion
 import {-# SOURCE #-} ConLike ( ConLike(..), conLikeName )
-import {-# SOURCE #-} TysWiredIn ( ptrRepLiftedTy )
+import {-# SOURCE #-} ToIface
 
 -- friends:
+import IfaceType
 import Var
 import VarEnv
 import VarSet
 import Name hiding ( varName )
-import BasicTypes
 import TyCon
 import Class
 import CoAxiom
 import FV
 
 -- others
+import BasicTypes ( LeftOrRight(..), TyPrec(..), maybeParen, pickLR )
 import PrelNames
-import Binary
 import Outputable
 import DynFlags
-import StaticFlags ( opt_PprStyle_Debug )
 import FastString
 import Pair
 import UniqSupply
@@ -833,25 +832,6 @@ type CoercionR = Coercion       -- always representational
 type CoercionP = Coercion       -- always phantom
 type KindCoercion = CoercionN   -- always nominal
 
--- If you edit this type, you may need to update the GHC formalism
--- See Note [GHC Formalism] in coreSyn/CoreLint.hs
-data LeftOrRight = CLeft | CRight
-                 deriving( Eq, Data.Data )
-
-instance Binary LeftOrRight where
-   put_ bh CLeft  = putByte bh 0
-   put_ bh CRight = putByte bh 1
-
-   get bh = do { h <- getByte bh
-               ; case h of
-                   0 -> return CLeft
-                   _ -> return CRight }
-
-pickLR :: LeftOrRight -> (a,a) -> a
-pickLR CLeft  (l,_) = l
-pickLR CRight (_,r) = r
-
-
 {-
 Note [Refl invariant]
 ~~~~~~~~~~~~~~~~~~~~~
@@ -2291,7 +2271,7 @@ substTyVarBndrUnchecked = substTyVarBndrCallback substTyUnchecked
 substTyVarBndrCallback :: (TCvSubst -> Type -> Type)  -- ^ the subst function
                        -> TCvSubst -> TyVar -> (TCvSubst, TyVar)
 substTyVarBndrCallback subst_fn subst@(TCvSubst in_scope tenv cenv) old_var
-  = ASSERT2( _no_capture, pprTvBndr old_var $$ pprTvBndr new_var $$ ppr subst )
+  = ASSERT2( _no_capture, pprTyVar old_var $$ pprTyVar new_var $$ ppr subst )
     ASSERT( isTyVar old_var )
     (TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv, new_var)
   where
@@ -2401,106 +2381,14 @@ Maybe operator applications should bind a bit less tightly?
 Anyway, that's the current story, and it is used consistently for Type and HsType
 -}
 
-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
-
 ------------------
 
-{-
-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 :: Type -> Type
-defaultRuntimeRepVars = defaultRuntimeRepVars' emptyVarSet
-
-defaultRuntimeRepVars' :: TyVarSet  -- ^ the binders which we should default
-                       -> Type -> Type
--- TODO: Eventually we should just eliminate the Type pretty-printer
--- entirely and simply use IfaceType; this task is tracked as #11660.
-defaultRuntimeRepVars' subs (ForAllTy (TvBndr var vis) ty)
-  | isRuntimeRepVar var                        =
-    let subs' = extendVarSet subs var
-    in defaultRuntimeRepVars' subs' ty
-  | otherwise                                  =
-    let var' = var { varType = defaultRuntimeRepVars' subs (varType var) }
-    in ForAllTy (TvBndr var' vis) (defaultRuntimeRepVars' subs ty)
-
-defaultRuntimeRepVars' subs (FunTy kind ty) =
-    FunTy (defaultRuntimeRepVars' subs kind)
-          (defaultRuntimeRepVars' subs ty)
-
-defaultRuntimeRepVars' subs (TyVarTy var)
-  | var `elemVarSet` subs                      = ptrRepLiftedTy
-
-defaultRuntimeRepVars' subs (TyConApp tc args) =
-    TyConApp tc $ map (defaultRuntimeRepVars' subs) args
-
-defaultRuntimeRepVars' subs (AppTy x y)        =
-    defaultRuntimeRepVars' subs x `AppTy` defaultRuntimeRepVars' subs y
-
-defaultRuntimeRepVars' subs (CastTy ty co)     =
-    CastTy (defaultRuntimeRepVars' subs ty) co
-
-defaultRuntimeRepVars' _    other              = other
-
-eliminateRuntimeRep :: (Type -> SDoc) -> Type -> SDoc
-eliminateRuntimeRep f ty = sdocWithDynFlags $ \dflags ->
-    if gopt Opt_PrintExplicitRuntimeReps dflags
-      then f ty
-      else f (defaultRuntimeRepVars ty)
-
 pprType, pprParendType :: Type -> SDoc
-pprType       ty = eliminateRuntimeRep (ppr_type TopPrec) ty
-pprParendType ty = eliminateRuntimeRep (ppr_type TyConPrec) ty
+pprType       = pprIfaceType . toIfaceType
+pprParendType = pprParendIfaceType . toIfaceType
 
 pprTyLit :: TyLit -> SDoc
-pprTyLit = ppr_tylit TopPrec
+pprTyLit = pprIfaceTyLit . toIfaceTyLit
 
 pprKind, pprParendKind :: Kind -> SDoc
 pprKind       = pprType
@@ -2512,38 +2400,10 @@ pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
 
 ------------
 pprTheta :: ThetaType -> SDoc
-pprTheta [pred] = ppr_type TopPrec pred     -- I'm in two minds about this
-pprTheta theta  = parens (sep (punctuate comma (map (ppr_type TopPrec) theta)))
+pprTheta = pprIfaceContext . map toIfaceType
 
 pprThetaArrowTy :: ThetaType -> SDoc
-pprThetaArrowTy []     = empty
-pprThetaArrowTy [pred] = ppr_type TyOpPrec pred <+> darrow
-                         -- TyOpPrec:  Num a     => a -> a  does not need parens
-                         --      bug   (a :~: b) => a -> b  currently does
-                         -- Trac # 9658
-pprThetaArrowTy preds  = parens (fsep (punctuate comma (map (ppr_type TopPrec) preds)))
-                            <+> darrow
-    -- Notice 'fsep' here rather that 'sep', so that
-    -- type contexts don't get displayed in 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 get
-    --
-    --  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)
+pprThetaArrowTy = pprIfaceContextArr . map toIfaceType
 
 ------------------
 instance Outputable Type where
@@ -2553,182 +2413,28 @@ instance Outputable TyLit where
    ppr = pprTyLit
 
 ------------------
-        -- OK, here's the main printer
-
-ppr_type :: TyPrec -> Type -> SDoc
-ppr_type _ (TyVarTy tv)       = ppr_tvar tv
-
-ppr_type p (TyConApp tc tys)  = pprTyTcApp p tc tys
-ppr_type p (LitTy l)          = ppr_tylit p l
-ppr_type p ty@(ForAllTy {})   = ppr_forall_type p ty
-ppr_type p ty@(FunTy {})      = ppr_forall_type p ty
-
-ppr_type p (AppTy t1 t2)
-  = if_print_coercions
-      ppr_app_ty
-      (case split_app_tys t1 [t2] of
-          (CastTy head _, args) -> ppr_type p (mk_app_tys head args)
-          _                     -> ppr_app_ty)
-  where
-    ppr_app_ty = maybeParen p TyConPrec $
-                 ppr_type FunPrec t1 <+> ppr_type TyConPrec t2
-
-    split_app_tys (AppTy ty1 ty2) args = split_app_tys ty1 (ty2:args)
-    split_app_tys head            args = (head, args)
-
-    mk_app_tys (TyConApp tc tys1) tys2 = TyConApp tc (tys1 ++ tys2)
-    mk_app_tys ty1                tys2 = foldl AppTy ty1 tys2
-
-ppr_type p (CastTy ty co)
-  = if_print_coercions
-      (parens (ppr_type TopPrec ty <+> text "|>" <+> ppr co))
-      (ppr_type p ty)
-
-ppr_type _ (CoercionTy co)
-  = if_print_coercions
-      (parens (ppr co))
-      (text "<>")
-
-ppr_forall_type :: TyPrec -> Type -> SDoc
--- Used for types starting with ForAllTy or FunTy
-ppr_forall_type p ty
-  = maybeParen p FunPrec $
-    sdocWithDynFlags $ \dflags ->
-    ppr_sigma_type dflags True ty
-    -- True <=> we always print the foralls on *nested* quantifiers
-    -- Opt_PrintExplicitForalls only affects top-level quantifiers
-
-ppr_tvar :: TyVar -> SDoc
-ppr_tvar tv  -- Note [Infix type variables]
-  = parenSymOcc (getOccName tv) (ppr tv)
-
-ppr_tylit :: TyPrec -> TyLit -> SDoc
-ppr_tylit _ tl =
-  case tl of
-    NumTyLit n -> integer n
-    StrTyLit s -> text (show s)
-
-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
-
--------------------
-ppr_sigma_type :: DynFlags
-               -> Bool -- ^ True <=> Show the foralls unconditionally
-               -> Type -> SDoc
--- Used for types starting with ForAllTy or FunTy
--- Suppose we have (forall a. Show a => forall b. a -> b). When we're not
--- printing foralls, we want to drop both the (forall a) and the (forall b).
--- This logic does so.
-ppr_sigma_type dflags False orig_ty
-  | not (gopt Opt_PrintExplicitForalls dflags)
-  , all (isEmptyVarSet . tyCoVarsOfType . tyVarKind) tv_bndrs
-      -- See Note [When to print foralls]
-  = sep [ pprThetaArrowTy theta
-        , pprArrowChain TopPrec (ppr_fun_tail tau) ]
-  where
-    (tv_bndrs, theta, tau) = split [] [] orig_ty
-
-    split :: [TyVar] -> [PredType] -> Type
-          -> ([TyVar], [PredType], Type)
-    split bndr_acc theta_acc (ForAllTy (TvBndr tv vis) ty)
-      | isInvisibleArgFlag vis  = split (tv : bndr_acc) theta_acc ty
-    split bndr_acc theta_acc (FunTy ty1 ty2)
-      | isPredTy ty1            = split bndr_acc (ty1 : theta_acc) ty2
-    split bndr_acc theta_acc ty = (reverse bndr_acc, reverse theta_acc, ty)
-
-ppr_sigma_type _ _ ty
-  = sep [ pprForAll bndrs
-        , pprThetaArrowTy ctxt
-        , pprArrowChain TopPrec (ppr_fun_tail tau) ]
-  where
-    (bndrs, rho) = split1 [] ty
-    (ctxt, tau)  = split2 [] rho
-
-    split1 bndrs (ForAllTy bndr ty) = split1 (bndr:bndrs) ty
-    split1 bndrs ty                 = (reverse bndrs, ty)
-
-    split2 ps (FunTy ty1 ty2) | isPredTy ty1 = split2 (ty1:ps) ty2
-    split2 ps ty                             = (reverse ps, ty)
-
-    -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
-ppr_fun_tail :: Type -> [SDoc]
-ppr_fun_tail (FunTy ty1 ty2)
-  | not (isPredTy ty1) = ppr_type FunPrec ty1 : ppr_fun_tail ty2
-ppr_fun_tail other_ty = [ppr_type TopPrec other_ty]
 
 pprSigmaType :: Type -> SDoc
--- Prints a top-level type for the user; in particular
--- top-level foralls are omitted unless you use -fprint-explicit-foralls
-pprSigmaType ty = sdocWithDynFlags $ \dflags ->
-                  eliminateRuntimeRep (ppr_sigma_type dflags False) ty
-
-pprUserForAll :: [TyVarBinder] -> SDoc
--- Print a user-level forall; see Note [When to print foralls]
-pprUserForAll bndrs
-  = sdocWithDynFlags $ \dflags ->
-    ppWhen (any bndr_has_kind_var bndrs || gopt Opt_PrintExplicitForalls dflags) $
-    pprForAll bndrs
-  where
-    bndr_has_kind_var bndr
-      = not (isEmptyVarSet (tyCoVarsOfType (binderKind bndr)))
-
-pprForAllImplicit :: [TyVar] -> SDoc
-pprForAllImplicit tvs = pprForAll [ TvBndr tv Specified | tv <- tvs ]
+pprSigmaType = pprIfaceSigmaType . toIfaceType
 
--- | Render the "forall ... ." or "forall ... ->" bit of a type.
--- Do not pass in anonymous binders!
 pprForAll :: [TyVarBinder] -> SDoc
-pprForAll [] = empty
-pprForAll bndrs@(TvBndr _ vis : _)
-  = add_separator (forAllLit <+> doc) <+> pprForAll bndrs'
-  where
-    (bndrs', doc) = ppr_tv_bndrs bndrs vis
+pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)
 
-    add_separator stuff = case vis of
-                            Required  -> stuff <+> arrow
-                            _inv      -> stuff <>  dot
+-- | Print a user-level forall; see Note [When to print foralls]
+pprUserForAll :: [TyVarBinder] -> SDoc
+pprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr
 
-pprTvBndrs :: [TyVar] -> SDoc
+pprTvBndrs :: [TyVarBinder] -> SDoc
 pprTvBndrs tvs = sep (map pprTvBndr tvs)
 
--- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
--- Returns both the list of not-yet-rendered binders and the doc.
-ppr_tv_bndrs :: [TyVarBinder]
-             -> ArgFlag  -- ^ visibility of the first binder in the list
-             -> ([TyVarBinder], SDoc)
-ppr_tv_bndrs all_bndrs@(TvBndr tv vis : bndrs) vis1
-  | vis `sameVis` vis1 = let (bndrs', doc) = ppr_tv_bndrs bndrs vis1
-                             pp_tv = sdocWithDynFlags $ \dflags ->
-                                     if Inferred == vis &&
-                                        gopt Opt_PrintExplicitForalls dflags
-                                     then braces (pprTvBndrNoParens tv)
-                                     else pprTvBndr tv
-                         in
-                         (bndrs', pp_tv <+> doc)
-  | otherwise   = (all_bndrs, empty)
-ppr_tv_bndrs [] _ = ([], empty)
-
-pprTvBndr :: TyVar -> SDoc
-pprTvBndr tv
-  | isLiftedTypeKind kind = ppr_tvar tv
-  | otherwise             = parens (ppr_tvar tv <+> dcolon <+> pprKind kind)
-             where
-               kind = tyVarKind tv
-
-pprTvBndrNoParens :: TyVar -> SDoc
-pprTvBndrNoParens tv
-  | isLiftedTypeKind kind = ppr_tvar tv
-  | otherwise             = ppr_tvar tv <+> dcolon <+> pprKind kind
-             where
-               kind = tyVarKind tv
+pprTvBndr :: TyVarBinder -> SDoc
+pprTvBndr = pprIfaceTvBndr True . toIfaceTvBndr . binderVar
+
+pprTyVars :: [TyVar] -> SDoc
+pprTyVars tvs = sep (map pprTyVar tvs)
+
+pprTyVar :: TyVar -> SDoc
+pprTyVar = pprIfaceTvBndr True . toIfaceTvBndr
 
 instance Outputable TyBinder where
   ppr (Anon ty) = text "[anon]" <+> ppr ty
@@ -2739,9 +2445,6 @@ instance Outputable TyBinder where
 -----------------
 instance Outputable Coercion where -- defined here to avoid orphans
   ppr = pprCo
-instance Outputable LeftOrRight where
-  ppr CLeft    = text "Left"
-  ppr CRight   = text "Right"
 
 {-
 Note [When to print foralls]
@@ -2799,249 +2502,23 @@ pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]
 
 
 pprTypeApp :: TyCon -> [Type] -> SDoc
-pprTypeApp tc tys = pprTyTcApp TopPrec tc tys
-        -- We have to use ppr on the TyCon (not its name)
-        -- so that we get promotion quotes in the right place
-
-pprTyTcApp :: TyPrec -> TyCon -> [Type] -> SDoc
--- Used for types only; so that we can make a
--- special case for type-level lists
-pprTyTcApp p tc tys
-  | tc `hasKey` ipClassKey
-  , [LitTy (StrTyLit n),ty] <- tys
-  = maybeParen p FunPrec $
-    char '?' <> ftext n <> text "::" <> ppr_type TopPrec ty
-
-  | tc `hasKey` consDataConKey
-  , [_kind,ty1,ty2] <- tys
-  = sdocWithDynFlags $ \dflags ->
-    if gopt Opt_PrintExplicitKinds dflags then ppr_deflt
-                                          else pprTyList p ty1 ty2
-
-  | not opt_PprStyle_Debug
-  , tc `hasKey` errorMessageTypeErrorFamKey
-  = text "(TypeError ...)"   -- Suppress detail unles you _really_ want to see
-
-  | tc `hasKey` tYPETyConKey
-  , [TyConApp ptr_rep []] <- tys
-  , ptr_rep `hasKey` ptrRepLiftedDataConKey
-  = unicodeSyntax (char '★') (char '*')
-
-  | tc `hasKey` tYPETyConKey
-  , [TyConApp ptr_rep []] <- tys
-  , ptr_rep `hasKey` ptrRepUnliftedDataConKey
-  = char '#'
+pprTypeApp = pprTcAppTy TopPrec
 
-  | otherwise
-  = ppr_deflt
-  where
-    ppr_deflt = pprTcAppTy p ppr_type tc tys
-
-pprTcAppTy :: TyPrec -> (TyPrec -> Type -> SDoc) -> TyCon -> [Type] -> SDoc
-pprTcAppTy p pp tc tys
-  = getPprStyle $ \style -> pprTcApp style id p pp tc tys
+pprTcAppTy :: TyPrec -> TyCon -> [Type] -> SDoc
+pprTcAppTy p tc tys
+    -- TODO: toIfaceTcArgs seems rather wasteful here
+  = pprIfaceTypeApp p (toIfaceTyCon tc) (toIfaceTcArgs tc tys)
 
 pprTcAppCo :: TyPrec -> (TyPrec -> Coercion -> SDoc)
            -> TyCon -> [Coercion] -> SDoc
-pprTcAppCo p pp tc cos
-  = getPprStyle $ \style ->
-    pprTcApp style (pFst . coercionKind) p pp tc cos
-
-pprTcApp :: PprStyle
-         -> (a -> Type) -> TyPrec -> (TyPrec -> a -> SDoc) -> TyCon -> [a] -> SDoc
--- Used for both types and coercions, hence polymorphism
-pprTcApp _ _ _ pp tc [ty]
-  | tc `hasKey` listTyConKey = pprPromotionQuote tc <> brackets   (pp TopPrec ty)
-  | tc `hasKey` parrTyConKey = pprPromotionQuote tc <> paBrackets (pp TopPrec ty)
-
-pprTcApp style to_type p pp tc tys
-  | not (debugStyle style)
-  , Just sort <- tyConTuple_maybe tc
-  , let arity = tyConArity tc
-  , arity == length tys
-  , let num_to_drop = case sort of UnboxedTuple -> arity `div` 2
-                                   _            -> 0
-  = pprTupleApp p pp tc sort (drop num_to_drop tys)
-
-  | not (debugStyle style)
-  , Just dc <- isPromotedDataCon_maybe tc
-  , let dc_tc = dataConTyCon dc
-  , Just tup_sort <- tyConTuple_maybe dc_tc
-  , let arity = tyConArity dc_tc    -- E.g. 3 for (,,) k1 k2 k3 t1 t2 t3
-        ty_args = drop arity tys    -- Drop the kind args
-  , ty_args `lengthIs` arity        -- Result is saturated
-  = pprPromotionQuote tc <>
-    (tupleParens tup_sort $ pprWithCommas (pp TopPrec) ty_args)
-
-  | not (debugStyle style)
-  , isUnboxedSumTyCon tc
-  , let arity = tyConArity tc
-        ty_args = drop (arity `div` 2) tys -- Drop the kind args
-  , tys `lengthIs` arity -- Not a partial application
-  = pprSumApp pp tc ty_args
-
-  | otherwise
-  = sdocWithDynFlags $ \dflags ->
-    pprTcApp_help to_type p pp tc tys dflags style
-
-pprTupleApp :: TyPrec -> (TyPrec -> a -> SDoc)
-            -> TyCon -> TupleSort -> [a] -> SDoc
--- Print a saturated tuple
-pprTupleApp p pp tc sort tys
-  | null tys
-  , ConstraintTuple <- sort
-  = if opt_PprStyle_Debug then text "(%%)"
-                          else maybeParen p FunPrec $
-                               text "() :: Constraint"
-  | otherwise
-  = pprPromotionQuote tc <>
-    tupleParens sort (pprWithCommas (pp TopPrec) tys)
-
-pprSumApp :: (TyPrec -> a -> SDoc) -> TyCon -> [a] -> SDoc
-pprSumApp pp tc tys
-  = pprPromotionQuote tc <>
-    sumParens (pprWithBars (pp TopPrec) tys)
-
-pprTcApp_help :: (a -> Type) -> TyPrec -> (TyPrec -> a -> SDoc)
-              -> TyCon -> [a] -> DynFlags -> PprStyle -> SDoc
--- This one has accss to the DynFlags
-pprTcApp_help to_type p pp tc tys dflags style
-  | not (isSymOcc (nameOccName tc_name)) -- Print prefix
-  = pprPrefixApp p pp_tc (map (pp TyConPrec) tys_wo_kinds)
-
-  | Just args <- mb_saturated_equality
-  = print_equality args
-
-  -- So we have an operator symbol of some kind
-
-  | [ty1,ty2] <- tys_wo_kinds  -- Infix, two arguments;
-                               -- we know nothing of precedence though
-  = pprInfixApp p pp pp_tc ty1 ty2
-
-  |  tc_name `hasKey` starKindTyConKey
-  || tc_name `hasKey` unicodeStarKindTyConKey
-  || tc_name `hasKey` unliftedTypeKindTyConKey
-  = pp_tc   -- Do not wrap *, # in parens
-
-  | otherwise  -- Unsaturated operator
-  = pprPrefixApp p (parens (pp_tc)) (map (pp TyConPrec) tys_wo_kinds)
-  where
-    tc_name      = tyConName tc
-    pp_tc        = ppr tc
-    tys_wo_kinds = suppressInvisibles to_type dflags tc tys
-
-    -- See Note [Printing equality constraints]
-    mb_saturated_equality
-      | hetero_eq_tc
-      , [k1, k2, t1, t2] <- tys
-      = Just (k1, k2, t1, t2)
-      | homo_eq_tc
-      , [k, t1, t2] <- tys  -- we must have (~)
-      = Just (k, k, t1, t2)
-      | otherwise
-      = Nothing
-
-    -- See Note [Printing equality constraints]
-    homo_eq_tc   =  tc `hasKey` eqTyConKey             -- ~
-    hetero_eq_tc =  tc `hasKey` eqPrimTyConKey         -- ~#
-                 || tc `hasKey` eqReprPrimTyConKey     -- ~R#
-                 || tc `hasKey` heqTyConKey            -- ~~
-
-    -- See Note [Printing equality constraints]
-    print_equality (ki1, ki2, ty1, ty2)
-      | print_eqs
-      = ppr_infix_eq pp_tc
-
-      | hetero_eq_tc
-      , print_kinds || not (to_type ki1 `eqType` to_type ki2)
-      = ppr_infix_eq $ if tc `hasKey` eqPrimTyConKey
-                       then text "~~"
-                       else pp_tc
-
-      | otherwise
-      = if tc `hasKey` eqReprPrimTyConKey
-        then text "Coercible" <+> (sep [ pp TyConPrec ty1
-                                       , pp TyConPrec ty2 ])
-        else sep [pp TyOpPrec ty1, text "~", pp TyOpPrec ty2]
-
-      where
-        ppr_infix_eq eq_op
-           = sep [ parens (pp TyOpPrec ty1 <+> dcolon <+> pp TyOpPrec ki1)
-                 , eq_op
-                 , parens (pp TyOpPrec ty2 <+> dcolon <+> pp TyOpPrec ki2)]
-
-    print_kinds = gopt Opt_PrintExplicitKinds dflags
-    print_eqs   = gopt Opt_PrintEqualityRelations dflags ||
-                  dumpStyle style ||
-                  debugStyle style
-
-{- Note [Printing equality constraints]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-GHC has a lot of differnent equalities:
-   ~       Boxed   homogeneous   Nominal
-   ~~      Boxed   heterogeneous Nominal
-   ~#      Unboxed heterogeneous Nominal
-   ~R#     Unboxed heterogeneous Representational
-
-This is cofusing to the user, so when priting we usse this
-strategy:
-
-If -fprint-equality-relations or -dppr-debug or we are in
-   "dump style", then print the relation as-is, which
-   distinguishes the various different equalities listed
-   above
-
-If ...something about heterogeneous equalities
-
-Otherwise print 'Coercible' for (~R#), and "~" for the others.
-
-This is all a bit ad-hoc, trying to print out the best representation
-of equalities.  If you see a better design, go for it.
--}
+pprTcAppCo p _pp tc cos
+  = pprIfaceCoTcApp p (toIfaceTyCon tc) (map toIfaceCoercion cos)
 
 ------------------
--- | Given a 'TyCon',and the args to which it is applied,
--- suppress the args that are implicit
-suppressInvisibles :: (a -> Type) -> DynFlags -> TyCon -> [a] -> [a]
-suppressInvisibles to_type dflags tc xs
-  | gopt Opt_PrintExplicitKinds dflags = xs
-  | otherwise                          = snd $ partitionInvisibles tc to_type xs
-
-----------------
-pprTyList :: TyPrec -> Type -> Type -> SDoc
--- Given a type-level list (t1 ': t2), see if we can print
--- it in list notation [t1, ...].
-pprTyList p ty1 ty2
-  = case gather ty2 of
-      (arg_tys, Nothing) -> char '\'' <> brackets (fsep (punctuate comma
-                                            (map (ppr_type TopPrec) (ty1:arg_tys))))
-      (arg_tys, Just tl) -> maybeParen p FunPrec $
-                            hang (ppr_type FunPrec ty1)
-                               2 (fsep [ colon <+> ppr_type FunPrec ty | ty <- arg_tys ++ [tl]])
-  where
-    gather :: Type -> ([Type], Maybe Type)
-     -- (gather ty) = (tys, Nothing) means ty is a list [t1, .., tn]
-     --             = (tys, Just tl) means ty is of form t1:t2:...tn:tl
-    gather (TyConApp tc tys)
-      | tc `hasKey` consDataConKey
-      , [_kind, ty1,ty2] <- tys
-      , (args, tl) <- gather ty2
-      = (ty1:args, tl)
-      | tc `hasKey` nilDataConKey
-      = ([], Nothing)
-    gather ty = ([], Just ty)
-
-----------------
-pprInfixApp :: TyPrec -> (TyPrec -> a -> SDoc) -> SDoc -> a -> a -> SDoc
-pprInfixApp p pp pp_tc ty1 ty2
-  = maybeParen p TyOpPrec $
-    sep [pp TyOpPrec ty1, pprInfixVar True pp_tc <+> pp TyOpPrec ty2]
 
 pprPrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
-pprPrefixApp p pp_fun pp_tys
-  | null pp_tys = pp_fun
-  | otherwise   = maybeParen p TyConPrec $
-                  hang pp_fun 2 (sep pp_tys)
+pprPrefixApp = pprIfacePrefixApp
+
 ----------------
 pprArrowChain :: TyPrec -> [SDoc] -> SDoc
 -- pprArrowChain p [a,b,c]  generates   a -> b -> c
index df2dfd5..8dcbd10 100644 (file)
@@ -6,9 +6,10 @@ import Data.Data  ( Data )
 data Type
 data TyThing
 data Coercion
-data LeftOrRight
 data UnivCoProvenance
 data TCvSubst
+data TyLit
+data TyBinder
 
 type PredType = Type
 type Kind = Type
index 40e8562..054eb2b 100644 (file)
@@ -1436,7 +1436,7 @@ mkClassTyCon name binders roles rhs clas tc_rep_name
 mkTupleTyCon :: Name
              -> [TyConBinder]
              -> Kind    -- ^ Result kind of the 'TyCon'
-             -> Arity   -- ^ Arity of the tuple
+             -> Arity   -- ^ Arity of the tuple 'TyCon'
              -> DataCon
              -> TupleSort    -- ^ Whether the tuple is boxed or unboxed
              -> AlgTyConFlav
index f615757..86cb5a8 100644 (file)
@@ -175,12 +175,12 @@ module Type (
 
         -- * Pretty-printing
         pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprShortTyThing,
-        pprTvBndr, pprTvBndrs, pprForAll, pprForAllImplicit, pprUserForAll,
+        pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll,
         pprSigmaType, ppSuggestExplicitKinds,
         pprTheta, pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprSourceTyCon,
         TyPrec(..), maybeParen,
-        pprTyVar, pprTcAppTy, pprPrefixApp, pprArrowChain,
+        pprTyVar, pprTyVars, pprTcAppTy, pprPrefixApp, pprArrowChain,
 
         -- * Tidying type related things up for printing
         tidyType,      tidyTypes,
@@ -2178,10 +2178,6 @@ typeLiteralKind l =
     NumTyLit _ -> typeNatKind
     StrTyLit _ -> typeSymbolKind
 
--- | Print a tyvar with its kind
-pprTyVar :: TyVar -> SDoc
-pprTyVar tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv)
-
 {-
 %************************************************************************
 %*                                                                      *
index 61e1ee8..26a4d19 100644 (file)
@@ -750,6 +750,14 @@ instance Binary FastString where
         UserData { ud_get_fs = get_fs } -> get_fs bh
 
 -- Here to avoid loop
+instance Binary LeftOrRight where
+   put_ bh CLeft  = putByte bh 0
+   put_ bh CRight = putByte bh 1
+
+   get bh = do { h <- getByte bh
+               ; case h of
+                   0 -> return CLeft
+                   _ -> return CRight }
 
 instance Binary Fingerprint where
   put_ h (Fingerprint w1 w2) = do put_ h w1; put_ h w2
index 43ffb06..ff1047d 100644 (file)
@@ -17,7 +17,7 @@ T2431.$WRefl =
     T2431.Refl @ a @ a @~ (<a>_N :: (a :: *) GHC.Prim.~# (a :: *))
 
 -- RHS size: {terms: 4, types: 8, coercions: 0}
-absurd :: forall a. Int :~: Bool -> a
+absurd :: forall a. (Int :~: Bool) -> a
 [GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>x]
 absurd = \ (@ a) (x :: Int :~: Bool) -> case x of { }
 
index 963dcbb..8853985 100644 (file)
@@ -2,6 +2,6 @@
 TypeSkolEscape.hs:8:1: error:
     • Quantified type's kind mentions quantified type variable
       (skolem escape)
-           type: forall a1. a1
+           type: forall (a1 :: TYPE v1). a1
         of kind: TYPE v
     • In the type synonym declaration for ‘Bad’
index 5bcbd9e..f8ee42f 100644 (file)
@@ -1,3 +1,3 @@
 first :: Arrow to => b `to` c -> (b, d) `to` (c, d)
   :: Arrow to => to b c -> to (b, d) (c, d)
-first :: b~>c -> (b, d)~>(c, d) :: b ~> c -> (b, d) ~> (c, d)
+first :: b~>c -> (b, d)~>(c, d) :: (b ~> c) -> (b, d) ~> (c, d)
index 3cb103c..9f4e65b 100644 (file)
@@ -1,4 +1,4 @@
 type role Coercible representational representational
-class a ~R# b => Coercible (a :: k0) (b :: k0)
+class Coercible a b => Coercible (a :: k0) (b :: k0)
        -- Defined in ‘GHC.Types’
 coerce :: Coercible a b => a -> b      -- Defined in ‘GHC.Prim’
index df20e67..5369daa 100644 (file)
@@ -65,8 +65,7 @@ AbsBinds [a] []
    Exported types: T8958.$fRepresentationala [InlPrag=[ALWAYS] CONLIKE]
                      :: forall a. Representational a
                    [LclIdX[DFunId],
-                    Unf=DFun: \ (@ a[ssk:2]) ->
-                          T8958.C:Representational TYPE: a[ssk:2]]
+                    Unf=DFun: \ (@ a) -> T8958.C:Representational TYPE: a]
    Binds: $dRepresentational = T8958.C:Representational @ a
    Evidence: [EvBinds{}]}
 AbsBinds [a] []
@@ -74,8 +73,7 @@ AbsBinds [a] []
                wrap: <>]
    Exported types: T8958.$fNominala [InlPrag=[ALWAYS] CONLIKE]
                      :: forall a. Nominal a
-                   [LclIdX[DFunId],
-                    Unf=DFun: \ (@ a[ssk:2]) -> T8958.C:Nominal TYPE: a[ssk:2]]
+                   [LclIdX[DFunId], Unf=DFun: \ (@ a) -> T8958.C:Nominal TYPE: a]
    Binds: $dNominal = T8958.C:Nominal @ a
    Evidence: [EvBinds{}]}
 
index 1733f0a..0796146 100644 (file)
@@ -1,5 +1,5 @@
 
 T10632.hs:4:1: warning: [-Wredundant-constraints]
-    • Redundant constraint: ?file1::String
+    • Redundant constraint: (?file1::String)
     • In the type signature for:
            f :: (?file1::String) => IO ()
index 29ac2d2..3079128 100644 (file)
@@ -1,7 +1,7 @@
 
 ClassOperator.hs:12:3: error:
     • Could not deduce (a ><> b0)
-      from the context: a ><> b
+      from the context: (a ><> b)
         bound by the type signature for:
                    (**>) :: (a ><> b) => a -> a -> ()
         at ClassOperator.hs:12:3-44
@@ -14,7 +14,7 @@ ClassOperator.hs:12:3: error:
 
 ClassOperator.hs:12:3: error:
     • Could not deduce (a ><> b0)
-      from the context: a ><> b
+      from the context: (a ><> b)
         bound by the type signature for:
                    (**<) :: (a ><> b) => a -> a -> ()
         at ClassOperator.hs:12:3-44
@@ -27,7 +27,7 @@ ClassOperator.hs:12:3: error:
 
 ClassOperator.hs:12:3: error:
     • Could not deduce (a ><> b0)
-      from the context: a ><> b
+      from the context: (a ><> b)
         bound by the type signature for:
                    (>**) :: (a ><> b) => a -> a -> ()
         at ClassOperator.hs:12:3-44
@@ -40,7 +40,7 @@ ClassOperator.hs:12:3: error:
 
 ClassOperator.hs:12:3: error:
     • Could not deduce (a ><> b0)
-      from the context: a ><> b
+      from the context: (a ><> b)
         bound by the type signature for:
                    (<**) :: (a ><> b) => a -> a -> ()
         at ClassOperator.hs:12:3-44
index 72c11b0..0ba5bce 100644 (file)
@@ -1,7 +1,7 @@
 
 IPFail.hs:6:18: error:
     • Could not deduce (Num Bool) arising from the literal ‘5’
-      from the context: ?x::Int
+      from the context: (?x::Int)
         bound by the type signature for:
                    f0 :: (?x::Int) => () -> Bool
         at IPFail.hs:5:1-31
index a50fbcf..9772b85 100644 (file)
@@ -2,6 +2,6 @@
 T7019a.hs:11:1: error:
     • Illegal polymorphic type: forall b. Context (Associated a b)
       A constraint must be a monotype
-    • In the context: forall b. Context (Associated a b)
+    • In the context: (forall b. Context (Associated a b))
       While checking the super-classes of class ‘Class’
       In the class declaration for ‘Class’
index 4d6f8d3..99b9c28 100644 (file)
@@ -1,9 +1,9 @@
 
-T7525.hs:5:30:
-    Could not deduce: ?b::Bool
-      arising from a use of implicit parameter ‘?b’
-    from the context: ?a::Bool
-      bound by the implicit-parameter binding for ?a at T7525.hs:5:7-31
-    In the second argument of ‘(&&)’, namely ‘?b’
-    In the expression: ?a && ?b
-    In the expression: let ?a = True in ?a && ?b
+T7525.hs:5:30: error:
+    • Could not deduce: (?b::Bool)
+        arising from a use of implicit parameter ‘?b’
+      from the context: (?a::Bool)
+        bound by the implicit-parameter binding for ?a at T7525.hs:5:7-31
+    • In the second argument of ‘(&&)’, namely ‘?b’
+      In the expression: ?a && ?b
+      In the expression: let ?a = True in ?a && ?b
index 4e4515e..78fdd10 100644 (file)
@@ -1,6 +1,6 @@
 
-T8912.hs:7:10:
-    Illegal implicit parameter ‘?imp::Int’
-    In the context: ?imp::Int
-    While checking an instance declaration
-    In the instance declaration for ‘C [a]’
+T8912.hs:7:10: error:
+    • Illegal implicit parameter ‘?imp::Int’
+    • In the context: (?imp::Int)
+      While checking an instance declaration
+      In the instance declaration for ‘C [a]’
index fe116b5..d2d3214 100644 (file)
@@ -1,6 +1,6 @@
 
-tcfail041.hs:5:1:
-    Illegal implicit parameter ‘?imp::Int’
-    In the context: ?imp::Int
-    While checking the super-classes of class ‘D’
-    In the class declaration for ‘D’
+tcfail041.hs:5:1: error:
+    • Illegal implicit parameter ‘?imp::Int’
+    • In the context: (?imp::Int)
+      While checking the super-classes of class ‘D’
+      In the class declaration for ‘D’
index 7640031..51f77d1 100644 (file)
@@ -1,5 +1,6 @@
 
-tcfail130.hs:10:7:
-    Unbound implicit parameter ?x::Int arising from a use of ‘woggle’
-    In the expression: woggle 3
-    In an equation for ‘foo’: foo = woggle 3
+tcfail130.hs:10:7: error:
+    • Unbound implicit parameter (?x::Int)
+        arising from a use of ‘woggle’
+    • In the expression: woggle 3
+      In an equation for ‘foo’: foo = woggle 3
index 7a5053a..a88cc35 100644 (file)
@@ -1,12 +1,12 @@
 
 tcfail211.hs:5:1: error:
     • Illegal implicit parameter ‘?imp::Int’
-    • In the context: ?imp::Int
+    • In the context: (?imp::Int)
       While checking the super-classes of class ‘D’
       In the class declaration for ‘D’
 
 tcfail211.hs:8:10: error:
     • Illegal implicit parameter ‘?imp::Int’
-    • In the context: ?imp::Int
+    • In the context: (?imp::Int)
       While checking an instance declaration
       In the instance declaration for ‘D Int’
index f6b1652..19fca10 100644 (file)
@@ -1,18 +1,18 @@
 
 tcrun045.hs:11:10: error:
     • Illegal implicit parameter ‘?imp::Int’
-    • In the context: ?imp::Int
+    • In the context: (?imp::Int)
       While checking an instance declaration
       In the instance declaration for ‘C Int’
 
 tcrun045.hs:24:1: error:
     • Illegal implicit parameter ‘?imp::Int’
-    • In the context: ?imp::Int
+    • In the context: (?imp::Int)
       While checking the super-classes of class ‘D’
       In the class declaration for ‘D’
 
 tcrun045.hs:27:10: error:
     • Illegal implicit parameter ‘?imp::Int’
-    • In the context: ?imp::Int
+    • In the context: (?imp::Int)
       While checking an instance declaration
       In the instance declaration for ‘D Int’