ghc-lib-parser 0.20190703 → 0.20190806

raw patch · 133 files changed

+7531/−14542 lines, 133 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Setup.hs +0/−2
• compiler/HsVersions.h +1/−1
• compiler/basicTypes/NameSet.hs +6/−5
• compiler/basicTypes/Var.hs +2/−1
• compiler/basicTypes/VarEnv.hs +7/−4
• compiler/cmm/CmmType.hs +1/−5
• compiler/coreSyn/CoreArity.hs +21/−8
• compiler/coreSyn/CoreFVs.hs +1/−0
• compiler/coreSyn/CoreOpt.hs +38/−4
• compiler/coreSyn/CoreSubst.hs +9/−9
• compiler/coreSyn/CoreSyn.hs +22/−0
• compiler/ghci/ByteCodeTypes.hs +4/−2
• compiler/hsSyn/HsBinds.hs +37/−37
• compiler/hsSyn/HsDecls.hs +107/−103
• compiler/hsSyn/HsExpr.hs +124/−123
• compiler/hsSyn/HsExtension.hs +72/−7
• compiler/hsSyn/HsImpExp.hs +15/−15
• compiler/hsSyn/HsInstances.hs +1/−0
• compiler/hsSyn/HsLit.hs +8/−8
• compiler/hsSyn/HsPat.hs +28/−28
• compiler/hsSyn/HsTypes.hs +130/−85
• compiler/hsSyn/HsUtils.hs +110/−108
• compiler/iface/IfaceType.hs +1/−1
• compiler/iface/ToIface.hs +1/−0
• compiler/iface/ToIface.hs-boot +1/−1
• compiler/main/DynFlags.hs +46/−185
• compiler/main/ErrUtils.hs +95/−0
• compiler/main/HeaderInfo.hs +1/−1
• compiler/main/HscTypes.hs +24/−1
• compiler/main/Packages.hs +144/−2
• compiler/main/Plugins.hs +5/−0
• compiler/parser/RdrHsSyn.hs +175/−113
• compiler/prelude/PrelNames.hs +12/−12
• compiler/prelude/TysPrim.hs +10/−6
• compiler/prelude/TysWiredIn.hs +35/−20
• compiler/prelude/TysWiredIn.hs-boot +7/−4
• compiler/simplStg/RepType.hs +163/−2
• compiler/typecheck/TcRnTypes.hs +45/−13
• compiler/typecheck/TcType.hs +3/−72
• compiler/types/Class.hs +2/−1
• compiler/types/CoAxiom.hs +3/−6
• compiler/types/Coercion.hs +4/−0
• compiler/types/OptCoercion.hs +1/−0
• compiler/types/TyCoFVs.hs +819/−0
• compiler/types/TyCoPpr.hs +308/−0
• compiler/types/TyCoPpr.hs-boot +10/−0
• compiler/types/TyCoRep.hs +1709/−4073
• compiler/types/TyCoRep.hs-boot +0/−4
• compiler/types/TyCoSubst.hs +1029/−0
• compiler/types/TyCoTidy.hs +236/−0
• compiler/types/TyCon.hs +16/−5
• compiler/types/Type.hs +274/−104
• compiler/types/Type.hs-boot +0/−4
• compiler/types/Unify.hs +3/−1
• compiler/utils/Binary.hs +4/−0
• compiler/utils/ListSetOps.hs +11/−2
• compiler/utils/Util.hs +1/−1
• ghc-lib-parser.cabal +15/−8
• ghc-lib/generated/ghcplatform.h +0/−8
• ghc-lib/generated/ghcversion.h +1/−1
• ghc-lib/stage0/compiler/build/Lexer.hs +59/−31
• ghc-lib/stage0/compiler/build/Parser.hs +154/−328
• ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs +21/−0
• ghc-lib/stage1/compiler/build/Config.hs +13/−13
• ghc-lib/stage1/compiler/build/ghc_boot_platform.h +0/−8
• ghc-lib/stage1/compiler/build/primop-data-decl.hs-incl +0/−1
• ghc-lib/stage1/compiler/build/primop-has-side-effects.hs-incl +0/−1
• ghc-lib/stage1/compiler/build/primop-list.hs-incl +0/−1
• ghc-lib/stage1/compiler/build/primop-out-of-line.hs-incl +0/−1
• ghc-lib/stage1/compiler/build/primop-primop-info.hs-incl +0/−1
• ghc-lib/stage1/compiler/build/primop-tag.hs-incl +1203/−1204
• ghc-lib/stage1/lib/platformConstants +1/−1
• ghc-lib/stage1/lib/settings +1/−0
• includes/Cmm.h +0/−946
• includes/CodeGen.Platform.hs +36/−36
• includes/HsFFI.h +0/−141
• includes/Rts.h +0/−325
• includes/RtsAPI.h +0/−487
• includes/Stg.h +0/−599
• includes/rts/Adjustor.h +0/−22
• includes/rts/BlockSignals.h +0/−34
• includes/rts/Bytecodes.h +0/−106
• includes/rts/Config.h +0/−52
• includes/rts/Constants.h +0/−332
• includes/rts/EventLogFormat.h +0/−265
• includes/rts/EventLogWriter.h +0/−40
• includes/rts/FileLock.h +0/−19
• includes/rts/Flags.h +0/−301
• includes/rts/GetTime.h +0/−16
• includes/rts/Globals.h +0/−36
• includes/rts/Hpc.h +0/−34
• includes/rts/IOManager.h +0/−43
• includes/rts/Libdw.h +0/−97
• includes/rts/LibdwPool.h +0/−19
• includes/rts/Linker.h +0/−101
• includes/rts/Main.h +0/−18
• includes/rts/Messages.h +0/−104
• includes/rts/OSThreads.h +0/−258
• includes/rts/Parallel.h +0/−16
• includes/rts/PrimFloat.h +0/−17
• includes/rts/Profiling.h +0/−17
• includes/rts/Signals.h +0/−23
• includes/rts/SpinLock.h +0/−116
• includes/rts/StableName.h +0/−32
• includes/rts/StablePtr.h +0/−35
• includes/rts/StaticPtrTable.h +0/−44
• includes/rts/TTY.h +0/−17
• includes/rts/Threads.h +0/−74
• includes/rts/Ticky.h +0/−32
• includes/rts/Time.h +0/−44
• includes/rts/Timer.h +0/−18
• includes/rts/Types.h +0/−31
• includes/rts/Utils.h +0/−16
• includes/rts/prof/CCS.h +0/−226
• includes/rts/prof/LDV.h +0/−44
• includes/rts/storage/Block.h +0/−341
• includes/rts/storage/ClosureMacros.h +0/−591
• includes/rts/storage/ClosureTypes.h +0/−86
• includes/rts/storage/Closures.h +0/−470
• includes/rts/storage/FunTypes.h +0/−54
• includes/rts/storage/GC.h +0/−248
• includes/rts/storage/Heap.h +0/−18
• includes/rts/storage/InfoTables.h +0/−405
• includes/rts/storage/MBlock.h +0/−32
• includes/rts/storage/TSO.h +0/−261
• libraries/ghc-boot/GHC/Platform.hs +1/−0
• libraries/ghc-boot/GHC/UniqueSubdir.hs +32/−0
• libraries/ghc-heap/GHC/Exts/Heap.hs +11/−0
• libraries/ghc-heap/GHC/Exts/Heap/Closures.hs +10/−0
• libraries/ghci/GHCi/Message.hs +5/−1
• libraries/template-haskell/Language/Haskell/TH.hs +2/−0
• libraries/template-haskell/Language/Haskell/TH/Ppr.hs +4/−1
• libraries/template-haskell/Language/Haskell/TH/Syntax.hs +20/−5

@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain

@@ -12,7 +12,7 @@ /* Useful in the headers that we share with the RTS */ #define COMPILING_GHC 1 -/* Pull in all the platform defines for this build (foo_TARGET_ARCH etc.) */+/* Pull in all the platform defines for this build (foo_HOST_ARCH etc.) */ #include "ghc_boot_platform.h"  /* Pull in the autoconf defines (HAVE_FOO), but don't include

@@ -36,6 +36,7 @@ import GhcPrelude  import Name+import OrdList import UniqSet import Data.List (sortBy) @@ -160,19 +161,19 @@  -- | A number of 'DefUse's in dependency order: earlier 'Defs' scope over later 'Uses' --   In a single (def, use) pair, the defs also scope over the uses-type DefUses = [DefUse]+type DefUses = OrdList DefUse  emptyDUs :: DefUses-emptyDUs = []+emptyDUs = nilOL  usesOnly :: Uses -> DefUses-usesOnly uses = [(Nothing, uses)]+usesOnly uses = unitOL (Nothing, uses)  mkDUs :: [(Defs,Uses)] -> DefUses-mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]+mkDUs pairs = toOL [(Just defs, uses) | (defs,uses) <- pairs]  plusDU :: DefUses -> DefUses -> DefUses-plusDU = (++)+plusDU = appOL  duDefs :: DefUses -> Defs duDefs dus = foldr get emptyNameSet dus

@@ -89,7 +89,8 @@  import GhcPrelude -import {-# SOURCE #-}   TyCoRep( Type, Kind, pprKind )+import {-# SOURCE #-}   TyCoRep( Type, Kind )+import {-# SOURCE #-}   TyCoPpr( pprKind ) import {-# SOURCE #-}   TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolemTv ) import {-# SOURCE #-}   IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails,                                 vanillaIdInfo, pprIdDetails )

@@ -98,10 +98,13 @@ -- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides -- the motivation for this abstraction. data InScopeSet = InScope VarSet {-# UNPACK #-} !Int-        -- We store a VarSet here, but we use this for lookups rather than-        -- just membership tests. Typically the InScopeSet contains the-        -- canonical version of the variable (e.g. with an informative-        -- unfolding), so this lookup is useful.+        -- Note [Lookups in in-scope set]+        -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+        -- We store a VarSet here, but we use this for lookups rather than just+        -- membership tests. Typically the InScopeSet contains the canonical+        -- version of the variable (e.g. with an informative unfolding), so this+        -- lookup is useful (see, for instance, Note [In-scope set as a+        -- substitution]).         --         -- The Int is a kind of hash-value used by uniqAway         -- For example, it might be the size of the set

@@ -6,7 +6,6 @@     , typeWidth, cmmEqType, cmmEqType_ignoring_ptrhood     , isFloatType, isGcPtrType, isBitsType     , isWord32, isWord64, isFloat64, isFloat32-    , isVecCatType      , Width(..)     , widthInBits, widthInBytes, widthInLog, widthFromBytes@@ -134,7 +133,7 @@ cInt dflags = cmmBits (cIntWidth  dflags)  ------------ Predicates -----------------isFloatType, isGcPtrType, isBitsType, isVecCatType :: CmmType -> Bool+isFloatType, isGcPtrType, isBitsType :: CmmType -> Bool isFloatType (CmmType FloatCat    _) = True isFloatType _other                  = False @@ -143,9 +142,6 @@  isBitsType (CmmType BitsCat _) = True isBitsType _                   = False--isVecCatType (CmmType (VecCat _ _) _) = True-isVecCatType _other                   = False  isWord32, isWord64, isFloat32, isFloat64 :: CmmType -> Bool -- isWord64 is true of 64-bit non-floats (both gc-ptrs and otherwise)

@@ -1055,10 +1055,17 @@   where     empty_subst = mkEmptyTCvSubst in_scope +    go :: Arity              -- Number of value args to expand to+       -> TCvSubst -> Type   -- We are really looking at subst(ty)+       -> [EtaInfo]          -- Accumulating parameter+       -> (InScopeSet, [EtaInfo])     go n subst ty eis       -- See Note [exprArity invariant]++       ----------- Done!  No more expansion needed        | n == 0        = (getTCvInScope subst, reverse eis) +       ----------- Forall types  (forall a. ty)        | Just (tcv,ty') <- splitForAllTy_maybe ty        , let (subst', tcv') = Type.substVarBndr subst tcv        = let ((n_subst, n_tcv), n_n)@@ -1069,10 +1076,11 @@                --   lambda \co:ty. e co. In this case we generate a new variable                --   of the coercion type, update the scope, and reduce n by 1.                | isTyVar tcv = ((subst', tcv'), n)-               | otherwise  = (freshEtaId n subst' (varType tcv'), n-1)+               | otherwise   = (freshEtaId n subst' (varType tcv'), n-1)            -- Avoid free vars of the original expression          in go n_n n_subst ty' (EtaVar n_tcv : eis) +       ----------- Function types  (t1 -> t2)        | Just (arg_ty, res_ty) <- splitFunTy_maybe ty        , not (isTypeLevPoly arg_ty)           -- See Note [Levity polymorphism invariants] in CoreSyn@@ -1082,14 +1090,19 @@            -- Avoid free vars of the original expression        = go (n-1) subst' res_ty (EtaVar eta_id' : eis) +       ----------- Newtypes+       -- Given this:+       --      newtype T = MkT ([T] -> Int)+       -- Consider eta-expanding this+       --      eta_expand 1 e T+       -- We want to get+       --      coerce T (\x::[T] -> (coerce ([T]->Int) e) x)        | Just (co, ty') <- topNormaliseNewType_maybe ty-       =        -- Given this:-                --      newtype T = MkT ([T] -> Int)-                -- Consider eta-expanding this-                --      eta_expand 1 e T-                -- We want to get-                --      coerce T (\x::[T] -> (coerce ([T]->Int) e) x)-         go n subst ty' (pushCoercion co eis)+       , let co' = Coercion.substCo subst co+             -- Remember to apply the substitution to co (#16979)+             -- (or we could have applied to ty, but then+             --  we'd have had to zap it for the recursive call)+       = go n subst ty' (pushCoercion co' eis)         | otherwise       -- We have an expression of arity > 0,                          -- but its type isn't a function, or a binder

@@ -72,6 +72,7 @@ import Var import Type import TyCoRep+import TyCoFVs import TyCon import CoAxiom import FamInstEnv

@@ -312,11 +312,17 @@ -- The let might appear there as a result of inlining -- e.g.   let f = let x = e in b --        in f a1 a2--- (#13208)-simple_app env (Let bind body) as+--   (#13208)+-- However, do /not/ do this transformation for join points+--    See Note [simple_app and join points]+simple_app env (Let bind body) args   = case simple_opt_bind env bind of-      (env', Nothing)   -> simple_app env' body as-      (env', Just bind) -> Let bind (simple_app env' body as)+      (env', Nothing)   -> simple_app env' body args+      (env', Just bind')+        | isJoinBind bind' -> finish_app env expr' args+        | otherwise        -> Let bind' (simple_app env' body args)+        where+          expr' = Let bind' (simple_opt_expr env' body)  simple_app env e as   = finish_app env (simple_opt_expr env e) as@@ -494,6 +500,34 @@ the RHS with simple_opt_expr, which does eta-reduction.  Solution: simplify the RHS of a join point by simplifying under the lambdas (which of course should be there).++Note [simple_app and join points]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In general for let-bindings we can do this:+   (let { x = e } in b) a  ==>  let { x = e } in b a++But not for join points!  For two reasons:++- We would need to push the continuation into the RHS:+   (join { j = e } in b) a  ==>  let { j' = e a } in b[j'/j] a+                                      NB ----^^+  and also change the type of j, hence j'.+  That's a bit sophisticated for the very simple optimiser.++- We might end up with something like+    join { j' = e a } in+    (case blah of        )+    (  True  -> j' void# ) a+    (  False -> blah     )+  and now the call to j' doesn't look like a tail call, and+  Lint may reject.  I say "may" because this is /explicitly/+  allowed in the "Compiling without Continuations" paper+  (Section 3, "Managing \Delta").  But GHC currently does not+  allow this slightly-more-flexible form.  See CoreSyn+  Note [Join points are less general than the paper].++The simple thing to do is to disable this transformation+for join points in the simple optimiser -}  ----------------------

@@ -79,9 +79,9 @@ -- -- Some invariants apply to how you use the substitution: ----- 1. Note [The substitution invariant] in TyCoRep+-- 1. Note [The substitution invariant] in TyCoSubst ----- 2. Note [Substitutions apply only once] in TyCoRep+-- 2. Note [Substitutions apply only once] in TyCoSubst data Subst   = Subst InScopeSet  -- Variables in in scope (both Ids and TyVars) /after/                       -- applying the substitution@@ -89,7 +89,7 @@           TvSubstEnv  -- Substitution from TyVars to Types           CvSubstEnv  -- Substitution from CoVars to Coercions -        -- INVARIANT 1: See TyCoRep Note [The substitution invariant]+        -- INVARIANT 1: See TyCoSubst Note [The substitution invariant]         -- This is what lets us deal with name capture properly         -- It's a hard invariant to check...         --@@ -104,7 +104,7 @@ For a core Subst, which binds Ids as well, we make a different choice for Ids than we do for TyVars. -For TyVars, see Note [Extending the TCvSubst] with Type.TvSubstEnv+For TyVars, see Note [Extending the TCvSubst] in TyCoSubst.  For Ids, we have a different invariant         The IdSubstEnv is extended *only* when the Unique on an Id changes@@ -171,7 +171,7 @@ mkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst mkSubst in_scope tvs cvs ids = Subst in_scope ids tvs cvs --- | Find the in-scope set: see TyCoRep Note [The substitution invariant]+-- | Find the in-scope set: see TyCoSubst Note [The substitution invariant] substInScope :: Subst -> InScopeSet substInScope (Subst in_scope _ _ _) = in_scope @@ -181,7 +181,7 @@ zapSubstEnv (Subst in_scope _ _ _) = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv  -- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is--- such that TyCoRep Note [The substitution invariant]+-- such that TyCoSubst Note [The substitution invariant] -- holds after extending the substitution like this extendIdSubst :: Subst -> Id -> CoreExpr -> Subst -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set@@ -198,7 +198,7 @@ -- | Add a substitution for a 'TyVar' to the 'Subst' -- The 'TyVar' *must* be a real TyVar, and not a CoVar -- You must ensure that the in-scope set is such that--- TyCoRep Note [The substitution invariant] holds+-- TyCoSubst Note [The substitution invariant] holds -- after extending the substitution like this. extendTvSubst :: Subst -> TyVar -> Type -> Subst extendTvSubst (Subst in_scope ids tvs cvs) tv ty@@ -214,7 +214,7 @@  -- | Add a substitution from a 'CoVar' to a 'Coercion' to the 'Subst': -- you must ensure that the in-scope set satisfies--- TyCoRep Note [The substitution invariant]+-- TyCoSubst Note [The substitution invariant] -- after extending the substitution like this extendCvSubst :: Subst -> CoVar -> Coercion -> Subst extendCvSubst (Subst in_scope ids tvs cvs) v r@@ -339,7 +339,7 @@  -- | Apply a substitution to an entire 'CoreExpr'. Remember, you may only -- apply the substitution /once/:--- see Note [Substitutions apply only once] in TyCoRep+-- See Note [Substitutions apply only once] in TyCoSubst -- -- Do *not* attempt to short-cut in the case of an empty substitution! -- See Note [Extending the Subst]

@@ -608,6 +608,8 @@      same number of arguments, counting both types and values; we call this the      "join arity" (to distinguish from regular arity, which only counts values). +     See Note [Join points are less general than the paper]+   2. For join arity n, the right-hand side must begin with at least n lambdas.      No ticks, no casts, just lambdas!  C.f. CoreUtils.joinRhsArity. @@ -656,6 +658,26 @@ Core Lint will check these invariants, anticipating that any binder whose OccInfo is marked AlwaysTailCalled will become a join point as soon as the simplifier (or simpleOptPgm) runs.++Note [Join points are less general than the paper]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In the paper "Compiling without continuations", this expression is+perfectly valid:++    join { j = \_ -> e }+    in (case blah of       )+       (  True  -> j void# ) arg+       (  False -> blah    )++assuming 'j' has arity 1.   Here the call to 'j' does not look like a+tail call, but actually everything is fine. See Section 3, "Managing \Delta"+in the paper.++In GHC, however, we adopt a slightly more restrictive subset, in which+join point calls must be tail calls.  I think we /could/ loosen it up, but+in fact the simplifier ensures that we always get tail calls, and it makes+the back end a bit easier I think.  Generally, just less to think about;+nothing deeper than that.  Note [The type of a join point] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -35,6 +35,7 @@ import Data.ByteString (ByteString) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap+import Data.Maybe (catMaybes) import GHC.Exts.Heap import GHC.Stack.CCS @@ -110,14 +111,15 @@ -- | Information about a breakpoint that we know at code-generation time data CgBreakInfo    = CgBreakInfo-   { cgb_vars   :: [(Id,Word16)]+   { cgb_vars   :: [Maybe (Id,Word16)]    , cgb_resty  :: Type    }+-- See Note [Syncing breakpoint info] in compiler/main/InteractiveEval.hs  -- Not a real NFData instance because we can't rnf Id or Type seqCgBreakInfo :: CgBreakInfo -> () seqCgBreakInfo CgBreakInfo{..} =-  rnf (map snd cgb_vars) `seq`+  rnf (map snd (catMaybes (cgb_vars))) `seq`   seqType cgb_resty  instance Outputable UnlinkedBCO where

@@ -94,10 +94,10 @@   | XHsLocalBindsLR         (XXHsLocalBindsLR idL idR) -type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExt-type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExt-type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt-type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt+type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExtField+type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExtField+type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField+type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon  type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR) @@ -135,7 +135,7 @@       [(RecFlag, LHsBinds idL)]       [LSig GhcRn] -type instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExt+type instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExtField type instance XXValBindsLR (GhcPass pL) (GhcPass pR)             = NHsValBindsLR (GhcPass pL) @@ -319,18 +319,18 @@      pat_rhs_ty :: Type  -- ^ Type of the GRHSs      } deriving Data -type instance XFunBind    (GhcPass pL) GhcPs = NoExt+type instance XFunBind    (GhcPass pL) GhcPs = NoExtField type instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables type instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables -type instance XPatBind    GhcPs (GhcPass pR) = NoExt+type instance XPatBind    GhcPs (GhcPass pR) = NoExtField type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables type instance XPatBind    GhcTc (GhcPass pR) = NPatBindTc -type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExt-type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExt-type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt-type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt+type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExtField+type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExtField+type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField+type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon           -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]@@ -356,8 +356,8 @@         }    | XABExport (XXABExport p) -type instance XABE       (GhcPass p) = NoExt-type instance XXABExport (GhcPass p) = NoExt+type instance XABE       (GhcPass p) = NoExtField+type instance XXABExport (GhcPass p) = NoExtCon   -- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',@@ -379,11 +379,11 @@      }    | XPatSynBind (XXPatSynBind idL idR) -type instance XPSB         (GhcPass idL) GhcPs = NoExt+type instance XPSB         (GhcPass idL) GhcPs = NoExtField type instance XPSB         (GhcPass idL) GhcRn = NameSet type instance XPSB         (GhcPass idL) GhcTc = NameSet -type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt+type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon  {- Note [AbsBinds]@@ -682,7 +682,7 @@  ------------ emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)-emptyLocalBinds = EmptyLocalBinds noExt+emptyLocalBinds = EmptyLocalBinds noExtField  -- AZ:These functions do not seem to be used at all? isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool@@ -706,7 +706,7 @@ isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs  emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)-emptyValBindsIn  = ValBinds noExt emptyBag []+emptyValBindsIn  = ValBinds noExtField emptyBag [] emptyValBindsOut = XValBindsLR (NValBinds [] [])  emptyLHsBinds :: LHsBindsLR idL idR@@ -719,7 +719,7 @@ plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)                -> HsValBinds(GhcPass a) plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)-  = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2)+  = ValBinds noExtField (ds1 `unionBags` ds2) (sigs1 ++ sigs2) plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))                (XValBindsLR (NValBinds ds2 sigs2))   = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))@@ -824,13 +824,13 @@         --                 -- uses of the implicit parameters   | XHsIPBinds (XXHsIPBinds id) -type instance XIPBinds       GhcPs = NoExt-type instance XIPBinds       GhcRn = NoExt+type instance XIPBinds       GhcPs = NoExtField+type instance XIPBinds       GhcRn = NoExtField type instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the                                                -- implicit parameters  -type instance XXHsIPBinds    (GhcPass p) = NoExt+type instance XXHsIPBinds    (GhcPass p) = NoExtCon  isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool isEmptyIPBindsPR (IPBinds _ is) = null is@@ -864,8 +864,8 @@         (LHsExpr id)   | XIPBind (XXIPBind id) -type instance XCIPBind    (GhcPass p) = NoExt-type instance XXIPBind    (GhcPass p) = NoExt+type instance XCIPBind    (GhcPass p) = NoExtField+type instance XXIPBind    (GhcPass p) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (HsIPBinds p) where@@ -1047,18 +1047,18 @@                      (Maybe (Located (IdP pass)))   | XSig (XXSig pass) -type instance XTypeSig          (GhcPass p) = NoExt-type instance XPatSynSig        (GhcPass p) = NoExt-type instance XClassOpSig       (GhcPass p) = NoExt-type instance XIdSig            (GhcPass p) = NoExt-type instance XFixSig           (GhcPass p) = NoExt-type instance XInlineSig        (GhcPass p) = NoExt-type instance XSpecSig          (GhcPass p) = NoExt-type instance XSpecInstSig      (GhcPass p) = NoExt-type instance XMinimalSig       (GhcPass p) = NoExt-type instance XSCCFunSig        (GhcPass p) = NoExt-type instance XCompleteMatchSig (GhcPass p) = NoExt-type instance XXSig             (GhcPass p) = NoExt+type instance XTypeSig          (GhcPass p) = NoExtField+type instance XPatSynSig        (GhcPass p) = NoExtField+type instance XClassOpSig       (GhcPass p) = NoExtField+type instance XIdSig            (GhcPass p) = NoExtField+type instance XFixSig           (GhcPass p) = NoExtField+type instance XInlineSig        (GhcPass p) = NoExtField+type instance XSpecSig          (GhcPass p) = NoExtField+type instance XSpecInstSig      (GhcPass p) = NoExtField+type instance XMinimalSig       (GhcPass p) = NoExtField+type instance XSCCFunSig        (GhcPass p) = NoExtField+type instance XCompleteMatchSig (GhcPass p) = NoExtField+type instance XXSig             (GhcPass p) = NoExtCon  -- | Located Fixity Signature type LFixitySig pass = Located (FixitySig pass)@@ -1067,8 +1067,8 @@ data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity                     | XFixitySig (XXFixitySig pass) -type instance XFixitySig  (GhcPass p) = NoExt-type instance XXFixitySig (GhcPass p) = NoExt+type instance XFixitySig  (GhcPass p) = NoExtField+type instance XXFixitySig (GhcPass p) = NoExtCon  -- | Type checker Specialisation Pragmas --

@@ -23,7 +23,7 @@    -- ** Class or type declarations   TyClDecl(..), LTyClDecl, DataDeclRn(..),-  TyClGroup(..), mkTyClGroup, emptyTyClGroup,+  TyClGroup(..),   tyClGroupTyClDecls, tyClGroupInstDecls, tyClGroupRoleDecls,   isClassDecl, isDataDecl, isSynDecl, tcdName,   isFamilyDecl, isTypeFamilyDecl, isDataFamilyDecl,@@ -47,7 +47,8 @@   -- ** Standalone deriving declarations   DerivDecl(..), LDerivDecl,   -- ** Deriving strategies-  DerivStrategy(..), LDerivStrategy, derivStrategyName,+  DerivStrategy(..), LDerivStrategy,+  derivStrategyName, foldDerivStrategy, mapDerivStrategy,   -- ** @RULE@ declarations   LRuleDecls,RuleDecls(..),RuleDecl(..),LRuleDecl,HsRuleRn(..),   RuleBndr(..),LRuleBndr,@@ -146,20 +147,20 @@   | RoleAnnotD (XRoleAnnotD p) (RoleAnnotDecl p) -- ^Role annotation declaration   | XHsDecl    (XXHsDecl p) -type instance XTyClD      (GhcPass _) = NoExt-type instance XInstD      (GhcPass _) = NoExt-type instance XDerivD     (GhcPass _) = NoExt-type instance XValD       (GhcPass _) = NoExt-type instance XSigD       (GhcPass _) = NoExt-type instance XDefD       (GhcPass _) = NoExt-type instance XForD       (GhcPass _) = NoExt-type instance XWarningD   (GhcPass _) = NoExt-type instance XAnnD       (GhcPass _) = NoExt-type instance XRuleD      (GhcPass _) = NoExt-type instance XSpliceD    (GhcPass _) = NoExt-type instance XDocD       (GhcPass _) = NoExt-type instance XRoleAnnotD (GhcPass _) = NoExt-type instance XXHsDecl    (GhcPass _) = NoExt+type instance XTyClD      (GhcPass _) = NoExtField+type instance XInstD      (GhcPass _) = NoExtField+type instance XDerivD     (GhcPass _) = NoExtField+type instance XValD       (GhcPass _) = NoExtField+type instance XSigD       (GhcPass _) = NoExtField+type instance XDefD       (GhcPass _) = NoExtField+type instance XForD       (GhcPass _) = NoExtField+type instance XWarningD   (GhcPass _) = NoExtField+type instance XAnnD       (GhcPass _) = NoExtField+type instance XRuleD      (GhcPass _) = NoExtField+type instance XSpliceD    (GhcPass _) = NoExtField+type instance XDocD       (GhcPass _) = NoExtField+type instance XRoleAnnotD (GhcPass _) = NoExtField+type instance XXHsDecl    (GhcPass _) = NoExtCon  -- NB: all top-level fixity decls are contained EITHER -- EITHER SigDs@@ -206,8 +207,8 @@     }   | XHsGroup (XXHsGroup p) -type instance XCHsGroup (GhcPass _) = NoExt-type instance XXHsGroup (GhcPass _) = NoExt+type instance XCHsGroup (GhcPass _) = NoExtField+type instance XXHsGroup (GhcPass _) = NoExtCon   emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup (GhcPass p)@@ -217,7 +218,7 @@ hsGroupInstDecls :: HsGroup id -> [LInstDecl id] hsGroupInstDecls = (=<<) group_instds . hs_tyclds -emptyGroup = HsGroup { hs_ext = noExt,+emptyGroup = HsGroup { hs_ext = noExtField,                        hs_tyclds = [],                        hs_derivds = [],                        hs_fixds = [], hs_defds = [], hs_annds = [],@@ -255,7 +256,7 @@         hs_docs   = docs2 }   =     HsGroup {-        hs_ext    = noExt,+        hs_ext    = noExtField,         hs_valds  = val_groups1 `plusHsValBinds` val_groups2,         hs_splcds = spliceds1 ++ spliceds2,         hs_tyclds = tyclds1 ++ tyclds2,@@ -330,8 +331,8 @@         SpliceExplicitFlag   | XSpliceDecl (XXSpliceDecl p) -type instance XSpliceDecl      (GhcPass _) = NoExt-type instance XXSpliceDecl     (GhcPass _) = NoExt+type instance XSpliceDecl      (GhcPass _) = NoExtField+type instance XXSpliceDecl     (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (SpliceDecl p) where@@ -576,21 +577,21 @@      Note [Family instance declaration binders] -} -type instance XFamDecl      (GhcPass _) = NoExt+type instance XFamDecl      (GhcPass _) = NoExtField -type instance XSynDecl      GhcPs = NoExt+type instance XSynDecl      GhcPs = NoExtField type instance XSynDecl      GhcRn = NameSet -- FVs type instance XSynDecl      GhcTc = NameSet -- FVs -type instance XDataDecl     GhcPs = NoExt+type instance XDataDecl     GhcPs = NoExtField type instance XDataDecl     GhcRn = DataDeclRn type instance XDataDecl     GhcTc = DataDeclRn -type instance XClassDecl    GhcPs = NoExt+type instance XClassDecl    GhcPs = NoExtField type instance XClassDecl    GhcRn = NameSet -- FVs type instance XClassDecl    GhcTc = NameSet -- FVs -type instance XXTyClDecl    (GhcPass _) = NoExt+type instance XXTyClDecl    (GhcPass _) = NoExtCon  -- Simple classifiers for TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -641,17 +642,17 @@  -- Dealing with names -tyFamInstDeclName :: TyFamInstDecl pass -> (IdP pass)+tyFamInstDeclName :: TyFamInstDecl (GhcPass p) -> IdP (GhcPass p) tyFamInstDeclName = unLoc . tyFamInstDeclLName -tyFamInstDeclLName :: TyFamInstDecl pass -> Located (IdP pass)+tyFamInstDeclLName :: TyFamInstDecl (GhcPass p) -> Located (IdP (GhcPass p)) tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =                      (HsIB { hsib_body = FamEqn { feqn_tycon = ln }}) })   = ln-tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn _)))-  = panic "tyFamInstDeclLName"-tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs _))-  = panic "tyFamInstDeclLName"+tyFamInstDeclLName (TyFamInstDecl (HsIB _ (XFamEqn nec)))+  = noExtCon nec+tyFamInstDeclLName (TyFamInstDecl (XHsImplicitBndrs nec))+  = noExtCon nec  tyClDeclLName :: TyClDecl pass -> Located (IdP pass) tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln@@ -699,7 +700,7 @@       _              -> False hsDeclHasCusk _cusks_enabled@True (DataDecl { tcdDExt = DataDeclRn { tcdDataCusk = cusk }}) = cusk hsDeclHasCusk _cusks_enabled@True (ClassDecl { tcdTyVars = tyvars }) = hsTvbAllKinded tyvars-hsDeclHasCusk _ (XTyClDecl _) = panic "hsDeclHasCusk"+hsDeclHasCusk _ (XTyClDecl nec) = noExtCon nec  -- Pretty-printing TyClDecl -- ~~~~~~~~~~~~~~~~~~~~~~~~@@ -912,13 +913,10 @@               , group_instds :: [LInstDecl pass] }   | XTyClGroup (XXTyClGroup pass) -type instance XCTyClGroup (GhcPass _) = NoExt-type instance XXTyClGroup (GhcPass _) = NoExt+type instance XCTyClGroup (GhcPass _) = NoExtField+type instance XXTyClGroup (GhcPass _) = NoExtCon  -emptyTyClGroup :: TyClGroup (GhcPass p)-emptyTyClGroup = TyClGroup noExt [] [] []- tyClGroupTyClDecls :: [TyClGroup pass] -> [LTyClDecl pass] tyClGroupTyClDecls = concatMap group_tyclds @@ -928,17 +926,8 @@ tyClGroupRoleDecls :: [TyClGroup pass] -> [LRoleAnnotDecl pass] tyClGroupRoleDecls = concatMap group_roles -mkTyClGroup :: [LTyClDecl (GhcPass p)] -> [LInstDecl (GhcPass p)]-            -> TyClGroup (GhcPass p)-mkTyClGroup decls instds = TyClGroup-  { group_ext = noExt-  , group_tyclds = decls-  , group_roles = []-  , group_instds = instds-  }  - {- ********************************************************************* *                                                                      *                Data and type family declarations@@ -1033,10 +1022,10 @@    -- For details on above see note [Api annotations] in ApiAnnotation -type instance XNoSig            (GhcPass _) = NoExt-type instance XCKindSig         (GhcPass _) = NoExt-type instance XTyVarSig         (GhcPass _) = NoExt-type instance XXFamilyResultSig (GhcPass _) = NoExt+type instance XNoSig            (GhcPass _) = NoExtField+type instance XCKindSig         (GhcPass _) = NoExtField+type instance XTyVarSig         (GhcPass _) = NoExtField+type instance XXFamilyResultSig (GhcPass _) = NoExtCon   -- | Located type Family Declaration@@ -1063,8 +1052,8 @@    -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCFamilyDecl    (GhcPass _) = NoExt-type instance XXFamilyDecl    (GhcPass _) = NoExt+type instance XCFamilyDecl    (GhcPass _) = NoExtField+type instance XXFamilyDecl    (GhcPass _) = NoExtCon   -- | Located Injectivity Annotation@@ -1097,7 +1086,7 @@ famDeclHasCusk :: Bool -- ^ True <=> the -XCUSKs extension is enabled                -> Bool -- ^ True <=> this is an associated type family,                        --            and the parent class has /no/ CUSK-               -> FamilyDecl pass+               -> FamilyDecl (GhcPass pass)                -> Bool famDeclHasCusk _cusks_enabled@False _ _ = False famDeclHasCusk _cusks_enabled@True assoc_with_no_cusk@@ -1111,7 +1100,7 @@             -- Un-associated open type/data families have CUSKs             -- Associated type families have CUSKs iff the parent class does -famDeclHasCusk _ _ (XFamilyDecl {}) = panic "famDeclHasCusk"+famDeclHasCusk _ _ (XFamilyDecl nec) = noExtCon nec  -- | Does this family declaration have user-supplied return kind signature? hasReturnKindSignature :: FamilyResultSig a -> Bool@@ -1120,7 +1109,7 @@ hasReturnKindSignature _                                = True  -- | Maybe return name of the result type variable-resultVariableName :: FamilyResultSig a -> Maybe (IdP a)+resultVariableName :: FamilyResultSig (GhcPass a) -> Maybe (IdP (GhcPass a)) resultVariableName (TyVarSig _ sig) = Just $ hsLTyVarName sig resultVariableName _                = Nothing @@ -1213,8 +1202,8 @@    }   | XHsDataDefn (XXHsDataDefn pass) -type instance XCHsDataDefn    (GhcPass _) = NoExt-type instance XXHsDataDefn    (GhcPass _) = NoExt+type instance XCHsDataDefn    (GhcPass _) = NoExtField+type instance XXHsDataDefn    (GhcPass _) = NoExtCon  -- | Haskell Deriving clause type HsDeriving pass = Located [LHsDerivingClause pass]@@ -1253,8 +1242,8 @@     }   | XHsDerivingClause (XXHsDerivingClause pass) -type instance XCHsDerivingClause    (GhcPass _) = NoExt-type instance XXHsDerivingClause    (GhcPass _) = NoExt+type instance XCHsDerivingClause    (GhcPass _) = NoExtField+type instance XXHsDerivingClause    (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (HsDerivingClause p) where@@ -1363,9 +1352,9 @@       }   | XConDecl (XXConDecl pass) -type instance XConDeclGADT (GhcPass _) = NoExt-type instance XConDeclH98  (GhcPass _) = NoExt-type instance XXConDecl    (GhcPass _) = NoExt+type instance XConDeclGADT (GhcPass _) = NoExtField+type instance XConDeclH98  (GhcPass _) = NoExtField+type instance XXConDecl    (GhcPass _) = NoExtCon  {- Note [GADT abstract syntax] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1408,10 +1397,10 @@ type HsConDeclDetails pass    = HsConDetails (LBangType pass) (Located [LConDeclField pass]) -getConNames :: ConDecl pass -> [Located (IdP pass)]+getConNames :: ConDecl (GhcPass p) -> [Located (IdP (GhcPass p))] getConNames ConDeclH98  {con_name  = name}  = [name] getConNames ConDeclGADT {con_names = names} = names-getConNames XConDecl {} = panic "getConNames"+getConNames (XConDecl nec) = noExtCon nec  getConArgs :: ConDecl pass -> HsConDeclDetails pass getConArgs d = con_args d@@ -1648,8 +1637,8 @@      -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCFamEqn    (GhcPass _) r = NoExt-type instance XXFamEqn    (GhcPass _) r = NoExt+type instance XCFamEqn    (GhcPass _) r = NoExtField+type instance XXFamEqn    (GhcPass _) r = NoExtCon  ----------------- Class instances ------------- @@ -1681,8 +1670,8 @@     -- For details on above see note [Api annotations] in ApiAnnotation   | XClsInstDecl (XXClsInstDecl pass) -type instance XCClsInstDecl    (GhcPass _) = NoExt-type instance XXClsInstDecl    (GhcPass _) = NoExt+type instance XCClsInstDecl    (GhcPass _) = NoExtField+type instance XXClsInstDecl    (GhcPass _) = NoExtCon  ----------------- Instances of all kinds ------------- @@ -1702,10 +1691,10 @@       , tfid_inst :: TyFamInstDecl pass }   | XInstDecl (XXInstDecl pass) -type instance XClsInstD     (GhcPass _) = NoExt-type instance XDataFamInstD (GhcPass _) = NoExt-type instance XTyFamInstD   (GhcPass _) = NoExt-type instance XXInstDecl    (GhcPass _) = NoExt+type instance XClsInstD     (GhcPass _) = NoExtField+type instance XDataFamInstD (GhcPass _) = NoExtField+type instance XTyFamInstD   (GhcPass _) = NoExtField+type instance XXInstDecl    (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (TyFamInstDecl p) where@@ -1841,7 +1830,7 @@  -- Extract the declarations of associated data types from an instance -instDeclDataFamInsts :: [LInstDecl pass] -> [DataFamInstDecl pass]+instDeclDataFamInsts :: [LInstDecl (GhcPass p)] -> [DataFamInstDecl (GhcPass p)] instDeclDataFamInsts inst_decls   = concatMap do_one inst_decls   where@@ -1849,8 +1838,8 @@       = map unLoc fam_insts     do_one (L _ (DataFamInstD { dfid_inst = fam_inst }))      = [fam_inst]     do_one (L _ (TyFamInstD {}))                              = []-    do_one (L _ (ClsInstD _ (XClsInstDecl _))) = panic "instDeclDataFamInsts"-    do_one (L _ (XInstDecl _))                 = panic "instDeclDataFamInsts"+    do_one (L _ (ClsInstD _ (XClsInstDecl nec))) = noExtCon nec+    do_one (L _ (XInstDecl nec))                 = noExtCon nec  {- ************************************************************************@@ -1889,8 +1878,8 @@         }   | XDerivDecl (XXDerivDecl pass) -type instance XCDerivDecl    (GhcPass _) = NoExt-type instance XXDerivDecl    (GhcPass _) = NoExt+type instance XCDerivDecl    (GhcPass _) = NoExtField+type instance XXDerivDecl    (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (DerivDecl p) where@@ -1948,6 +1937,21 @@     go NewtypeStrategy  = "newtype"     go (ViaStrategy {}) = "via" +-- | Eliminate a 'DerivStrategy'.+foldDerivStrategy :: (p ~ GhcPass pass)+                  => r -> (XViaStrategy p -> r) -> DerivStrategy p -> r+foldDerivStrategy other _   StockStrategy    = other+foldDerivStrategy other _   AnyclassStrategy = other+foldDerivStrategy other _   NewtypeStrategy  = other+foldDerivStrategy _     via (ViaStrategy t)  = via t++-- | Map over the @via@ type if dealing with 'ViaStrategy'. Otherwise,+-- return the 'DerivStrategy' unchanged.+mapDerivStrategy :: (p ~ GhcPass pass)+                 => (XViaStrategy p -> XViaStrategy p)+                 -> DerivStrategy p -> DerivStrategy p+mapDerivStrategy f ds = foldDerivStrategy ds (ViaStrategy . f) ds+ {- ************************************************************************ *                                                                      *@@ -1972,8 +1976,8 @@         -- For details on above see note [Api annotations] in ApiAnnotation   | XDefaultDecl (XXDefaultDecl pass) -type instance XCDefaultDecl    (GhcPass _) = NoExt-type instance XXDefaultDecl    (GhcPass _) = NoExt+type instance XCDefaultDecl    (GhcPass _) = NoExtField+type instance XXDefaultDecl    (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (DefaultDecl p) where@@ -2028,15 +2032,15 @@     such as Int and IO that we know how to make foreign calls with. -} -type instance XForeignImport   GhcPs = NoExt-type instance XForeignImport   GhcRn = NoExt+type instance XForeignImport   GhcPs = NoExtField+type instance XForeignImport   GhcRn = NoExtField type instance XForeignImport   GhcTc = Coercion -type instance XForeignExport   GhcPs = NoExt-type instance XForeignExport   GhcRn = NoExt+type instance XForeignExport   GhcPs = NoExtField+type instance XForeignExport   GhcRn = NoExtField type instance XForeignExport   GhcTc = Coercion -type instance XXForeignDecl    (GhcPass _) = NoExt+type instance XXForeignDecl    (GhcPass _) = NoExtCon  -- Specification Of an imported external entity in dependence on the calling -- convention@@ -2143,8 +2147,8 @@                               , rds_rules :: [LRuleDecl pass] }   | XRuleDecls (XXRuleDecls pass) -type instance XCRuleDecls    (GhcPass _) = NoExt-type instance XXRuleDecls    (GhcPass _) = NoExt+type instance XCRuleDecls    (GhcPass _) = NoExtField+type instance XXRuleDecls    (GhcPass _) = NoExtCon  -- | Located Rule Declaration type LRuleDecl pass = Located (RuleDecl pass)@@ -2177,11 +2181,11 @@ data HsRuleRn = HsRuleRn NameSet NameSet -- Free-vars from the LHS and RHS   deriving Data -type instance XHsRule       GhcPs = NoExt+type instance XHsRule       GhcPs = NoExtField type instance XHsRule       GhcRn = HsRuleRn type instance XHsRule       GhcTc = HsRuleRn -type instance XXRuleDecl    (GhcPass _) = NoExt+type instance XXRuleDecl    (GhcPass _) = NoExtCon  flattenRuleDecls :: [LRuleDecls pass] -> [LRuleDecl pass] flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls@@ -2200,9 +2204,9 @@          -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCRuleBndr    (GhcPass _) = NoExt-type instance XRuleBndrSig  (GhcPass _) = NoExt-type instance XXRuleBndr    (GhcPass _) = NoExt+type instance XCRuleBndr    (GhcPass _) = NoExtField+type instance XRuleBndrSig  (GhcPass _) = NoExtField+type instance XXRuleBndr    (GhcPass _) = NoExtCon  collectRuleBndrSigTys :: [RuleBndr pass] -> [LHsSigWcType pass] collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ _ ty <- bndrs]@@ -2290,8 +2294,8 @@                                }   | XWarnDecls (XXWarnDecls pass) -type instance XWarnings      (GhcPass _) = NoExt-type instance XXWarnDecls    (GhcPass _) = NoExt+type instance XWarnings      (GhcPass _) = NoExtField+type instance XXWarnDecls    (GhcPass _) = NoExtCon  -- | Located Warning pragma Declaration type LWarnDecl pass = Located (WarnDecl pass)@@ -2300,8 +2304,8 @@ data WarnDecl pass = Warning (XWarning pass) [Located (IdP pass)] WarningTxt                    | XWarnDecl (XXWarnDecl pass) -type instance XWarning      (GhcPass _) = NoExt-type instance XXWarnDecl    (GhcPass _) = NoExt+type instance XWarning      (GhcPass _) = NoExtField+type instance XXWarnDecl    (GhcPass _) = NoExtCon   instance (p ~ GhcPass pass,OutputableBndr (IdP p))@@ -2342,8 +2346,8 @@       -- For details on above see note [Api annotations] in ApiAnnotation   | XAnnDecl (XXAnnDecl pass) -type instance XHsAnnotation (GhcPass _) = NoExt-type instance XXAnnDecl     (GhcPass _) = NoExt+type instance XHsAnnotation (GhcPass _) = NoExtField+type instance XXAnnDecl     (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (AnnDecl p) where     ppr (HsAnnotation _ _ provenance expr)@@ -2395,8 +2399,8 @@       -- For details on above see note [Api annotations] in ApiAnnotation   | XRoleAnnotDecl (XXRoleAnnotDecl pass) -type instance XCRoleAnnotDecl (GhcPass _) = NoExt-type instance XXRoleAnnotDecl (GhcPass _) = NoExt+type instance XCRoleAnnotDecl (GhcPass _) = NoExtField+type instance XXRoleAnnotDecl (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndr (IdP p))        => Outputable (RoleAnnotDecl p) where@@ -2408,6 +2412,6 @@       pp_role (Just r) = ppr r   ppr (XRoleAnnotDecl x) = ppr x -roleAnnotDeclName :: RoleAnnotDecl pass -> (IdP pass)+roleAnnotDeclName :: RoleAnnotDecl (GhcPass p) -> IdP (GhcPass p) roleAnnotDeclName (RoleAnnotDecl _ (L _ name) _) = name-roleAnnotDeclName (XRoleAnnotDecl _) = panic "roleAnnotDeclName"+roleAnnotDeclName (XRoleAnnotDecl nec) = noExtCon nec

@@ -110,13 +110,14 @@ -- | This is used for rebindable-syntax pieces that are too polymorphic -- for tcSyntaxOp (trS_fmap and the mzip in ParStmt) noExpr :: HsExpr (GhcPass p)-noExpr = HsLit noExt (HsString (SourceText  "noExpr") (fsLit "noExpr"))+noExpr = HsLit noExtField (HsString (SourceText  "noExpr") (fsLit "noExpr"))  noSyntaxExpr :: SyntaxExpr (GhcPass p)                               -- Before renaming, and sometimes after,                               -- (if the syntax slot makes no sense)-noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExt (HsString NoSourceText-                                                        (fsLit "noSyntaxExpr"))+noSyntaxExpr = SyntaxExpr { syn_expr      = HsLit noExtField+                                                  (HsString NoSourceText+                                                  (fsLit "noSyntaxExpr"))                           , syn_arg_wraps = []                           , syn_res_wrap  = WpHole } @@ -129,7 +130,7 @@ -- | Make a 'SyntaxExpr Name' (the "rn" is because this is used in the -- renamer), missing its HsWrappers. mkRnSyntaxExpr :: Name -> SyntaxExpr GhcRn-mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExt $ noLoc name+mkRnSyntaxExpr name = mkSyntaxExpr $ HsVar noExtField $ noLoc name   -- don't care about filling in syn_arg_wraps because we're clearly   -- not past the typechecker @@ -659,84 +660,84 @@  -- --------------------------------------------------------------------- -type instance XVar           (GhcPass _) = NoExt-type instance XUnboundVar    (GhcPass _) = NoExt-type instance XConLikeOut    (GhcPass _) = NoExt-type instance XRecFld        (GhcPass _) = NoExt-type instance XOverLabel     (GhcPass _) = NoExt-type instance XIPVar         (GhcPass _) = NoExt-type instance XOverLitE      (GhcPass _) = NoExt-type instance XLitE          (GhcPass _) = NoExt-type instance XLam           (GhcPass _) = NoExt-type instance XLamCase       (GhcPass _) = NoExt-type instance XApp           (GhcPass _) = NoExt+type instance XVar           (GhcPass _) = NoExtField+type instance XUnboundVar    (GhcPass _) = NoExtField+type instance XConLikeOut    (GhcPass _) = NoExtField+type instance XRecFld        (GhcPass _) = NoExtField+type instance XOverLabel     (GhcPass _) = NoExtField+type instance XIPVar         (GhcPass _) = NoExtField+type instance XOverLitE      (GhcPass _) = NoExtField+type instance XLitE          (GhcPass _) = NoExtField+type instance XLam           (GhcPass _) = NoExtField+type instance XLamCase       (GhcPass _) = NoExtField+type instance XApp           (GhcPass _) = NoExtField -type instance XAppTypeE      (GhcPass _) = NoExt+type instance XAppTypeE      (GhcPass _) = NoExtField -type instance XOpApp         GhcPs = NoExt+type instance XOpApp         GhcPs = NoExtField type instance XOpApp         GhcRn = Fixity type instance XOpApp         GhcTc = Fixity -type instance XNegApp        (GhcPass _) = NoExt-type instance XPar           (GhcPass _) = NoExt-type instance XSectionL      (GhcPass _) = NoExt-type instance XSectionR      (GhcPass _) = NoExt-type instance XExplicitTuple (GhcPass _) = NoExt+type instance XNegApp        (GhcPass _) = NoExtField+type instance XPar           (GhcPass _) = NoExtField+type instance XSectionL      (GhcPass _) = NoExtField+type instance XSectionR      (GhcPass _) = NoExtField+type instance XExplicitTuple (GhcPass _) = NoExtField -type instance XExplicitSum   GhcPs = NoExt-type instance XExplicitSum   GhcRn = NoExt+type instance XExplicitSum   GhcPs = NoExtField+type instance XExplicitSum   GhcRn = NoExtField type instance XExplicitSum   GhcTc = [Type] -type instance XCase          (GhcPass _) = NoExt-type instance XIf            (GhcPass _) = NoExt+type instance XCase          (GhcPass _) = NoExtField+type instance XIf            (GhcPass _) = NoExtField -type instance XMultiIf       GhcPs = NoExt-type instance XMultiIf       GhcRn = NoExt+type instance XMultiIf       GhcPs = NoExtField+type instance XMultiIf       GhcRn = NoExtField type instance XMultiIf       GhcTc = Type -type instance XLet           (GhcPass _) = NoExt+type instance XLet           (GhcPass _) = NoExtField -type instance XDo            GhcPs = NoExt-type instance XDo            GhcRn = NoExt+type instance XDo            GhcPs = NoExtField+type instance XDo            GhcRn = NoExtField type instance XDo            GhcTc = Type -type instance XExplicitList  GhcPs = NoExt-type instance XExplicitList  GhcRn = NoExt+type instance XExplicitList  GhcPs = NoExtField+type instance XExplicitList  GhcRn = NoExtField type instance XExplicitList  GhcTc = Type -type instance XRecordCon     GhcPs = NoExt-type instance XRecordCon     GhcRn = NoExt+type instance XRecordCon     GhcPs = NoExtField+type instance XRecordCon     GhcRn = NoExtField type instance XRecordCon     GhcTc = RecordConTc -type instance XRecordUpd     GhcPs = NoExt-type instance XRecordUpd     GhcRn = NoExt+type instance XRecordUpd     GhcPs = NoExtField+type instance XRecordUpd     GhcRn = NoExtField type instance XRecordUpd     GhcTc = RecordUpdTc -type instance XExprWithTySig (GhcPass _) = NoExt+type instance XExprWithTySig (GhcPass _) = NoExtField -type instance XArithSeq      GhcPs = NoExt-type instance XArithSeq      GhcRn = NoExt+type instance XArithSeq      GhcPs = NoExtField+type instance XArithSeq      GhcRn = NoExtField type instance XArithSeq      GhcTc = PostTcExpr -type instance XSCC           (GhcPass _) = NoExt-type instance XCoreAnn       (GhcPass _) = NoExt-type instance XBracket       (GhcPass _) = NoExt+type instance XSCC           (GhcPass _) = NoExtField+type instance XCoreAnn       (GhcPass _) = NoExtField+type instance XBracket       (GhcPass _) = NoExtField -type instance XRnBracketOut  (GhcPass _) = NoExt-type instance XTcBracketOut  (GhcPass _) = NoExt+type instance XRnBracketOut  (GhcPass _) = NoExtField+type instance XTcBracketOut  (GhcPass _) = NoExtField -type instance XSpliceE       (GhcPass _) = NoExt-type instance XProc          (GhcPass _) = NoExt+type instance XSpliceE       (GhcPass _) = NoExtField+type instance XProc          (GhcPass _) = NoExtField -type instance XStatic        GhcPs = NoExt+type instance XStatic        GhcPs = NoExtField type instance XStatic        GhcRn = NameSet type instance XStatic        GhcTc = NameSet -type instance XTick          (GhcPass _) = NoExt-type instance XBinTick       (GhcPass _) = NoExt-type instance XTickPragma    (GhcPass _) = NoExt-type instance XWrap          (GhcPass _) = NoExt-type instance XXExpr         (GhcPass _) = NoExt+type instance XTick          (GhcPass _) = NoExtField+type instance XBinTick       (GhcPass _) = NoExtField+type instance XTickPragma    (GhcPass _) = NoExtField+type instance XWrap          (GhcPass _) = NoExtField+type instance XXExpr         (GhcPass _) = NoExtCon  -- --------------------------------------------------------------------- @@ -757,13 +758,13 @@   | Missing (XMissing id)    -- ^ The argument is missing, but this is its type   | XTupArg (XXTupArg id)    -- ^ Note [Trees that Grow] extension point -type instance XPresent         (GhcPass _) = NoExt+type instance XPresent         (GhcPass _) = NoExtField -type instance XMissing         GhcPs = NoExt-type instance XMissing         GhcRn = NoExt+type instance XMissing         GhcPs = NoExtField+type instance XMissing         GhcRn = NoExtField type instance XMissing         GhcTc = Type -type instance XXTupArg         (GhcPass _) = NoExt+type instance XXTupArg         (GhcPass _) = NoExtCon  tupArgPresent :: LHsTupArg id -> Bool tupArgPresent (L _ (Present {})) = True@@ -1076,7 +1077,7 @@   = ppr_apps fun (Left arg : args) ppr_apps (HsAppType _ (L _ fun) arg)    args   = ppr_apps fun (Right arg : args)-ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))+ppr_apps fun args = hang (ppr_expr fun) 2 (fsep (map pp args))   where     pp (Left arg)                             = ppr arg     -- pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))@@ -1173,7 +1174,7 @@ -- and if so, surrounds @e@ with an 'HsPar'. Otherwise, it simply returns @e@. parenthesizeHsExpr :: PprPrec -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) parenthesizeHsExpr p le@(L loc e)-  | hsExprNeedsParens p e = L loc (HsPar NoExt le)+  | hsExprNeedsParens p e = L loc (HsPar noExtField le)   | otherwise             = le  isAtomicHsExpr :: HsExpr id -> Bool@@ -1298,24 +1299,24 @@                                -- Then (HsCmdWrap wrap cmd) :: arg2 --> res   | XCmd        (XXCmd id)     -- Note [Trees that Grow] extension point -type instance XCmdArrApp  GhcPs = NoExt-type instance XCmdArrApp  GhcRn = NoExt+type instance XCmdArrApp  GhcPs = NoExtField+type instance XCmdArrApp  GhcRn = NoExtField type instance XCmdArrApp  GhcTc = Type -type instance XCmdArrForm (GhcPass _) = NoExt-type instance XCmdApp     (GhcPass _) = NoExt-type instance XCmdLam     (GhcPass _) = NoExt-type instance XCmdPar     (GhcPass _) = NoExt-type instance XCmdCase    (GhcPass _) = NoExt-type instance XCmdIf      (GhcPass _) = NoExt-type instance XCmdLet     (GhcPass _) = NoExt+type instance XCmdArrForm (GhcPass _) = NoExtField+type instance XCmdApp     (GhcPass _) = NoExtField+type instance XCmdLam     (GhcPass _) = NoExtField+type instance XCmdPar     (GhcPass _) = NoExtField+type instance XCmdCase    (GhcPass _) = NoExtField+type instance XCmdIf      (GhcPass _) = NoExtField+type instance XCmdLet     (GhcPass _) = NoExtField -type instance XCmdDo      GhcPs = NoExt-type instance XCmdDo      GhcRn = NoExt+type instance XCmdDo      GhcPs = NoExtField+type instance XCmdDo      GhcRn = NoExtField type instance XCmdDo      GhcTc = Type -type instance XCmdWrap    (GhcPass _) = NoExt-type instance XXCmd       (GhcPass _) = NoExt+type instance XCmdWrap    (GhcPass _) = NoExtField+type instance XXCmd       (GhcPass _) = NoExtCon  -- | Haskell Array Application Type data HsArrAppType = HsHigherOrderApp | HsFirstOrderApp@@ -1341,11 +1342,11 @@              Type    -- return type of the command              (CmdSyntaxTable GhcTc) -- See Note [CmdSyntaxTable] -type instance XCmdTop  GhcPs = NoExt+type instance XCmdTop  GhcPs = NoExtField type instance XCmdTop  GhcRn = CmdSyntaxTable GhcRn -- See Note [CmdSyntaxTable] type instance XCmdTop  GhcTc = CmdTopTc -type instance XXCmdTop (GhcPass _) = NoExt+type instance XXCmdTop (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsCmd p) where     ppr cmd = pprCmd cmd@@ -1491,11 +1492,11 @@        , mg_res_ty  :: Type    -- Type of the result, tr        } deriving Data -type instance XMG         GhcPs b = NoExt-type instance XMG         GhcRn b = NoExt+type instance XMG         GhcPs b = NoExtField+type instance XMG         GhcRn b = NoExtField type instance XMG         GhcTc b = MatchGroupTc -type instance XXMatchGroup (GhcPass _) b = NoExt+type instance XXMatchGroup (GhcPass _) b = NoExtCon  -- | Located Match type LMatch id body = Located (Match id body)@@ -1513,8 +1514,8 @@   }   | XMatch (XXMatch p body) -type instance XCMatch (GhcPass _) b = NoExt-type instance XXMatch (GhcPass _) b = NoExt+type instance XCMatch (GhcPass _) b = NoExtField+type instance XXMatch (GhcPass _) b = NoExtCon  instance (idR ~ GhcPass pr, OutputableBndrId idR, Outputable body)             => Outputable (Match idR body) where@@ -1564,7 +1565,7 @@  isEmptyMatchGroup :: MatchGroup id body -> Bool isEmptyMatchGroup (MG { mg_alts = ms }) = null $ unLoc ms-isEmptyMatchGroup (XMatchGroup{}) = panic "isEmptyMatchGroup"+isEmptyMatchGroup (XMatchGroup {})      = False  -- | Is there only one RHS in this list of matches? isSingletonMatchGroup :: [LMatch id body] -> Bool@@ -1575,17 +1576,17 @@   | otherwise   = False -matchGroupArity :: MatchGroup id body -> Arity+matchGroupArity :: MatchGroup (GhcPass id) body -> Arity -- Precondition: MatchGroup is non-empty -- This is called before type checking, when mg_arg_tys is not set matchGroupArity (MG { mg_alts = alts })   | L _ (alt1:_) <- alts = length (hsLMatchPats alt1)   | otherwise        = panic "matchGroupArity"-matchGroupArity (XMatchGroup{}) = panic "matchGroupArity"+matchGroupArity (XMatchGroup nec) = noExtCon nec -hsLMatchPats :: LMatch id body -> [LPat id]+hsLMatchPats :: LMatch (GhcPass id) body -> [LPat (GhcPass id)] hsLMatchPats (L _ (Match { m_pats = pats })) = pats-hsLMatchPats (L _ (XMatch _)) = panic "hsLMatchPats"+hsLMatchPats (L _ (XMatch nec)) = noExtCon nec  -- | Guarded Right-Hand Sides --@@ -1605,8 +1606,8 @@     }   | XGRHSs (XXGRHSs p body) -type instance XCGRHSs (GhcPass _) b = NoExt-type instance XXGRHSs (GhcPass _) b = NoExt+type instance XCGRHSs (GhcPass _) b = NoExtField+type instance XXGRHSs (GhcPass _) b = NoExtCon  -- | Located Guarded Right-Hand Side type LGRHS id body = Located (GRHS id body)@@ -1617,8 +1618,8 @@                         body           -- Right hand side                   | XGRHS (XXGRHS p body) -type instance XCGRHS (GhcPass _) b = NoExt-type instance XXGRHS (GhcPass _) b = NoExt+type instance XCGRHS (GhcPass _) b = NoExtField+type instance XXGRHS (GhcPass _) b = NoExtCon  -- We know the list must have at least one @Match@ in it. @@ -1887,35 +1888,35 @@       }  -type instance XLastStmt        (GhcPass _) (GhcPass _) b = NoExt+type instance XLastStmt        (GhcPass _) (GhcPass _) b = NoExtField -type instance XBindStmt        (GhcPass _) GhcPs b = NoExt-type instance XBindStmt        (GhcPass _) GhcRn b = NoExt+type instance XBindStmt        (GhcPass _) GhcPs b = NoExtField+type instance XBindStmt        (GhcPass _) GhcRn b = NoExtField type instance XBindStmt        (GhcPass _) GhcTc b = Type -type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExt-type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExt+type instance XApplicativeStmt (GhcPass _) GhcPs b = NoExtField+type instance XApplicativeStmt (GhcPass _) GhcRn b = NoExtField type instance XApplicativeStmt (GhcPass _) GhcTc b = Type -type instance XBodyStmt        (GhcPass _) GhcPs b = NoExt-type instance XBodyStmt        (GhcPass _) GhcRn b = NoExt+type instance XBodyStmt        (GhcPass _) GhcPs b = NoExtField+type instance XBodyStmt        (GhcPass _) GhcRn b = NoExtField type instance XBodyStmt        (GhcPass _) GhcTc b = Type -type instance XLetStmt         (GhcPass _) (GhcPass _) b = NoExt+type instance XLetStmt         (GhcPass _) (GhcPass _) b = NoExtField -type instance XParStmt         (GhcPass _) GhcPs b = NoExt-type instance XParStmt         (GhcPass _) GhcRn b = NoExt+type instance XParStmt         (GhcPass _) GhcPs b = NoExtField+type instance XParStmt         (GhcPass _) GhcRn b = NoExtField type instance XParStmt         (GhcPass _) GhcTc b = Type -type instance XTransStmt       (GhcPass _) GhcPs b = NoExt-type instance XTransStmt       (GhcPass _) GhcRn b = NoExt+type instance XTransStmt       (GhcPass _) GhcPs b = NoExtField+type instance XTransStmt       (GhcPass _) GhcRn b = NoExtField type instance XTransStmt       (GhcPass _) GhcTc b = Type -type instance XRecStmt         (GhcPass _) GhcPs b = NoExt-type instance XRecStmt         (GhcPass _) GhcRn b = NoExt+type instance XRecStmt         (GhcPass _) GhcPs b = NoExtField+type instance XRecStmt         (GhcPass _) GhcRn b = NoExtField type instance XRecStmt         (GhcPass _) GhcTc b = RecStmtTc -type instance XXStmtLR         (GhcPass _) (GhcPass _) b = NoExt+type instance XXStmtLR         (GhcPass _) (GhcPass _) b = NoExtCon  data TransForm   -- The 'f' below is the 'using' function, 'e' is the by function   = ThenForm     -- then f               or    then f by e             (depending on trS_by)@@ -1931,8 +1932,8 @@         (SyntaxExpr idR)   -- The return operator   | XParStmtBlock (XXParStmtBlock idL idR) -type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = NoExt-type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExt+type instance XParStmtBlock  (GhcPass pL) (GhcPass pR) = NoExtField+type instance XXParStmtBlock (GhcPass pL) (GhcPass pR) = NoExtCon  -- | Applicative Argument data ApplicativeArg idL@@ -1951,9 +1952,9 @@       (LPat idL)           -- (v1,...,vn)   | XApplicativeArg (XXApplicativeArg idL) -type instance XApplicativeArgOne  (GhcPass _) = NoExt-type instance XApplicativeArgMany (GhcPass _) = NoExt-type instance XXApplicativeArg    (GhcPass _) = NoExt+type instance XApplicativeArgOne  (GhcPass _) = NoExtField+type instance XApplicativeArgMany (GhcPass _) = NoExtField+type instance XXApplicativeArg    (GhcPass _) = NoExtCon  {- Note [The type of bind in Stmts]@@ -2184,7 +2185,7 @@              :: ExprStmt (GhcPass idL))]    flattenArg (_, ApplicativeArgMany _ stmts _ _) =      concatMap flattenStmt stmts-   flattenArg (_, XApplicativeArg _) = panic "flattenArg"+   flattenArg (_, XApplicativeArg nec) = noExtCon nec     pp_debug =      let@@ -2207,7 +2208,7 @@      text "<-" <+>      ppr (HsDo (panic "pprStmt") DoExpr (noLoc                (stmts ++-                   [noLoc (LastStmt noExt (noLoc return) False noSyntaxExpr)])))+                   [noLoc (LastStmt noExtField (noLoc return) False noSyntaxExpr)])))    pp_arg (_, XApplicativeArg x) = ppr x  pprStmt (XStmtLR x) = ppr x@@ -2308,11 +2309,11 @@       DelayedSplice    | XSplice (XXSplice id)  -- Note [Trees that Grow] extension point -type instance XTypedSplice   (GhcPass _) = NoExt-type instance XUntypedSplice (GhcPass _) = NoExt-type instance XQuasiQuote    (GhcPass _) = NoExt-type instance XSpliced       (GhcPass _) = NoExt-type instance XXSplice       (GhcPass _) = NoExt+type instance XTypedSplice   (GhcPass _) = NoExtField+type instance XUntypedSplice (GhcPass _) = NoExtField+type instance XQuasiQuote    (GhcPass _) = NoExtField+type instance XSpliced       (GhcPass _) = NoExtField+type instance XXSplice       (GhcPass _) = NoExtCon  -- | A splice can appear with various decorations wrapped around it. This data -- type captures explicitly how it was originally written, for use in the pretty@@ -2515,14 +2516,14 @@   | TExpBr (XTExpBr p) (LHsExpr p)    -- [||  expr  ||]   | XBracket (XXBracket p)            -- Note [Trees that Grow] extension point -type instance XExpBr      (GhcPass _) = NoExt-type instance XPatBr      (GhcPass _) = NoExt-type instance XDecBrL     (GhcPass _) = NoExt-type instance XDecBrG     (GhcPass _) = NoExt-type instance XTypBr      (GhcPass _) = NoExt-type instance XVarBr      (GhcPass _) = NoExt-type instance XTExpBr     (GhcPass _) = NoExt-type instance XXBracket   (GhcPass _) = NoExt+type instance XExpBr      (GhcPass _) = NoExtField+type instance XPatBr      (GhcPass _) = NoExtField+type instance XDecBrL     (GhcPass _) = NoExtField+type instance XDecBrG     (GhcPass _) = NoExtField+type instance XTypBr      (GhcPass _) = NoExtField+type instance XVarBr      (GhcPass _) = NoExtField+type instance XTExpBr     (GhcPass _) = NoExtField+type instance XXBracket   (GhcPass _) = NoExtCon  isTypedBracket :: HsBracket id -> Bool isTypedBracket (TExpBr {}) = True

@@ -1,5 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE EmptyCase #-}+{-# LANGUAGE EmptyDataDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}@@ -53,17 +55,80 @@  -} --- | used as place holder in TTG values-data NoExt = NoExt+-- | A placeholder type for TTG extension points that are not currently+-- unused to represent any particular value.+--+-- This should not be confused with 'NoExtCon', which are found in unused+-- extension /constructors/ and therefore should never be inhabited. In+-- contrast, 'NoExtField' is used in extension /points/ (e.g., as the field of+-- some constructor), so it must have an inhabitant to construct AST passes+-- that manipulate fields with that extension point as their type.+data NoExtField = NoExtField   deriving (Data,Eq,Ord) -instance Outputable NoExt where-  ppr _ = text "NoExt"+instance Outputable NoExtField where+  ppr _ = text "NoExtField"  -- | Used when constructing a term with an unused extension point.-noExt :: NoExt-noExt = NoExt+noExtField :: NoExtField+noExtField = NoExtField +-- | Used in TTG extension constructors that have yet to be extended with+-- anything. If an extension constructor has 'NoExtCon' as its field, it is+-- not intended to ever be constructed anywhere, and any function that consumes+-- the extension constructor can eliminate it by way of 'noExtCon'.+--+-- This should not be confused with 'NoExtField', which are found in unused+-- extension /points/ (not /constructors/) and therefore can be inhabited.++-- See also [NoExtCon and strict fields].+data NoExtCon+  deriving (Data,Eq,Ord)++instance Outputable NoExtCon where+  ppr = noExtCon++-- | Eliminate a 'NoExtCon'. Much like 'Data.Void.absurd'.+noExtCon :: NoExtCon -> a+noExtCon x = case x of {}++{-+Note [NoExtCon and strict fields]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Currently, any unused TTG extension constructor will generally look like the+following:++  type instance XXHsDecl (GhcPass _) = NoExtCon+  data HsDecl p+    = ...+    | XHsDecl (XXHsDecl p)++This means that any function that wishes to consume an HsDecl will need to+have a case for XHsDecl. This might look like this:++  ex :: HsDecl GhcPs -> HsDecl GhcRn+  ...+  ex (XHsDecl nec) = noExtCon nec++Ideally, we wouldn't need a case for XHsDecl at all (it /is/ supposed to be+an unused extension constructor, after all). There is a way to achieve this+on GHC 8.8 or later: make the field of XHsDecl strict:++  data HsDecl p+    = ...+    | XHsDecl !(XXHsDecl p)++If this is done, GHC's pattern-match coverage checker is clever enough to+figure out that the XHsDecl case of `ex` is unreachable, so it can simply be+omitted. (See Note [Extensions to GADTs Meet Their Match] in Check for more on+how this works.)++When GHC drops support for bootstrapping with GHC 8.6 and earlier, we can make+the strict field changes described above and delete gobs of code involving+`noExtCon`. Until then, it is necessary to use, so be aware of it when writing+code that consumes unused extension constructors.+-}+ -- | Used as a data type index for the hsSyn AST data GhcPass (c :: Pass) deriving instance Eq (GhcPass c)@@ -1068,7 +1133,7 @@ -- -- So -----   type instance XXHsIPBinds    (GhcPass p) = NoExt+--   type instance XXHsIPBinds    (GhcPass p) = NoExtCon -- -- will correctly deduce Outputable for (GhcPass p), but --

@@ -108,12 +108,12 @@       -- For details on above see note [Api annotations] in ApiAnnotation -type instance XCImportDecl  (GhcPass _) = NoExt-type instance XXImportDecl  (GhcPass _) = NoExt+type instance XCImportDecl  (GhcPass _) = NoExtField+type instance XXImportDecl  (GhcPass _) = NoExtCon  simpleImportDecl :: ModuleName -> ImportDecl (GhcPass p) simpleImportDecl mn = ImportDecl {-      ideclExt       = noExt,+      ideclExt       = noExtField,       ideclSourceSrc = NoSourceText,       ideclName      = noLoc mn,       ideclPkgQual   = Nothing,@@ -254,15 +254,15 @@   | IEDocNamed          (XIEDocNamed pass) String    -- ^ Reference to named doc   | XIE (XXIE pass) -type instance XIEVar             (GhcPass _) = NoExt-type instance XIEThingAbs        (GhcPass _) = NoExt-type instance XIEThingAll        (GhcPass _) = NoExt-type instance XIEThingWith       (GhcPass _) = NoExt-type instance XIEModuleContents  (GhcPass _) = NoExt-type instance XIEGroup           (GhcPass _) = NoExt-type instance XIEDoc             (GhcPass _) = NoExt-type instance XIEDocNamed        (GhcPass _) = NoExt-type instance XXIE               (GhcPass _) = NoExt+type instance XIEVar             (GhcPass _) = NoExtField+type instance XIEThingAbs        (GhcPass _) = NoExtField+type instance XIEThingAll        (GhcPass _) = NoExtField+type instance XIEThingWith       (GhcPass _) = NoExtField+type instance XIEModuleContents  (GhcPass _) = NoExtField+type instance XIEGroup           (GhcPass _) = NoExtField+type instance XIEDoc             (GhcPass _) = NoExtField+type instance XIEDocNamed        (GhcPass _) = NoExtField+type instance XXIE               (GhcPass _) = NoExtCon  -- | Imported or Exported Wildcard data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data)@@ -284,14 +284,14 @@ See Note [Representing fields in AvailInfo] in Avail for more details. -} -ieName :: IE pass -> IdP pass+ieName :: IE (GhcPass p) -> IdP (GhcPass p) ieName (IEVar _ (L _ n))              = ieWrappedName n ieName (IEThingAbs  _ (L _ n))        = ieWrappedName n ieName (IEThingWith _ (L _ n) _ _ _)  = ieWrappedName n ieName (IEThingAll  _ (L _ n))        = ieWrappedName n ieName _ = panic "ieName failed pattern match!" -ieNames :: IE pass -> [IdP pass]+ieNames :: IE (GhcPass p) -> [IdP (GhcPass p)] ieNames (IEVar       _ (L _ n)   )     = [ieWrappedName n] ieNames (IEThingAbs  _ (L _ n)   )     = [ieWrappedName n] ieNames (IEThingAll  _ (L _ n)   )     = [ieWrappedName n]@@ -301,7 +301,7 @@ ieNames (IEGroup          {})     = [] ieNames (IEDoc            {})     = [] ieNames (IEDocNamed       {})     = []-ieNames (XIE {}) = panic "ieNames"+ieNames (XIE nec) = noExtCon nec  ieWrappedName :: IEWrappedName name -> name ieWrappedName (IEName    (L _ n)) = n

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -O0 #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable #-}

@@ -82,16 +82,16 @@ type instance XHsCharPrim   (GhcPass _) = SourceText type instance XHsString     (GhcPass _) = SourceText type instance XHsStringPrim (GhcPass _) = SourceText-type instance XHsInt        (GhcPass _) = NoExt+type instance XHsInt        (GhcPass _) = NoExtField type instance XHsIntPrim    (GhcPass _) = SourceText type instance XHsWordPrim   (GhcPass _) = SourceText type instance XHsInt64Prim  (GhcPass _) = SourceText type instance XHsWord64Prim (GhcPass _) = SourceText type instance XHsInteger    (GhcPass _) = SourceText-type instance XHsRat        (GhcPass _) = NoExt-type instance XHsFloatPrim  (GhcPass _) = NoExt-type instance XHsDoublePrim (GhcPass _) = NoExt-type instance XXLit         (GhcPass _) = NoExt+type instance XHsRat        (GhcPass _) = NoExtField+type instance XHsFloatPrim  (GhcPass _) = NoExtField+type instance XHsDoublePrim (GhcPass _) = NoExtField+type instance XXLit         (GhcPass _) = NoExtCon  instance Eq (HsLit x) where   (HsChar _ x1)       == (HsChar _ x2)       = x1==x2@@ -125,11 +125,11 @@         ol_type :: Type }   deriving Data -type instance XOverLit GhcPs = NoExt+type instance XOverLit GhcPs = NoExtField type instance XOverLit GhcRn = Bool            -- Note [ol_rebindable] type instance XOverLit GhcTc = OverLitTc -type instance XXOverLit (GhcPass _) = NoExt+type instance XXOverLit (GhcPass _) = NoExtCon  -- Note [Literal source text] in BasicTypes for SourceText fields in -- the following@@ -147,7 +147,7 @@  overLitType :: HsOverLit GhcTc -> Type overLitType (OverLit (OverLitTc _ ty) _ _) = ty-overLitType XOverLit{} = panic "overLitType"+overLitType (XOverLit nec) = noExtCon nec  -- | Convert a literal from one index type to another, updating the annotations -- according to the relevant 'Convertable' instance

@@ -281,51 +281,51 @@       Type                             -- The type of the elements       (Maybe (Type, SyntaxExpr GhcTc)) -- For rebindable syntax -type instance XWildPat GhcPs = NoExt-type instance XWildPat GhcRn = NoExt+type instance XWildPat GhcPs = NoExtField+type instance XWildPat GhcRn = NoExtField type instance XWildPat GhcTc = Type -type instance XVarPat  (GhcPass _) = NoExt-type instance XLazyPat (GhcPass _) = NoExt-type instance XAsPat   (GhcPass _) = NoExt-type instance XParPat  (GhcPass _) = NoExt-type instance XBangPat (GhcPass _) = NoExt+type instance XVarPat  (GhcPass _) = NoExtField+type instance XLazyPat (GhcPass _) = NoExtField+type instance XAsPat   (GhcPass _) = NoExtField+type instance XParPat  (GhcPass _) = NoExtField+type instance XBangPat (GhcPass _) = NoExtField  -- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap -- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for -- `SyntaxExpr`-type instance XListPat GhcPs = NoExt+type instance XListPat GhcPs = NoExtField type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn) type instance XListPat GhcTc = ListPatTc -type instance XTuplePat GhcPs = NoExt-type instance XTuplePat GhcRn = NoExt+type instance XTuplePat GhcPs = NoExtField+type instance XTuplePat GhcRn = NoExtField type instance XTuplePat GhcTc = [Type] -type instance XSumPat GhcPs = NoExt-type instance XSumPat GhcRn = NoExt+type instance XSumPat GhcPs = NoExtField+type instance XSumPat GhcRn = NoExtField type instance XSumPat GhcTc = [Type] -type instance XViewPat GhcPs = NoExt-type instance XViewPat GhcRn = NoExt+type instance XViewPat GhcPs = NoExtField+type instance XViewPat GhcRn = NoExtField type instance XViewPat GhcTc = Type -type instance XSplicePat (GhcPass _) = NoExt-type instance XLitPat    (GhcPass _) = NoExt+type instance XSplicePat (GhcPass _) = NoExtField+type instance XLitPat    (GhcPass _) = NoExtField -type instance XNPat GhcPs = NoExt-type instance XNPat GhcRn = NoExt+type instance XNPat GhcPs = NoExtField+type instance XNPat GhcRn = NoExtField type instance XNPat GhcTc = Type -type instance XNPlusKPat GhcPs = NoExt-type instance XNPlusKPat GhcRn = NoExt+type instance XNPlusKPat GhcPs = NoExtField+type instance XNPlusKPat GhcRn = NoExtField type instance XNPlusKPat GhcTc = Type -type instance XSigPat GhcPs = NoExt-type instance XSigPat GhcRn = NoExt+type instance XSigPat GhcPs = NoExtField+type instance XSigPat GhcRn = NoExtField type instance XSigPat GhcTc = Type -type instance XCoPat  (GhcPass _) = NoExt+type instance XCoPat  (GhcPass _) = NoExtField type instance XXPat   (GhcPass p) = Located (Pat (GhcPass p))  @@ -460,11 +460,11 @@ -- -- The parsed HsRecUpdField corresponding to the record update will have: -----     hsRecFieldLbl = Unambiguous "x" NoExt :: AmbiguousFieldOcc RdrName+--     hsRecFieldLbl = Unambiguous "x" noExtField :: AmbiguousFieldOcc RdrName -- -- After the renamer, this will become: -----     hsRecFieldLbl = Ambiguous   "x" NoExt :: AmbiguousFieldOcc Name+--     hsRecFieldLbl = Ambiguous   "x" noExtField :: AmbiguousFieldOcc Name -- -- (note that the Unambiguous constructor is not type-correct here). -- The typechecker will determine the particular selector:@@ -584,7 +584,7 @@  pprConArgs :: (OutputableBndrId (GhcPass p))            => HsConPatDetails (GhcPass p) -> SDoc-pprConArgs (PrefixCon pats) = sep (map (pprParendLPat appPrec) pats)+pprConArgs (PrefixCon pats) = fsep (map (pprParendLPat appPrec) pats) pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1                                   , pprParendLPat appPrec p2 ] pprConArgs (RecCon rpats)   = ppr rpats@@ -630,7 +630,7 @@  mkCharLitPat :: SourceText -> Char -> OutPat (GhcPass p) mkCharLitPat src c = mkPrefixConPat charDataCon-                          [noLoc $ LitPat NoExt (HsCharPrim src c)] []+                          [noLoc $ LitPat noExtField (HsCharPrim src c)] []  {- ************************************************************************@@ -811,7 +811,7 @@ -- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@. parenthesizePat :: PprPrec -> LPat (GhcPass p) -> LPat (GhcPass p) parenthesizePat p lpat@(dL->L loc pat)-  | patNeedsParens p pat = cL loc (ParPat NoExt lpat)+  | patNeedsParens p pat = cL loc (ParPat noExtField lpat)   | otherwise            = lpat  {-

@@ -70,6 +70,8 @@         hsTypeNeedsParens, parenthesizeHsType, parenthesizeHsContext     ) where +#include "HsVersions.h"+ import GhcPrelude  import {-# SOURCE #-} HsExpr ( HsSplice, pprSplice )@@ -90,7 +92,7 @@ import Outputable import FastString import Maybes( isJust )-import Util ( count )+import Util ( count, debugIsOn )  import Data.Data hiding ( Fixity, Prefix, Infix ) @@ -334,14 +336,14 @@   -- For example, in   data T (a :: k1 -> k2) = ...   -- the 'a' is explicit while 'k1', 'k2' are implicit -type instance XHsQTvs GhcPs = NoExt+type instance XHsQTvs GhcPs = NoExtField type instance XHsQTvs GhcRn = HsQTvsRn type instance XHsQTvs GhcTc = HsQTvsRn -type instance XXLHsQTyVars  (GhcPass _) = NoExt+type instance XXLHsQTyVars  (GhcPass _) = NoExtCon  mkHsQTvs :: [LHsTyVarBndr GhcPs] -> LHsQTyVars GhcPs-mkHsQTvs tvs = HsQTvs { hsq_ext = noExt, hsq_explicit = tvs }+mkHsQTvs tvs = HsQTvs { hsq_ext = noExtField, hsq_explicit = tvs }  hsQTvExplicit :: LHsQTyVars pass -> [LHsTyVarBndr pass] hsQTvExplicit = hsq_explicit@@ -372,11 +374,11 @@     }   | XHsImplicitBndrs (XXHsImplicitBndrs pass thing) -type instance XHsIB              GhcPs _ = NoExt+type instance XHsIB              GhcPs _ = NoExtField type instance XHsIB              GhcRn _ = [Name] type instance XHsIB              GhcTc _ = [Name] -type instance XXHsImplicitBndrs  (GhcPass _) _ = NoExt+type instance XXHsImplicitBndrs  (GhcPass _) _ = NoExtCon  -- | Haskell Wildcard Binders data HsWildCardBndrs pass thing@@ -394,11 +396,11 @@     }   | XHsWildCardBndrs (XXHsWildCardBndrs pass thing) -type instance XHsWC              GhcPs b = NoExt+type instance XHsWC              GhcPs b = NoExtField type instance XHsWC              GhcRn b = [Name] type instance XHsWC              GhcTc b = [Name] -type instance XXHsWildCardBndrs  (GhcPass _) b = NoExt+type instance XXHsWildCardBndrs  (GhcPass _) b = NoExtCon  -- | Located Haskell Signature Type type LHsSigType   pass = HsImplicitBndrs pass (LHsType pass)    -- Implicit only@@ -411,11 +413,11 @@  -- See Note [Representing type signatures] -hsImplicitBody :: HsImplicitBndrs pass thing -> thing+hsImplicitBody :: HsImplicitBndrs (GhcPass p) thing -> thing hsImplicitBody (HsIB { hsib_body = body }) = body-hsImplicitBody (XHsImplicitBndrs _) = panic "hsImplicitBody"+hsImplicitBody (XHsImplicitBndrs nec) = noExtCon nec -hsSigType :: LHsSigType pass -> LHsType pass+hsSigType :: LHsSigType (GhcPass p) -> LHsType (GhcPass p) hsSigType = hsImplicitBody  hsSigWcType :: LHsSigWcType pass -> LHsType pass@@ -446,12 +448,12 @@ -}  mkHsImplicitBndrs :: thing -> HsImplicitBndrs GhcPs thing-mkHsImplicitBndrs x = HsIB { hsib_ext  = noExt+mkHsImplicitBndrs x = HsIB { hsib_ext  = noExtField                            , hsib_body = x }  mkHsWildCardBndrs :: thing -> HsWildCardBndrs GhcPs thing mkHsWildCardBndrs x = HsWC { hswc_body = x-                           , hswc_ext  = noExt }+                           , hswc_ext  = noExtField }  -- Add empty binders.  This is a bit suspicious; what if -- the wrapped thing had free type variables?@@ -502,15 +504,15 @@   | XTyVarBndr       (XXTyVarBndr pass) -type instance XUserTyVar    (GhcPass _) = NoExt-type instance XKindedTyVar  (GhcPass _) = NoExt-type instance XXTyVarBndr   (GhcPass _) = NoExt+type instance XUserTyVar    (GhcPass _) = NoExtField+type instance XKindedTyVar  (GhcPass _) = NoExtField+type instance XXTyVarBndr   (GhcPass _) = NoExtCon  -- | Does this 'HsTyVarBndr' come with an explicit kind annotation? isHsKindedTyVar :: HsTyVarBndr pass -> Bool isHsKindedTyVar (UserTyVar {})   = False isHsKindedTyVar (KindedTyVar {}) = True-isHsKindedTyVar (XTyVarBndr{})   = panic "isHsKindedTyVar"+isHsKindedTyVar (XTyVarBndr {})  = False  -- | Do all type variables in this 'LHsQTyVars' come with kind annotations? hsTvbAllKinded :: LHsQTyVars pass -> Bool@@ -704,41 +706,41 @@ instance Outputable NewHsTypeX where   ppr (NHsCoreTy ty) = ppr ty -type instance XForAllTy        (GhcPass _) = NoExt-type instance XQualTy          (GhcPass _) = NoExt-type instance XTyVar           (GhcPass _) = NoExt-type instance XAppTy           (GhcPass _) = NoExt-type instance XFunTy           (GhcPass _) = NoExt-type instance XListTy          (GhcPass _) = NoExt-type instance XTupleTy         (GhcPass _) = NoExt-type instance XSumTy           (GhcPass _) = NoExt-type instance XOpTy            (GhcPass _) = NoExt-type instance XParTy           (GhcPass _) = NoExt-type instance XIParamTy        (GhcPass _) = NoExt-type instance XStarTy          (GhcPass _) = NoExt-type instance XKindSig         (GhcPass _) = NoExt+type instance XForAllTy        (GhcPass _) = NoExtField+type instance XQualTy          (GhcPass _) = NoExtField+type instance XTyVar           (GhcPass _) = NoExtField+type instance XAppTy           (GhcPass _) = NoExtField+type instance XFunTy           (GhcPass _) = NoExtField+type instance XListTy          (GhcPass _) = NoExtField+type instance XTupleTy         (GhcPass _) = NoExtField+type instance XSumTy           (GhcPass _) = NoExtField+type instance XOpTy            (GhcPass _) = NoExtField+type instance XParTy           (GhcPass _) = NoExtField+type instance XIParamTy        (GhcPass _) = NoExtField+type instance XStarTy          (GhcPass _) = NoExtField+type instance XKindSig         (GhcPass _) = NoExtField  type instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives -type instance XSpliceTy        GhcPs = NoExt-type instance XSpliceTy        GhcRn = NoExt+type instance XSpliceTy        GhcPs = NoExtField+type instance XSpliceTy        GhcRn = NoExtField type instance XSpliceTy        GhcTc = Kind -type instance XDocTy           (GhcPass _) = NoExt-type instance XBangTy          (GhcPass _) = NoExt-type instance XRecTy           (GhcPass _) = NoExt+type instance XDocTy           (GhcPass _) = NoExtField+type instance XBangTy          (GhcPass _) = NoExtField+type instance XRecTy           (GhcPass _) = NoExtField -type instance XExplicitListTy  GhcPs = NoExt-type instance XExplicitListTy  GhcRn = NoExt+type instance XExplicitListTy  GhcPs = NoExtField+type instance XExplicitListTy  GhcRn = NoExtField type instance XExplicitListTy  GhcTc = Kind -type instance XExplicitTupleTy GhcPs = NoExt-type instance XExplicitTupleTy GhcRn = NoExt+type instance XExplicitTupleTy GhcPs = NoExtField+type instance XExplicitTupleTy GhcRn = NoExtField type instance XExplicitTupleTy GhcTc = [Kind] -type instance XTyLit           (GhcPass _) = NoExt+type instance XTyLit           (GhcPass _) = NoExtField -type instance XWildCardTy      (GhcPass _) = NoExt+type instance XWildCardTy      (GhcPass _) = NoExtField  type instance XXType         (GhcPass _) = NewHsTypeX @@ -890,8 +892,8 @@       -- For details on above see note [Api annotations] in ApiAnnotation   | XConDeclField (XXConDeclField pass) -type instance XConDeclField  (GhcPass _) = NoExt-type instance XXConDeclField (GhcPass _) = NoExt+type instance XConDeclField  (GhcPass _) = NoExtField+type instance XXConDeclField (GhcPass _) = NoExtCon  instance (p ~ GhcPass pass, OutputableBndrId p)        => Outputable (ConDeclField p) where@@ -949,7 +951,6 @@ hsWcScopedTvs :: LHsSigWcType GhcRn -> [Name] -- Get the lexically-scoped type variables of a HsSigType --  - the explicitly-given forall'd type variables---  - the implicitly-bound kind variables --  - the named wildcars; see Note [Scoping of named wildcards] -- because they scope in the same way hsWcScopedTvs sig_ty@@ -957,21 +958,23 @@   , HsIB { hsib_ext = vars          , hsib_body = sig_ty2 } <- sig_ty1   = case sig_ty2 of-      L _ (HsForAllTy { hst_bndrs = tvs }) -> vars ++ nwcs ++-                                              hsLTyVarNames tvs-               -- include kind variables only if the type is headed by forall-               -- (this is consistent with GHC 7 behaviour)+      L _ (HsForAllTy { hst_fvf = vis_flag+                      , hst_bndrs = tvs }) ->+        ASSERT( vis_flag == ForallInvis ) -- See Note [hsScopedTvs vis_flag]+        vars ++ nwcs ++ hsLTyVarNames tvs       _                                    -> nwcs-hsWcScopedTvs (HsWC _ (XHsImplicitBndrs _)) = panic "hsWcScopedTvs"-hsWcScopedTvs (XHsWildCardBndrs _) = panic "hsWcScopedTvs"+hsWcScopedTvs (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec+hsWcScopedTvs (XHsWildCardBndrs nec) = noExtCon nec  hsScopedTvs :: LHsSigType GhcRn -> [Name] -- Same as hsWcScopedTvs, but for a LHsSigType hsScopedTvs sig_ty   | HsIB { hsib_ext = vars          , hsib_body = sig_ty2 } <- sig_ty-  , L _ (HsForAllTy { hst_bndrs = tvs }) <- sig_ty2-  = vars ++ hsLTyVarNames tvs+  , L _ (HsForAllTy { hst_fvf = vis_flag+                    , hst_bndrs = tvs }) <- sig_ty2+  = ASSERT( vis_flag == ForallInvis ) -- See Note [hsScopedTvs vis_flag]+    vars ++ hsLTyVarNames tvs   | otherwise   = [] @@ -988,19 +991,61 @@ I don't know if this is a good idea, but there it is. -} +{- Note [hsScopedTvs vis_flag]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-XScopedTypeVariables can be defined in terms of a desugaring to+-XTypeAbstractions (GHC Proposal #50):++    fn :: forall a b c. tau(a,b,c)            fn :: forall a b c. tau(a,b,c)+    fn = defn(a,b,c)                   ==>    fn @x @y @z = defn(x,y,z)++That is, for every type variable of the leading 'forall' in the type signature,+we add an invisible binder at term level.++This model does not extend to visible forall, as discussed here:++* https://gitlab.haskell.org/ghc/ghc/issues/16734#note_203412+* https://github.com/ghc-proposals/ghc-proposals/pull/238++The conclusion of these discussions can be summarized as follows:++  > Assuming support for visible 'forall' in terms, consider this example:+  >+  >     vfn :: forall x y -> tau(x,y)+  >     vfn = \a b -> ...+  >+  > The user has written their own binders 'a' and 'b' to stand for 'x' and+  > 'y', and we definitely should not desugar this into:+  >+  >     vfn :: forall x y -> tau(x,y)+  >     vfn x y = \a b -> ...         -- bad!++At the moment, GHC does not support visible 'forall' in terms, so we simply cement+our assumptions with an assert:++    hsScopedTvs (HsForAllTy { hst_fvf = vis_flag, ... }) =+      ASSERT( vis_flag == ForallInvis )+      ...++In the future, this assert can be safely turned into a pattern match to support+visible forall in terms:++    hsScopedTvs (HsForAllTy { hst_fvf = ForallInvis, ... }) = ...+-}+ ----------------------hsTyVarName :: HsTyVarBndr pass -> IdP pass+hsTyVarName :: HsTyVarBndr (GhcPass p) -> IdP (GhcPass p) hsTyVarName (UserTyVar _ (L _ n))     = n hsTyVarName (KindedTyVar _ (L _ n) _) = n-hsTyVarName (XTyVarBndr{}) = panic "hsTyVarName"+hsTyVarName (XTyVarBndr nec) = noExtCon nec -hsLTyVarName :: LHsTyVarBndr pass -> IdP pass+hsLTyVarName :: LHsTyVarBndr (GhcPass p) -> IdP (GhcPass p) hsLTyVarName = hsTyVarName . unLoc -hsLTyVarNames :: [LHsTyVarBndr pass] -> [IdP pass]+hsLTyVarNames :: [LHsTyVarBndr (GhcPass p)] -> [IdP (GhcPass p)] hsLTyVarNames = map hsLTyVarName -hsExplicitLTyVarNames :: LHsQTyVars pass -> [IdP pass]+hsExplicitLTyVarNames :: LHsQTyVars (GhcPass p) -> [IdP (GhcPass p)] -- Explicit variables only hsExplicitLTyVarNames qtvs = map hsLTyVarName (hsQTvExplicit qtvs) @@ -1009,28 +1054,28 @@ hsAllLTyVarNames (HsQTvs { hsq_ext = kvs                          , hsq_explicit = tvs })   = kvs ++ hsLTyVarNames tvs-hsAllLTyVarNames (XLHsQTyVars _) = panic "hsAllLTyVarNames"+hsAllLTyVarNames (XLHsQTyVars nec) = noExtCon nec -hsLTyVarLocName :: LHsTyVarBndr pass -> Located (IdP pass)+hsLTyVarLocName :: LHsTyVarBndr (GhcPass p) -> Located (IdP (GhcPass p)) hsLTyVarLocName = onHasSrcSpan hsTyVarName -hsLTyVarLocNames :: LHsQTyVars pass -> [Located (IdP pass)]+hsLTyVarLocNames :: LHsQTyVars (GhcPass p) -> [Located (IdP (GhcPass p))] hsLTyVarLocNames qtvs = map hsLTyVarLocName (hsQTvExplicit qtvs)  -- | Convert a LHsTyVarBndr to an equivalent LHsType. hsLTyVarBndrToType :: LHsTyVarBndr (GhcPass p) -> LHsType (GhcPass p) hsLTyVarBndrToType = onHasSrcSpan cvt-  where cvt (UserTyVar _ n) = HsTyVar noExt NotPromoted n+  where cvt (UserTyVar _ n) = HsTyVar noExtField NotPromoted n         cvt (KindedTyVar _ (L name_loc n) kind)-          = HsKindSig noExt-                   (L name_loc (HsTyVar noExt NotPromoted (L name_loc n))) kind-        cvt (XTyVarBndr{}) = panic "hsLTyVarBndrToType"+          = HsKindSig noExtField+                   (L name_loc (HsTyVar noExtField NotPromoted (L name_loc n))) kind+        cvt (XTyVarBndr nec) = noExtCon nec  -- | Convert a LHsTyVarBndrs to a list of types. -- Works on *type* variable only, no kind vars. hsLTyVarBndrsToTypes :: LHsQTyVars (GhcPass p) -> [LHsType (GhcPass p)] hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType tvbs-hsLTyVarBndrsToTypes (XLHsQTyVars _) = panic "hsLTyVarBndrsToTypes"+hsLTyVarBndrsToTypes (XLHsQTyVars nec) = noExtCon nec  --------------------- ignoreParens :: LHsType pass -> LHsType pass@@ -1050,15 +1095,15 @@ -}  mkAnonWildCardTy :: HsType GhcPs-mkAnonWildCardTy = HsWildCardTy noExt+mkAnonWildCardTy = HsWildCardTy noExtField  mkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p))          -> LHsType (GhcPass p) -> HsType (GhcPass p)-mkHsOpTy ty1 op ty2 = HsOpTy noExt ty1 op ty2+mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2  mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) mkHsAppTy t1 t2-  = addCLoc t1 t2 (HsAppTy noExt t1 (parenthesizeHsType appPrec t2))+  = addCLoc t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))  mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]            -> LHsType (GhcPass p)@@ -1270,9 +1315,9 @@   = (itkvs ++ hsLTyVarNames tvs, cxt, body_ty)          -- Return implicitly bound type and kind vars          -- For an instance decl, all of them are in scope-splitLHsInstDeclTy (XHsImplicitBndrs _) = panic "splitLHsInstDeclTy"+splitLHsInstDeclTy (XHsImplicitBndrs nec) = noExtCon nec -getLHsInstDeclHead :: LHsSigType pass -> LHsType pass+getLHsInstDeclHead :: LHsSigType (GhcPass p) -> LHsType (GhcPass p) getLHsInstDeclHead inst_ty   | (_tvs, _cxt, body_ty) <- splitLHsSigmaTyInvis (hsSigType inst_ty)   = body_ty@@ -1311,17 +1356,17 @@ deriving instance (p ~ GhcPass pass, Eq (XCFieldOcc p)) => Eq  (FieldOcc p) deriving instance (p ~ GhcPass pass, Ord (XCFieldOcc p)) => Ord (FieldOcc p) -type instance XCFieldOcc GhcPs = NoExt+type instance XCFieldOcc GhcPs = NoExtField type instance XCFieldOcc GhcRn = Name type instance XCFieldOcc GhcTc = Id -type instance XXFieldOcc (GhcPass _) = NoExt+type instance XXFieldOcc (GhcPass _) = NoExtCon  instance Outputable (FieldOcc pass) where   ppr = ppr . rdrNameFieldOcc  mkFieldOcc :: Located RdrName -> FieldOcc GhcPs-mkFieldOcc rdr = FieldOcc noExt rdr+mkFieldOcc rdr = FieldOcc noExtField rdr   -- | Ambiguous Field Occurrence@@ -1341,15 +1386,15 @@   | Ambiguous   (XAmbiguous pass)   (Located RdrName)   | XAmbiguousFieldOcc (XXAmbiguousFieldOcc pass) -type instance XUnambiguous GhcPs = NoExt+type instance XUnambiguous GhcPs = NoExtField type instance XUnambiguous GhcRn = Name type instance XUnambiguous GhcTc = Id -type instance XAmbiguous GhcPs = NoExt-type instance XAmbiguous GhcRn = NoExt+type instance XAmbiguous GhcPs = NoExtField+type instance XAmbiguous GhcRn = NoExtField type instance XAmbiguous GhcTc = Id -type instance XXAmbiguousFieldOcc (GhcPass _) = NoExt+type instance XXAmbiguousFieldOcc (GhcPass _) = NoExtCon  instance p ~ GhcPass pass => Outputable (AmbiguousFieldOcc p) where   ppr = ppr . rdrNameAmbiguousFieldOcc@@ -1359,28 +1404,28 @@   pprPrefixOcc = pprPrefixOcc . rdrNameAmbiguousFieldOcc  mkAmbiguousFieldOcc :: Located RdrName -> AmbiguousFieldOcc GhcPs-mkAmbiguousFieldOcc rdr = Unambiguous noExt rdr+mkAmbiguousFieldOcc rdr = Unambiguous noExtField rdr  rdrNameAmbiguousFieldOcc :: AmbiguousFieldOcc (GhcPass p) -> RdrName rdrNameAmbiguousFieldOcc (Unambiguous _ (L _ rdr)) = rdr rdrNameAmbiguousFieldOcc (Ambiguous   _ (L _ rdr)) = rdr-rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc _)-  = panic "rdrNameAmbiguousFieldOcc"+rdrNameAmbiguousFieldOcc (XAmbiguousFieldOcc nec)+  = noExtCon nec  selectorAmbiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> Id selectorAmbiguousFieldOcc (Unambiguous sel _) = sel selectorAmbiguousFieldOcc (Ambiguous   sel _) = sel-selectorAmbiguousFieldOcc (XAmbiguousFieldOcc _)-  = panic "selectorAmbiguousFieldOcc"+selectorAmbiguousFieldOcc (XAmbiguousFieldOcc nec)+  = noExtCon nec  unambiguousFieldOcc :: AmbiguousFieldOcc GhcTc -> FieldOcc GhcTc unambiguousFieldOcc (Unambiguous rdr sel) = FieldOcc rdr sel unambiguousFieldOcc (Ambiguous   rdr sel) = FieldOcc rdr sel-unambiguousFieldOcc (XAmbiguousFieldOcc _) = panic "unambiguousFieldOcc"+unambiguousFieldOcc (XAmbiguousFieldOcc nec) = noExtCon nec  ambiguousFieldOcc :: FieldOcc GhcTc -> AmbiguousFieldOcc GhcTc ambiguousFieldOcc (FieldOcc sel rdr) = Unambiguous sel rdr-ambiguousFieldOcc (XFieldOcc _) = panic "ambiguousFieldOcc"+ambiguousFieldOcc (XFieldOcc nec) = noExtCon nec  {- ************************************************************************@@ -1664,7 +1709,7 @@ -- returns @ty@. parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p) parenthesizeHsType p lty@(L loc ty)-  | hsTypeNeedsParens p ty = L loc (HsParTy NoExt lty)+  | hsTypeNeedsParens p ty = L loc (HsParTy noExtField lty)   | otherwise              = lty  -- | @'parenthesizeHsContext' p ctxt@ checks if @ctxt@ is a single constraint

@@ -106,7 +106,7 @@ import RdrName import Var import TyCoRep-import Type   ( appTyArgFlags, splitAppTys, tyConArgFlags )+import Type   ( appTyArgFlags, splitAppTys, tyConArgFlags, tyConAppNeedsKindSig ) import TysWiredIn ( unitTy ) import TcType import DataCon@@ -140,14 +140,14 @@ -}  mkHsPar :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)-mkHsPar e = cL (getLoc e) (HsPar noExt e)+mkHsPar e = cL (getLoc e) (HsPar noExtField e)  mkSimpleMatch :: HsMatchContext (NameOrRdrName (IdP (GhcPass p)))               -> [LPat (GhcPass p)] -> Located (body (GhcPass p))               -> LMatch (GhcPass p) (Located (body (GhcPass p))) mkSimpleMatch ctxt pats rhs   = cL loc $-    Match { m_ext = noExt, m_ctxt = ctxt, m_pats = pats+    Match { m_ext = noExtField, m_ctxt = ctxt, m_pats = pats           , m_grhss = unguardedGRHSs rhs }   where     loc = case pats of@@ -157,16 +157,16 @@ unguardedGRHSs :: Located (body (GhcPass p))                -> GRHSs (GhcPass p) (Located (body (GhcPass p))) unguardedGRHSs rhs@(dL->L loc _)-  = GRHSs noExt (unguardedRHS loc rhs) (noLoc emptyLocalBinds)+  = GRHSs noExtField (unguardedRHS loc rhs) (noLoc emptyLocalBinds)  unguardedRHS :: SrcSpan -> Located (body (GhcPass p))              -> [LGRHS (GhcPass p) (Located (body (GhcPass p)))]-unguardedRHS loc rhs = [cL loc (GRHS noExt [] rhs)]+unguardedRHS loc rhs = [cL loc (GRHS noExtField [] rhs)] -mkMatchGroup :: (XMG name (Located (body name)) ~ NoExt)+mkMatchGroup :: (XMG name (Located (body name)) ~ NoExtField)              => Origin -> [LMatch name (Located (body name))]              -> MatchGroup name (Located (body name))-mkMatchGroup origin matches = MG { mg_ext = noExt+mkMatchGroup origin matches = MG { mg_ext = noExtField                                  , mg_alts = mkLocatedList matches                                  , mg_origin = origin } @@ -175,11 +175,11 @@ mkLocatedList ms = cL (combineLocs (head ms) (last ms)) ms  mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)-mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExt e1 e2)+mkHsApp e1 e2 = addCLoc e1 e2 (HsApp noExtField e1 e2)  mkHsAppType :: (NoGhcTc (GhcPass id) ~ GhcRn)             => LHsExpr (GhcPass id) -> LHsWcType GhcRn -> LHsExpr (GhcPass id)-mkHsAppType e t = addCLoc e t_body (HsAppType noExt e paren_wct)+mkHsAppType e t = addCLoc e t_body (HsAppType noExtField e paren_wct)   where     t_body    = hswc_body t     paren_wct = t { hswc_body = parenthesizeHsType appPrec t_body }@@ -187,9 +187,9 @@ mkHsAppTypes :: LHsExpr GhcRn -> [LHsWcType GhcRn] -> LHsExpr GhcRn mkHsAppTypes = foldl' mkHsAppType -mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExt) =>+mkHsLam :: (XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>   [LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)-mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExt matches))+mkHsLam pats body = mkHsPar (cL (getLoc body) (HsLam noExtField matches))   where     matches = mkMatchGroup Generated                            [mkSimpleMatch LambdaExpr pats' body]@@ -208,7 +208,7 @@  nlHsTyApp :: IdP (GhcPass id) -> [Type] -> LHsExpr (GhcPass id) nlHsTyApp fun_id tys-  = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExt (noLoc fun_id)))+  = noLoc (mkHsWrap (mkWpTyApps tys) (HsVar noExtField (noLoc fun_id)))  nlHsTyApps :: IdP (GhcPass id) -> [Type] -> [LHsExpr (GhcPass id)]            -> LHsExpr (GhcPass id)@@ -219,16 +219,16 @@ -- Wrap in parens if (hsExprNeedsParens appPrec) says it needs them -- So   'f x'  becomes '(f x)', but '3' stays as '3' mkLHsPar le@(dL->L loc e)-  | hsExprNeedsParens appPrec e = cL loc (HsPar noExt le)+  | hsExprNeedsParens appPrec e = cL loc (HsPar noExtField le)   | otherwise                   = le  mkParPat :: LPat (GhcPass name) -> LPat (GhcPass name) mkParPat lp@(dL->L loc p)-  | patNeedsParens appPrec p = cL loc (ParPat noExt lp)+  | patNeedsParens appPrec p = cL loc (ParPat noExtField lp)   | otherwise                = lp  nlParPat :: LPat (GhcPass name) -> LPat (GhcPass name)-nlParPat p = noLoc (ParPat noExt p)+nlParPat p = noLoc (ParPat noExtField p)  ------------------------------- -- These are the bits of syntax that contain rebindable names@@ -250,7 +250,7 @@ mkBodyStmt :: Located (bodyR GhcPs)            -> StmtLR (GhcPass idL) GhcPs (Located (bodyR GhcPs)) mkBindStmt :: (XBindStmt (GhcPass idL) (GhcPass idR)-                         (Located (bodyR (GhcPass idR))) ~ NoExt)+                         (Located (bodyR (GhcPass idR))) ~ NoExtField)            => LPat (GhcPass idL) -> Located (bodyR (GhcPass idR))            -> StmtLR (GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR))) mkTcBindStmt :: LPat GhcTc -> Located (bodyR GhcTc)@@ -263,26 +263,26 @@                  -> StmtLR (GhcPass idL) GhcPs bodyR  -mkHsIntegral     i  = OverLit noExt (HsIntegral       i) noExpr-mkHsFractional   f  = OverLit noExt (HsFractional     f) noExpr-mkHsIsString src s  = OverLit noExt (HsIsString   src s) noExpr+mkHsIntegral     i  = OverLit noExtField (HsIntegral       i) noExpr+mkHsFractional   f  = OverLit noExtField (HsFractional     f) noExpr+mkHsIsString src s  = OverLit noExtField (HsIsString   src s) noExpr -mkHsDo ctxt stmts = HsDo noExt ctxt (mkLocatedList stmts)+mkHsDo ctxt stmts = HsDo noExtField ctxt (mkLocatedList stmts) mkHsComp ctxt stmts expr = mkHsDo ctxt (stmts ++ [last_stmt])   where     last_stmt = cL (getLoc expr) $ mkLastStmt expr  mkHsIf :: LHsExpr (GhcPass p) -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)        -> HsExpr (GhcPass p)-mkHsIf c a b = HsIf noExt (Just noSyntaxExpr) c a b+mkHsIf c a b = HsIf noExtField (Just noSyntaxExpr) c a b  mkHsCmdIf :: LHsExpr (GhcPass p) -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p)        -> HsCmd (GhcPass p)-mkHsCmdIf c a b = HsCmdIf noExt (Just noSyntaxExpr) c a b+mkHsCmdIf c a b = HsCmdIf noExtField (Just noSyntaxExpr) c a b -mkNPat lit neg     = NPat noExt lit neg noSyntaxExpr+mkNPat lit neg     = NPat noExtField lit neg noSyntaxExpr mkNPlusKPat id lit-  = NPlusKPat noExt id lit (unLoc lit) noSyntaxExpr noSyntaxExpr+  = NPlusKPat noExtField id lit (unLoc lit) noSyntaxExpr noSyntaxExpr  mkTransformStmt    :: [ExprLStmt GhcPs] -> LHsExpr GhcPs                    -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)@@ -295,7 +295,7 @@                    -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)  emptyTransStmt :: StmtLR GhcPs GhcPs (LHsExpr GhcPs)-emptyTransStmt = TransStmt { trS_ext = noExt+emptyTransStmt = TransStmt { trS_ext = noExtField                            , trS_form = panic "emptyTransStmt: form"                            , trS_stmts = [], trS_bndrs = []                            , trS_by = Nothing, trS_using = noLoc noExpr@@ -306,11 +306,11 @@ mkGroupUsingStmt   ss u   = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u } mkGroupByUsingStmt ss b u = emptyTransStmt { trS_form = GroupForm, trS_stmts = ss, trS_using = u, trS_by = Just b } -mkLastStmt body = LastStmt noExt body False noSyntaxExpr+mkLastStmt body = LastStmt noExtField body False noSyntaxExpr mkBodyStmt body-  = BodyStmt noExt body noSyntaxExpr noSyntaxExpr+  = BodyStmt noExtField body noSyntaxExpr noSyntaxExpr mkBindStmt pat body-  = BindStmt noExt pat body noSyntaxExpr noSyntaxExpr+  = BindStmt noExtField pat body noSyntaxExpr noSyntaxExpr mkTcBindStmt pat body = BindStmt unitTy pat body noSyntaxExpr noSyntaxExpr   -- don't use placeHolderTypeTc above, because that panics during zonking @@ -332,8 +332,8 @@                           , recS_rec_rets = []                           , recS_ret_ty = unitTy } -emptyRecStmt     = emptyRecStmt' noExt-emptyRecStmtName = emptyRecStmt' noExt+emptyRecStmt     = emptyRecStmt' noExtField+emptyRecStmtName = emptyRecStmt' noExtField emptyRecStmtId   = emptyRecStmt' unitRecStmtTc                                         -- a panic might trigger during zonking mkRecStmt stmts  = emptyRecStmt { recS_stmts = stmts }@@ -342,20 +342,20 @@ --- A useful function for building @OpApps@.  The operator is always a -- variable, and we don't know the fixity yet. mkHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs-mkHsOpApp e1 op e2 = OpApp noExt e1 (noLoc (HsVar noExt (noLoc op))) e2+mkHsOpApp e1 op e2 = OpApp noExtField e1 (noLoc (HsVar noExtField (noLoc op))) e2  unqualSplice :: RdrName unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice"))  mkUntypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs-mkUntypedSplice hasParen e = HsUntypedSplice noExt hasParen unqualSplice e+mkUntypedSplice hasParen e = HsUntypedSplice noExtField hasParen unqualSplice e  mkTypedSplice :: SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs-mkTypedSplice hasParen e = HsTypedSplice noExt hasParen unqualSplice e+mkTypedSplice hasParen e = HsTypedSplice noExtField hasParen unqualSplice e  mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs mkHsQuasiQuote quoter span quote-  = HsQuasiQuote noExt unqualSplice quoter span quote+  = HsQuasiQuote noExtField unqualSplice quoter span quote  unqualQuasiQuote :: RdrName unqualQuasiQuote = mkRdrUnqual (mkVarOccFS (fsLit "quasiquote"))@@ -372,11 +372,11 @@ userHsLTyVarBndrs :: SrcSpan -> [Located (IdP (GhcPass p))]                   -> [LHsTyVarBndr (GhcPass p)] -- Caller sets location-userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt v) | v <- bndrs ]+userHsLTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField v) | v <- bndrs ]  userHsTyVarBndrs :: SrcSpan -> [IdP (GhcPass p)] -> [LHsTyVarBndr (GhcPass p)] -- Caller sets location-userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExt (cL loc v))+userHsTyVarBndrs loc bndrs = [ cL loc (UserTyVar noExtField (cL loc v))                              | v <- bndrs ]  @@ -389,26 +389,26 @@ -}  nlHsVar :: IdP (GhcPass id) -> LHsExpr (GhcPass id)-nlHsVar n = noLoc (HsVar noExt (noLoc n))+nlHsVar n = noLoc (HsVar noExtField (noLoc n))  -- NB: Only for LHsExpr **Id** nlHsDataCon :: DataCon -> LHsExpr GhcTc-nlHsDataCon con = noLoc (HsConLikeOut noExt (RealDataCon con))+nlHsDataCon con = noLoc (HsConLikeOut noExtField (RealDataCon con))  nlHsLit :: HsLit (GhcPass p) -> LHsExpr (GhcPass p)-nlHsLit n = noLoc (HsLit noExt n)+nlHsLit n = noLoc (HsLit noExtField n)  nlHsIntLit :: Integer -> LHsExpr (GhcPass p)-nlHsIntLit n = noLoc (HsLit noExt (HsInt noExt (mkIntegralLit n)))+nlHsIntLit n = noLoc (HsLit noExtField (HsInt noExtField (mkIntegralLit n)))  nlVarPat :: IdP (GhcPass id) -> LPat (GhcPass id)-nlVarPat n = noLoc (VarPat noExt (noLoc n))+nlVarPat n = noLoc (VarPat noExtField (noLoc n))  nlLitPat :: HsLit GhcPs -> LPat GhcPs-nlLitPat l = noLoc (LitPat noExt l)+nlLitPat l = noLoc (LitPat noExtField l)  nlHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)-nlHsApp f x = noLoc (HsApp noExt f (mkLHsPar x))+nlHsApp f x = noLoc (HsApp noExtField f (mkLHsPar x))  nlHsSyntaxApps :: SyntaxExpr (GhcPass id) -> [LHsExpr (GhcPass id)]                -> LHsExpr (GhcPass id)@@ -427,10 +427,10 @@ nlHsApps f xs = foldl' nlHsApp (nlHsVar f) xs  nlHsVarApps :: IdP (GhcPass id) -> [IdP (GhcPass id)] -> LHsExpr (GhcPass id)-nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExt (noLoc f))-                                               (map ((HsVar noExt) . noLoc) xs))+nlHsVarApps f xs = noLoc (foldl' mk (HsVar noExtField (noLoc f))+                                               (map ((HsVar noExtField) . noLoc) xs))                  where-                   mk f a = HsApp noExt (noLoc f) (noLoc a)+                   mk f a = HsApp noExtField (noLoc f) (noLoc a)  nlConVarPat :: RdrName -> [RdrName] -> LPat GhcPs nlConVarPat con vars = nlConPat con (map nlVarPat vars)@@ -460,10 +460,10 @@                                              nlWildPat)))  nlWildPat :: LPat GhcPs-nlWildPat  = noLoc (WildPat noExt )  -- Pre-typechecking+nlWildPat  = noLoc (WildPat noExtField )  -- Pre-typechecking  nlWildPatName :: LPat GhcRn-nlWildPatName  = noLoc (WildPat noExt )  -- Pre-typechecking+nlWildPatName  = noLoc (WildPat noExtField )  -- Pre-typechecking  nlHsDo :: HsStmtContext Name -> [LStmt GhcPs (LHsExpr GhcPs)]        -> LHsExpr GhcPs@@ -480,27 +480,27 @@          -> LHsExpr GhcPs nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs -nlHsLam match          = noLoc (HsLam noExt (mkMatchGroup Generated [match]))-nlHsPar e              = noLoc (HsPar noExt e)+nlHsLam match          = noLoc (HsLam noExtField (mkMatchGroup Generated [match]))+nlHsPar e              = noLoc (HsPar noExtField e)  -- Note [Rebindable nlHsIf] -- nlHsIf should generate if-expressions which are NOT subject to -- RebindableSyntax, so the first field of HsIf is Nothing. (#12080)-nlHsIf cond true false = noLoc (HsIf noExt Nothing cond true false)+nlHsIf cond true false = noLoc (HsIf noExtField Nothing cond true false)  nlHsCase expr matches-  = noLoc (HsCase noExt expr (mkMatchGroup Generated matches))-nlList exprs          = noLoc (ExplicitList noExt Nothing exprs)+  = noLoc (HsCase noExtField expr (mkMatchGroup Generated matches))+nlList exprs          = noLoc (ExplicitList noExtField Nothing exprs)  nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsTyVar :: IdP (GhcPass p)                            -> LHsType (GhcPass p) nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p) nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p) -nlHsAppTy f t = noLoc (HsAppTy noExt f (parenthesizeHsType appPrec t))-nlHsTyVar x   = noLoc (HsTyVar noExt NotPromoted (noLoc x))-nlHsFunTy a b = noLoc (HsFunTy noExt (parenthesizeHsType funPrec a) b)-nlHsParTy t   = noLoc (HsParTy noExt t)+nlHsAppTy f t = noLoc (HsAppTy noExtField f (parenthesizeHsType appPrec t))+nlHsTyVar x   = noLoc (HsTyVar noExtField NotPromoted (noLoc x))+nlHsFunTy a b = noLoc (HsFunTy noExtField (parenthesizeHsType funPrec a) b)+nlHsParTy t   = noLoc (HsParTy noExtField t)  nlHsTyConApp :: IdP (GhcPass p) -> [LHsType (GhcPass p)] -> LHsType (GhcPass p) nlHsTyConApp tycon tys  = foldl' nlHsAppTy (nlHsTyVar tycon) tys@@ -519,21 +519,21 @@ -- Makes a pre-typechecker boxed tuple, deals with 1 case mkLHsTupleExpr [e] = e mkLHsTupleExpr es-  = noLoc $ ExplicitTuple noExt (map (noLoc . (Present noExt)) es) Boxed+  = noLoc $ ExplicitTuple noExtField (map (noLoc . (Present noExtField)) es) Boxed  mkLHsVarTuple :: [IdP (GhcPass a)] -> LHsExpr (GhcPass a) mkLHsVarTuple ids  = mkLHsTupleExpr (map nlHsVar ids)  nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs-nlTuplePat pats box = noLoc (TuplePat noExt pats box)+nlTuplePat pats box = noLoc (TuplePat noExtField pats box)  missingTupArg :: HsTupArg GhcPs-missingTupArg = Missing noExt+missingTupArg = Missing noExtField  mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn-mkLHsPatTup []     = noLoc $ TuplePat noExt [] Boxed+mkLHsPatTup []     = noLoc $ TuplePat noExtField [] Boxed mkLHsPatTup [lpat] = lpat-mkLHsPatTup lpats  = cL (getLoc (head lpats)) $ TuplePat noExt lpats Boxed+mkLHsPatTup lpats  = cL (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed  -- The Big equivalents for the source tuple expressions mkBigLHsVarTup :: [IdP (GhcPass id)] -> LHsExpr (GhcPass id)@@ -637,7 +637,7 @@   = map fiddle sigs   where     fiddle (dL->L loc (TypeSig _ nms ty))-      = cL loc (ClassOpSig noExt False nms (dropWildCards ty))+      = cL loc (ClassOpSig noExtField False nms (dropWildCards ty))     fiddle sig = sig  typeToLHsType :: Type -> LHsType GhcPs@@ -655,25 +655,25 @@           VisArg   -> nlHsFunTy (go arg) (go res)           InvisArg | (theta, tau) <- tcSplitPhiTy ty                    -> noLoc (HsQualTy { hst_ctxt = noLoc (map go theta)-                                      , hst_xqual = noExt+                                      , hst_xqual = noExtField                                       , hst_body = go tau })      go ty@(ForAllTy (Bndr _ argf) _)       | (tvs, tau) <- tcSplitForAllTysSameVis argf ty       = noLoc (HsForAllTy { hst_fvf = argToForallVisFlag argf                           , hst_bndrs = map go_tv tvs-                          , hst_xforall = noExt+                          , hst_xforall = noExtField                           , hst_body = go tau })     go (TyVarTy tv)         = nlHsTyVar (getRdrName tv)     go (LitTy (NumTyLit n))-      = noLoc $ HsTyLit NoExt (HsNumTy NoSourceText n)+      = noLoc $ HsTyLit noExtField (HsNumTy NoSourceText n)     go (LitTy (StrTyLit s))-      = noLoc $ HsTyLit NoExt (HsStrTy NoSourceText s)+      = noLoc $ HsTyLit noExtField (HsStrTy NoSourceText s)     go ty@(TyConApp tc args)       | tyConAppNeedsKindSig True tc (length args)         -- We must produce an explicit kind signature here to make certain         -- programs kind-check. See Note [Kind signatures in typeToLHsType].-      = nlHsParTy $ noLoc $ HsKindSig NoExt ty' (go (tcTypeKind ty))+      = nlHsParTy $ noLoc $ HsKindSig noExtField ty' (go (tcTypeKind ty))       | otherwise = ty'        where         ty' :: LHsType GhcPs@@ -703,7 +703,7 @@              head (zip args arg_flags)      go_tv :: TyVar -> LHsTyVarBndr GhcPs-    go_tv tv = noLoc $ KindedTyVar noExt (noLoc (getRdrName tv))+    go_tv tv = noLoc $ KindedTyVar noExtField (noLoc (getRdrName tv))                                    (go (tyVarKind tv))  {-@@ -762,7 +762,7 @@ mkHsWrap :: HsWrapper -> HsExpr (GhcPass id) -> HsExpr (GhcPass id) mkHsWrap co_fn e | isIdHsWrapper co_fn = e mkHsWrap co_fn (HsWrap _ co_fn' e)     = mkHsWrap (co_fn <.> co_fn') e-mkHsWrap co_fn e                       = HsWrap noExt co_fn e+mkHsWrap co_fn e                       = HsWrap noExtField co_fn e  mkHsWrapCo :: TcCoercionN   -- A Nominal coercion  a ~N b            -> HsExpr (GhcPass id) -> HsExpr (GhcPass id)@@ -777,18 +777,18 @@  mkHsCmdWrap :: HsWrapper -> HsCmd (GhcPass p) -> HsCmd (GhcPass p) mkHsCmdWrap w cmd | isIdHsWrapper w = cmd-                  | otherwise       = HsCmdWrap noExt w cmd+                  | otherwise       = HsCmdWrap noExtField w cmd  mkLHsCmdWrap :: HsWrapper -> LHsCmd (GhcPass p) -> LHsCmd (GhcPass p) mkLHsCmdWrap w (dL->L loc c) = cL loc (mkHsCmdWrap w c)  mkHsWrapPat :: HsWrapper -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) mkHsWrapPat co_fn p ty | isIdHsWrapper co_fn = p-                       | otherwise           = CoPat noExt co_fn p ty+                       | otherwise           = CoPat noExtField co_fn p ty  mkHsWrapPatCo :: TcCoercionN -> Pat (GhcPass id) -> Type -> Pat (GhcPass id) mkHsWrapPatCo co pat ty | isTcReflCo co = pat-                        | otherwise    = CoPat noExt (mkWpCastN co) pat ty+                        | otherwise    = CoPat noExtField (mkWpCastN co) pat ty  mkHsDictLet :: TcEvBinds -> LHsExpr GhcTc -> LHsExpr GhcTc mkHsDictLet ev_binds expr = mkLHsWrap (mkWpLet ev_binds) expr@@ -808,7 +808,7 @@ mkFunBind fn ms = FunBind { fun_id = fn                           , fun_matches = mkMatchGroup Generated ms                           , fun_co_fn = idHsWrapper-                          , fun_ext = noExt+                          , fun_ext = noExtField                           , fun_tick = [] }  mkTopFunBind :: Origin -> Located Name -> [LMatch GhcRn (LHsExpr GhcRn)]@@ -826,14 +826,14 @@  mkVarBind :: IdP (GhcPass p) -> LHsExpr (GhcPass p) -> LHsBind (GhcPass p) mkVarBind var rhs = cL (getLoc rhs) $-                    VarBind { var_ext = noExt,+                    VarBind { var_ext = noExtField,                               var_id = var, var_rhs = rhs, var_inline = False }  mkPatSynBind :: Located RdrName -> HsPatSynDetails (Located RdrName)              -> LPat GhcPs -> HsPatSynDir GhcPs -> HsBind GhcPs-mkPatSynBind name details lpat dir = PatSynBind noExt psb+mkPatSynBind name details lpat dir = PatSynBind noExtField psb   where-    psb = PSB{ psb_ext = noExt+    psb = PSB{ psb_ext = noExtField              , psb_id = name              , psb_args = details              , psb_def = lpat@@ -867,13 +867,13 @@         -> Located (HsLocalBinds (GhcPass p))         -> LMatch (GhcPass p) (LHsExpr (GhcPass p)) mkMatch ctxt pats expr lbinds-  = noLoc (Match { m_ext   = noExt+  = noLoc (Match { m_ext   = noExtField                  , m_ctxt  = ctxt                  , m_pats  = map paren pats-                 , m_grhss = GRHSs noExt (unguardedRHS noSrcSpan expr) lbinds })+                 , m_grhss = GRHSs noExtField (unguardedRHS noSrcSpan expr) lbinds })   where     paren lp@(dL->L l p)-      | patNeedsParens appPrec p = cL l (ParPat noExt lp)+      | patNeedsParens appPrec p = cL l (ParPat noExtField lp)       | otherwise                = lp  {-@@ -1054,7 +1054,7 @@   collectArgBinders (_, ApplicativeArgOne _ pat _ _) = collectPatBinders pat   collectArgBinders (_, ApplicativeArgMany _ _ _ pat) = collectPatBinders pat   collectArgBinders _ = []-collectStmtBinders XStmtLR{} = panic "collectStmtBinders"+collectStmtBinders (XStmtLR nec) = noExtCon nec   ----------------- Patterns --------------------------@@ -1130,7 +1130,7 @@                           hs_fords = foreign_decls })   =  collectHsValBinders val_decls   ++ hsTyClForeignBinders tycl_decls foreign_decls-hsGroupBinders (XHsGroup {}) = panic "hsGroupBinders"+hsGroupBinders (XHsGroup nec) = noExtCon nec  hsTyClForeignBinders :: [TyClGroup GhcRn]                      -> [LForeignDecl GhcRn]@@ -1148,8 +1148,8 @@     getSelectorNames (ns, fs) = map unLoc ns ++ map (extFieldOcc . unLoc) fs  --------------------hsLTyClDeclBinders :: Located (TyClDecl pass)-                   -> ([Located (IdP pass)], [LFieldOcc pass])+hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p))+                   -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) -- ^ Returns all the /binding/ names of the decl.  The first one is -- guaranteed to be the name of the decl. The first component -- represents all binding names except record fields; the second@@ -1162,8 +1162,8 @@ hsLTyClDeclBinders (dL->L loc (FamDecl { tcdFam = FamilyDecl                                             { fdLName = (dL->L _ name) } }))   = ([cL loc name], [])-hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl _ }))-  = panic "hsLTyClDeclBinders"+hsLTyClDeclBinders (dL->L _ (FamDecl { tcdFam = XFamilyDecl nec }))+  = noExtCon nec hsLTyClDeclBinders (dL->L loc (SynDecl                                { tcdLName = (dL->L _ name) }))   = ([cL loc name], [])@@ -1181,7 +1181,7 @@ hsLTyClDeclBinders (dL->L loc (DataDecl    { tcdLName = (dL->L _ name)                                            , tcdDataDefn = defn }))   = (\ (xs, ys) -> (cL loc name : xs, ys)) $ hsDataDefnBinders defn-hsLTyClDeclBinders (dL->L _ (XTyClDecl _)) = panic "hsLTyClDeclBinders"+hsLTyClDeclBinders (dL->L _ (XTyClDecl nec)) = noExtCon nec hsLTyClDeclBinders _ = panic "hsLTyClDeclBinders: Impossible Match"                              -- due to #15884 @@ -1224,48 +1224,50 @@ hsLInstDeclBinders (dL->L _ (DataFamInstD { dfid_inst = fi }))   = hsDataFamInstBinders fi hsLInstDeclBinders (dL->L _ (TyFamInstD {})) = mempty-hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl {})))-  = panic "hsLInstDeclBinders"-hsLInstDeclBinders (dL->L _ (XInstDecl _))-  = panic "hsLInstDeclBinders"+hsLInstDeclBinders (dL->L _ (ClsInstD _ (XClsInstDecl nec)))+  = noExtCon nec+hsLInstDeclBinders (dL->L _ (XInstDecl nec))+  = noExtCon nec hsLInstDeclBinders _ = panic "hsLInstDeclBinders: Impossible Match"                              -- due to #15884  ------------------- -- the SrcLoc returned are for the whole declarations, not just the names-hsDataFamInstBinders :: DataFamInstDecl pass-                     -> ([Located (IdP pass)], [LFieldOcc pass])+hsDataFamInstBinders :: DataFamInstDecl (GhcPass p)+                     -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) hsDataFamInstBinders (DataFamInstDecl { dfid_eqn = HsIB { hsib_body =                        FamEqn { feqn_rhs = defn }}})   = hsDataDefnBinders defn   -- There can't be repeated symbols because only data instances have binders hsDataFamInstBinders (DataFamInstDecl-                                    { dfid_eqn = HsIB { hsib_body = XFamEqn _}})-  = panic "hsDataFamInstBinders"-hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs _))-  = panic "hsDataFamInstBinders"+                                    { dfid_eqn = HsIB { hsib_body = XFamEqn nec}})+  = noExtCon nec+hsDataFamInstBinders (DataFamInstDecl (XHsImplicitBndrs nec))+  = noExtCon nec  ------------------- -- the SrcLoc returned are for the whole declarations, not just the names-hsDataDefnBinders :: HsDataDefn pass -> ([Located (IdP pass)], [LFieldOcc pass])+hsDataDefnBinders :: HsDataDefn (GhcPass p)+                  -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)]) hsDataDefnBinders (HsDataDefn { dd_cons = cons })   = hsConDeclsBinders cons   -- See Note [Binders in family instances]-hsDataDefnBinders (XHsDataDefn _) = panic "hsDataDefnBinders"+hsDataDefnBinders (XHsDataDefn nec) = noExtCon nec  --------------------type Seen pass = [LFieldOcc pass] -> [LFieldOcc pass]+type Seen p = [LFieldOcc (GhcPass p)] -> [LFieldOcc (GhcPass p)]                  -- Filters out ones that have already been seen -hsConDeclsBinders :: [LConDecl pass] -> ([Located (IdP pass)], [LFieldOcc pass])+hsConDeclsBinders :: [LConDecl (GhcPass p)]+                  -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])    -- See hsLTyClDeclBinders for what this does    -- The function is boringly complicated because of the records    -- And since we only have equality, we have to be a little careful hsConDeclsBinders cons   = go id cons   where-    go :: Seen pass -> [LConDecl pass]-       -> ([Located (IdP pass)], [LFieldOcc pass])+    go :: Seen p -> [LConDecl (GhcPass p)]+       -> ([Located (IdP (GhcPass p))], [LFieldOcc (GhcPass p)])     go _ [] = ([], [])     go remSeen (r:rs)       -- Don't re-mangle the location of field names, because we don't@@ -1286,10 +1288,10 @@                 (remSeen', flds) = get_flds remSeen args                 (ns, fs) = go remSeen' rs -           XConDecl _ -> panic "hsConDeclsBinders"+           XConDecl nec -> noExtCon nec -    get_flds :: Seen pass -> HsConDeclDetails pass-             -> (Seen pass, [LFieldOcc pass])+    get_flds :: Seen p -> HsConDeclDetails (GhcPass p)+             -> (Seen p, [LFieldOcc (GhcPass p)])     get_flds remSeen (RecCon flds)        = (remSeen', fld_names)        where@@ -1355,7 +1357,7 @@     hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args       where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat             do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts-            do_arg (_, XApplicativeArg _) = panic "lStmtsImplicits"+            do_arg (_, XApplicativeArg nec) = noExtCon nec     hs_stmt (LetStmt _ binds)     = hs_local_binds (unLoc binds)     hs_stmt (BodyStmt {})         = []     hs_stmt (LastStmt {})         = []@@ -1363,7 +1365,7 @@                                                 , s <- ss]     hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts     hs_stmt (RecStmt { recS_stmts = ss })     = hs_lstmts ss-    hs_stmt (XStmtLR {})          = panic "lStmtsImplicits"+    hs_stmt (XStmtLR nec)         = noExtCon nec      hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds     hs_local_binds (HsIPBinds {})           = []

@@ -1075,7 +1075,7 @@ pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc pprUserIfaceForAll tvs    = sdocWithDynFlags $ \dflags ->-     -- See Note [When to print foralls]+     -- See Note [When to print foralls] in this module.      ppWhen (any tv_has_kind_var tvs              || any tv_is_required tvs              || gopt Opt_PrintExplicitForalls dflags) $

@@ -68,6 +68,7 @@ import VarEnv import VarSet import TyCoRep+import TyCoTidy ( tidyCo ) import Demand ( isTopSig )  import Data.Maybe ( catMaybes )

@@ -1,6 +1,6 @@ module ToIface where -import {-# SOURCE #-} TyCoRep+import {-# SOURCE #-} TyCoRep ( Type, TyLit, Coercion ) import {-# SOURCE #-} IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr                                , IfaceCoercion, IfaceTyLit, IfaceAppArgs ) import Var ( TyCoVarBinder )

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -O0 #-} {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} @@ -65,6 +66,7 @@         shouldUseHexWordLiterals,         positionIndependent,         optimisationFlags,+        setFlagsFromEnvFile,          Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays,         wayGeneralFlags, wayUnsetGeneralFlags,@@ -150,7 +152,7 @@         settings,         programName, projectVersion,         ghcUsagePath, ghciUsagePath, topDir, tmpDir,-        versionedAppDir,+        versionedAppDir, versionedFilePath,         extraGccViaCFlags, systemPackageConfig,         pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_dll, pgm_T,         pgm_windres, pgm_libtool, pgm_ar, pgm_ranlib, pgm_lo, pgm_lc,@@ -178,7 +180,6 @@         updOptLevel,         setTmpDir,         setUnitId,-        interpretPackageEnv,         canonicalizeHomeModule,         canonicalizeModuleIfHome, @@ -219,7 +220,6 @@         -- * SSE and AVX         isSseEnabled,         isSse2Enabled,-        isSse4_1Enabled,         isSse4_2Enabled,         isBmiEnabled,         isBmi2Enabled,@@ -250,6 +250,7 @@ import GhcPrelude  import GHC.Platform+import GHC.UniqueSubdir (uniqueSubdir) import PlatformConstants import Module import PackageConfig@@ -295,7 +296,6 @@ import Control.Monad.Trans.Writer import Control.Monad.Trans.Reader import Control.Monad.Trans.Except-import Control.Exception (throwIO)  import Data.Ord import Data.Bits@@ -309,7 +309,7 @@ import Data.Word import System.FilePath import System.Directory-import System.Environment (getEnv, lookupEnv)+import System.Environment (lookupEnv) import System.IO import System.IO.Error import Text.ParserCombinators.ReadP hiding (char)@@ -408,10 +408,13 @@    = Opt_D_dump_cmm    | Opt_D_dump_cmm_from_stg    | Opt_D_dump_cmm_raw-   | Opt_D_dump_cmm_verbose+   | Opt_D_dump_cmm_verbose_by_proc    -- All of the cmm subflags (there are a lot!) automatically-   -- enabled if you run -ddump-cmm-verbose+   -- enabled if you run -ddump-cmm-verbose-by-proc    -- Each flag corresponds to exact stage of Cmm pipeline.+   | Opt_D_dump_cmm_verbose+   -- same as -ddump-cmm-verbose-by-proc but writes each stage+   -- to a separate file (if used with -ddump-to-file)    | Opt_D_dump_cmm_cfg    | Opt_D_dump_cmm_cbe    | Opt_D_dump_cmm_switch@@ -1499,15 +1502,8 @@   appdir <- tryMaybeT $ getAppUserDataDirectory (programName dflags)   return $ appdir </> versionedFilePath dflags --- | A filepath like @x86_64-linux-7.6.3@ with the platform string to use when--- constructing platform-version-dependent files that need to co-exist.--- versionedFilePath :: DynFlags -> FilePath-versionedFilePath dflags =     TARGET_ARCH-                        ++ '-':TARGET_OS-                        ++ '-':projectVersion dflags-  -- NB: This functionality is reimplemented in Cabal, so if you-  -- change it, be sure to update Cabal.+versionedFilePath dflags = uniqueSubdir $ targetPlatform dflags  -- | The target code type of the compilation (if any). --@@ -3026,7 +3022,7 @@   , make_ord_flag defGhcFlag "rdynamic" $ noArg $ #if defined(linux_HOST_OS)                               addOptl "-rdynamic"-#elif defined (mingw32_HOST_OS)+#elif defined(mingw32_HOST_OS)                               addOptl "-Wl,--export-all-symbols" #else     -- ignored for compat w/ gcc:@@ -3310,6 +3306,8 @@         (setDumpFlag Opt_D_dump_cmm_raw)   , make_ord_flag defGhcFlag "ddump-cmm-verbose"         (setDumpFlag Opt_D_dump_cmm_verbose)+  , make_ord_flag defGhcFlag "ddump-cmm-verbose-by-proc"+        (setDumpFlag Opt_D_dump_cmm_verbose_by_proc)   , make_ord_flag defGhcFlag "ddump-cmm-cfg"         (setDumpFlag Opt_D_dump_cmm_cfg)   , make_ord_flag defGhcFlag "ddump-cmm-cbe"@@ -5272,170 +5270,6 @@                       then canonicalizeHomeModule dflags (moduleName mod)                       else mod ---- -------------------------------------------------------------------------------- | Find the package environment (if one exists)------ We interpret the package environment as a set of package flags; to be--- specific, if we find a package environment file like------ > clear-package-db--- > global-package-db--- > package-db blah/package.conf.d--- > package-id id1--- > package-id id2------ we interpret this as------ > [ -hide-all-packages--- > , -clear-package-db--- > , -global-package-db--- > , -package-db blah/package.conf.d--- > , -package-id id1--- > , -package-id id2--- > ]------ There's also an older syntax alias for package-id, which is just an--- unadorned package id------ > id1--- > id2----interpretPackageEnv :: DynFlags -> IO DynFlags-interpretPackageEnv dflags = do-    mPkgEnv <- runMaybeT $ msum $ [-                   getCmdLineArg >>= \env -> msum [-                       probeNullEnv env-                     , probeEnvFile env-                     , probeEnvName env-                     , cmdLineError env-                     ]-                 , getEnvVar >>= \env -> msum [-                       probeNullEnv env-                     , probeEnvFile env-                     , probeEnvName env-                     , envError     env-                     ]-                 , notIfHideAllPackages >> msum [-                       findLocalEnvFile >>= probeEnvFile-                     , probeEnvName defaultEnvName-                     ]-                 ]-    case mPkgEnv of-      Nothing ->-        -- No environment found. Leave DynFlags unchanged.-        return dflags-      Just "-" -> do-        -- Explicitly disabled environment file. Leave DynFlags unchanged.-        return dflags-      Just envfile -> do-        content <- readFile envfile-        putLogMsg dflags NoReason SevInfo noSrcSpan-             (defaultUserStyle dflags)-             (text ("Loaded package environment from " ++ envfile))-        let setFlags :: DynP ()-            setFlags = do-              setGeneralFlag Opt_HideAllPackages-              parseEnvFile envfile content--            (_, dflags') = runCmdLine (runEwM setFlags) dflags--        return dflags'-  where-    -- Loading environments (by name or by location)--    namedEnvPath :: String -> MaybeT IO FilePath-    namedEnvPath name = do-     appdir <- versionedAppDir dflags-     return $ appdir </> "environments" </> name--    probeEnvName :: String -> MaybeT IO FilePath-    probeEnvName name = probeEnvFile =<< namedEnvPath name--    probeEnvFile :: FilePath -> MaybeT IO FilePath-    probeEnvFile path = do-      guard =<< liftMaybeT (doesFileExist path)-      return path--    probeNullEnv :: FilePath -> MaybeT IO FilePath-    probeNullEnv "-" = return "-"-    probeNullEnv _   = mzero--    parseEnvFile :: FilePath -> String -> DynP ()-    parseEnvFile envfile = mapM_ parseEntry . lines-      where-        parseEntry str = case words str of-          ("package-db": _)     -> addPkgConfRef (PkgConfFile (envdir </> db))-            -- relative package dbs are interpreted relative to the env file-            where envdir = takeDirectory envfile-                  db     = drop 11 str-          ["clear-package-db"]  -> clearPkgConf-          ["global-package-db"] -> addPkgConfRef GlobalPkgConf-          ["user-package-db"]   -> addPkgConfRef UserPkgConf-          ["package-id", pkgid] -> exposePackageId pkgid-          (('-':'-':_):_)       -> return () -- comments-          -- and the original syntax introduced in 7.10:-          [pkgid]               -> exposePackageId pkgid-          []                    -> return ()-          _                     -> throwGhcException $ CmdLineError $-                                        "Can't parse environment file entry: "-                                     ++ envfile ++ ": " ++ str--    -- Various ways to define which environment to use--    getCmdLineArg :: MaybeT IO String-    getCmdLineArg = MaybeT $ return $ packageEnv dflags--    getEnvVar :: MaybeT IO String-    getEnvVar = do-      mvar <- liftMaybeT $ try $ getEnv "GHC_ENVIRONMENT"-      case mvar of-        Right var -> return var-        Left err  -> if isDoesNotExistError err then mzero-                                                else liftMaybeT $ throwIO err--    notIfHideAllPackages :: MaybeT IO ()-    notIfHideAllPackages =-      guard (not (gopt Opt_HideAllPackages dflags))--    defaultEnvName :: String-    defaultEnvName = "default"--    -- e.g. .ghc.environment.x86_64-linux-7.6.3-    localEnvFileName :: FilePath-    localEnvFileName = ".ghc.environment" <.> versionedFilePath dflags--    -- Search for an env file, starting in the current dir and looking upwards.-    -- Fail if we get to the users home dir or the filesystem root. That is,-    -- we don't look for an env file in the user's home dir. The user-wide-    -- env lives in ghc's versionedAppDir/environments/default-    findLocalEnvFile :: MaybeT IO FilePath-    findLocalEnvFile = do-        curdir  <- liftMaybeT getCurrentDirectory-        homedir <- tryMaybeT getHomeDirectory-        let probe dir | isDrive dir || dir == homedir-                      = mzero-            probe dir = do-              let file = dir </> localEnvFileName-              exists <- liftMaybeT (doesFileExist file)-              if exists-                then return file-                else probe (takeDirectory dir)-        probe curdir--    -- Error reporting--    cmdLineError :: String -> MaybeT IO a-    cmdLineError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $-      "Package environment " ++ show env ++ " not found"--    envError :: String -> MaybeT IO a-    envError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $-         "Package environment "-      ++ show env-      ++ " (specified in GHC_ENVIRONMENT) not found"-- -- If we're linking a binary, then only targets that produce object -- code are allowed (requests for other target types are ignored). setTarget :: HscTarget -> DynP ()@@ -5484,6 +5318,35 @@ addLdInputs :: Option -> DynFlags -> DynFlags addLdInputs p dflags = dflags{ldInputs = ldInputs dflags ++ [p]} +-- -----------------------------------------------------------------------------+-- Load dynflags from environment files.++setFlagsFromEnvFile :: FilePath -> String -> DynP ()+setFlagsFromEnvFile envfile content = do+  setGeneralFlag Opt_HideAllPackages+  parseEnvFile envfile content++parseEnvFile :: FilePath -> String -> DynP ()+parseEnvFile envfile = mapM_ parseEntry . lines+  where+    parseEntry str = case words str of+      ("package-db": _)     -> addPkgConfRef (PkgConfFile (envdir </> db))+        -- relative package dbs are interpreted relative to the env file+        where envdir = takeDirectory envfile+              db     = drop 11 str+      ["clear-package-db"]  -> clearPkgConf+      ["global-package-db"] -> addPkgConfRef GlobalPkgConf+      ["user-package-db"]   -> addPkgConfRef UserPkgConf+      ["package-id", pkgid] -> exposePackageId pkgid+      (('-':'-':_):_)       -> return () -- comments+      -- and the original syntax introduced in 7.10:+      [pkgid]               -> exposePackageId pkgid+      []                    -> return ()+      _                     -> throwGhcException $ CmdLineError $+                                    "Can't parse environment file entry: "+                                 ++ envfile ++ ": " ++ str++ ----------------------------------------------------------------------------- -- Paths & Libraries @@ -5503,7 +5366,7 @@ addFrameworkPath p =   upd (\s -> s{frameworkPaths = frameworkPaths s ++ splitPathList p}) -#if !defined(mingw32_TARGET_OS)+#if !defined(mingw32_HOST_OS) split_marker :: Char split_marker = ':'   -- not configurable (ToDo) #endif@@ -5515,7 +5378,7 @@                 -- cause confusion when they are translated into -I options                 -- for passing to gcc.   where-#if !defined(mingw32_TARGET_OS)+#if !defined(mingw32_HOST_OS)     splitUp xs = split split_marker xs #else      -- Windows: 'hybrid' support for DOS-style paths in directory lists.@@ -5700,7 +5563,7 @@        ("GHC Dynamic",                 showBool dynamicGhc),        -- Whether or not GHC was compiled using -prof        ("GHC Profiled",                showBool rtsIsProfiled),-       ("Debug on",                    show debugIsOn),+       ("Debug on",                    showBool debugIsOn),        ("LibDir",                      topDir dflags),        -- The path of the global package database used by GHC        ("Global Package DB",           systemPackageConfig dflags)@@ -5909,8 +5772,6 @@     ArchX86    -> True     _          -> False -isSse4_1Enabled :: DynFlags -> Bool-isSse4_1Enabled dflags = sseVersion dflags >= Just SSE4  isSse4_2Enabled :: DynFlags -> Bool isSse4_2Enabled dflags = sseVersion dflags >= Just SSE42

@@ -640,6 +640,8 @@ -- -- To avoid adversely affecting compiler performance when timings are not -- requested, the result is only forced when timings are enabled.+--+-- See Note [withTiming] for more. withTiming :: MonadIO m            => m DynFlags  -- ^ A means of getting a 'DynFlags' (often                           -- 'getDynFlags' will work here)@@ -749,3 +751,96 @@                                  <+> text cmd_line                                  <+> text (show exn))                               ; throwGhcExceptionIO (ProgramError (show exn))}++{- Note [withTiming]+~~~~~~~~~~~~~~~~~~~~++For reference:++  withTiming+    :: MonadIO+    => m DynFlags -- how to get the DynFlags+    -> SDoc       -- label for the computation we're timing+    -> (a -> ())  -- how to evaluate the result+    -> m a        -- computation we're timing+    -> m a++withTiming lets you run an action while:++(1) measuring the CPU time it took and reporting that on stderr,+(2) emitting start/stop events to GHC's event log, with the label+    given as an argument.++Evaluation of the result+------------------------++'withTiming' takes as an argument a function of type 'a -> ()', whose purpose is+to evaluate the result "sufficiently". A given pass might return an 'm a' for+some monad 'm' and result type 'a', but where the 'a' is complex enough+that evaluating it to WHNF barely scratches its surface and leaves many+complex and time-consuming computations unevaluated. Those would only be+forced by the next pass, and the time needed to evaluate them would be+mis-attributed to that next pass. A more appropriate function would be+one that deeply evaluates the result, so as to assign the time spent doing it+to the pass we're timing.++Note: as hinted at above, the time spent evaluating the application of the+forcing function to the result is included in the timings reported by+'withTiming'.++How we use it+-------------++We measure the time and allocations of various passes in GHC's pipeline by just+wrapping the whole pass with 'withTiming'. This also materializes by having+a label for each pass in the eventlog, where each pass is executed in one go,+during a continuous time window.++However, from STG onwards, the pipeline uses streams to emit groups of+STG/Cmm/etc declarations one at a time, and process them until we get to+assembly code generation. This means that the execution of those last few passes+is interleaved and that we cannot measure how long they take by just wrapping+the whole thing with 'withTiming'. Instead we wrap the processing of each+individual stream element, all along the codegen pipeline, using the appropriate+label for the pass to which this processing belongs. That generates a lot more+data but allows us to get fine-grained timings about all the passes and we can+easily compute totals withh tools like ghc-events-analyze (see below).+++Producing an eventlog for GHC+-----------------------------++To actually produce the eventlog, you need an eventlog-capable GHC build:++  With Hadrian:+  $ hadrian/build.sh -j "stage1.ghc-bin.ghc.link.opts += -eventlog"++  With Make:+  $ make -j GhcStage2HcOpts+=-eventlog++You can then produce an eventlog when compiling say hello.hs by simply+doing:++  If GHC was built by Hadrian:+  $ _build/stage1/bin/ghc -ddump-timings hello.hs -o hello +RTS -l++  If GHC was built with Make:+  $ inplace/bin/ghc-stage2 -ddump-timing hello.hs -o hello +RTS -l++You could alternatively use -v<N> (with N >= 2) instead of -ddump-timings,+to ask GHC to report timings (on stderr and the eventlog).++This will write the eventlog to ./ghc.eventlog in both cases. You can then+visualize it or look at the totals for each label by using ghc-events-analyze,+threadscope or any other eventlog consumer. Illustrating with+ghc-events-analyze:++  $ ghc-events-analyze --timed --timed-txt --totals \+                       --start "GHC:started:" --stop "GHC:finished:" \+                       ghc.eventlog++This produces ghc.timed.txt (all event timestamps), ghc.timed.svg (visualisation+of the execution through the various labels) and ghc.totals.txt (total time+spent in each label).++-}

@@ -127,7 +127,7 @@        preludeImportDecl :: LImportDecl GhcPs       preludeImportDecl-        = cL loc $ ImportDecl { ideclExt       = noExt,+        = cL loc $ ImportDecl { ideclExt       = noExtField,                                 ideclSourceSrc = NoSourceText,                                 ideclName      = cL loc pRELUDE_NAME,                                 ideclPkgQual   = Nothing,

@@ -33,7 +33,8 @@         ForeignSrcLang(..),         phaseForeignLanguage, -        ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, showModMsg, isBootSummary,+        ModSummary(..), ms_imps, ms_installed_mod, ms_mod_name, ms_home_imps,+        home_imps, ms_home_allimps, ms_home_srcimps, showModMsg, isBootSummary,         msHsFilePath, msHiFilePath, msObjFilePath,         SourceModified(..), isTemplateHaskellOrQQNonBoot, @@ -2799,6 +2800,28 @@   map mk_additional_import (dynFlagDependencies (ms_hspp_opts ms))   where     mk_additional_import mod_nm = (Nothing, noLoc mod_nm)++home_imps :: [(Maybe FastString, Located ModuleName)] -> [Located ModuleName]+home_imps imps = [ lmodname |  (mb_pkg, lmodname) <- imps,+                                  isLocal mb_pkg ]+  where isLocal Nothing = True+        isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special+        isLocal _ = False++ms_home_allimps :: ModSummary -> [ModuleName]+ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms)++-- | Like 'ms_home_imps', but for SOURCE imports.+ms_home_srcimps :: ModSummary -> [Located ModuleName]+ms_home_srcimps = home_imps . ms_srcimps++-- | All of the (possibly) home module imports from a+-- 'ModSummary'; that is to say, each of these module names+-- could be a home import if an appropriately named file+-- existed.  (This is in contrast to package qualified+-- imports, which are guaranteed not to be home imports.)+ms_home_imps :: ModSummary -> [Located ModuleName]+ms_home_imps = home_imps . ms_imps  -- The ModLocation contains both the original source filename and the -- filename of the cleaned-up source file after all preprocessing has been

@@ -80,15 +80,18 @@ import GHC.Platform import Outputable import Maybes+import CmdLineParser  import System.Environment ( getEnv ) import FastString-import ErrUtils         ( debugTraceMsg, MsgDoc, dumpIfSet_dyn )+import ErrUtils         ( debugTraceMsg, MsgDoc, dumpIfSet_dyn, compilationProgressMsg,+                          withTiming ) import Exception  import System.Directory import System.FilePath as FilePath import qualified System.FilePath.Posix as FilePath.Posix+import System.IO.Error  ( isDoesNotExistError ) import Control.Monad import Data.Graph (stronglyConnComp, SCC(..)) import Data.Char ( toUpper )@@ -466,7 +469,9 @@ -- 'pkgState' in 'DynFlags' and return a list of packages to -- link in. initPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])-initPackages dflags0 = do+initPackages dflags0 = withTiming (return dflags0)+                                  (text "initializing package database")+                                  forcePkgDb $ do   dflags <- interpretPackageEnv dflags0   pkg_db <-     case pkgDatabase dflags of@@ -479,6 +484,8 @@                   pkgState = pkg_state,                   thisUnitIdInsts_ = insts },           preload)+  where+    forcePkgDb (dflags, _) = pkgIdMap (pkgState dflags) `seq` ()  -- ----------------------------------------------------------------------------- -- Reading the package database(s)@@ -2193,3 +2200,138 @@ -- in the @hs-boot@ loop-breaker. getPackageConfigMap :: DynFlags -> PackageConfigMap getPackageConfigMap = pkgIdMap . pkgState++-- -----------------------------------------------------------------------------+-- | Find the package environment (if one exists)+--+-- We interpret the package environment as a set of package flags; to be+-- specific, if we find a package environment file like+--+-- > clear-package-db+-- > global-package-db+-- > package-db blah/package.conf.d+-- > package-id id1+-- > package-id id2+--+-- we interpret this as+--+-- > [ -hide-all-packages+-- > , -clear-package-db+-- > , -global-package-db+-- > , -package-db blah/package.conf.d+-- > , -package-id id1+-- > , -package-id id2+-- > ]+--+-- There's also an older syntax alias for package-id, which is just an+-- unadorned package id+--+-- > id1+-- > id2+--+interpretPackageEnv :: DynFlags -> IO DynFlags+interpretPackageEnv dflags = do+    mPkgEnv <- runMaybeT $ msum $ [+                   getCmdLineArg >>= \env -> msum [+                       probeNullEnv env+                     , probeEnvFile env+                     , probeEnvName env+                     , cmdLineError env+                     ]+                 , getEnvVar >>= \env -> msum [+                       probeNullEnv env+                     , probeEnvFile env+                     , probeEnvName env+                     , envError     env+                     ]+                 , notIfHideAllPackages >> msum [+                       findLocalEnvFile >>= probeEnvFile+                     , probeEnvName defaultEnvName+                     ]+                 ]+    case mPkgEnv of+      Nothing ->+        -- No environment found. Leave DynFlags unchanged.+        return dflags+      Just "-" -> do+        -- Explicitly disabled environment file. Leave DynFlags unchanged.+        return dflags+      Just envfile -> do+        content <- readFile envfile+        compilationProgressMsg dflags ("Loaded package environment from " ++ envfile)+        let (_, dflags') = runCmdLine (runEwM (setFlagsFromEnvFile envfile content)) dflags++        return dflags'+  where+    -- Loading environments (by name or by location)++    namedEnvPath :: String -> MaybeT IO FilePath+    namedEnvPath name = do+     appdir <- versionedAppDir dflags+     return $ appdir </> "environments" </> name++    probeEnvName :: String -> MaybeT IO FilePath+    probeEnvName name = probeEnvFile =<< namedEnvPath name++    probeEnvFile :: FilePath -> MaybeT IO FilePath+    probeEnvFile path = do+      guard =<< liftMaybeT (doesFileExist path)+      return path++    probeNullEnv :: FilePath -> MaybeT IO FilePath+    probeNullEnv "-" = return "-"+    probeNullEnv _   = mzero++    -- Various ways to define which environment to use++    getCmdLineArg :: MaybeT IO String+    getCmdLineArg = MaybeT $ return $ packageEnv dflags++    getEnvVar :: MaybeT IO String+    getEnvVar = do+      mvar <- liftMaybeT $ try $ getEnv "GHC_ENVIRONMENT"+      case mvar of+        Right var -> return var+        Left err  -> if isDoesNotExistError err then mzero+                                                else liftMaybeT $ throwIO err++    notIfHideAllPackages :: MaybeT IO ()+    notIfHideAllPackages =+      guard (not (gopt Opt_HideAllPackages dflags))++    defaultEnvName :: String+    defaultEnvName = "default"++    -- e.g. .ghc.environment.x86_64-linux-7.6.3+    localEnvFileName :: FilePath+    localEnvFileName = ".ghc.environment" <.> versionedFilePath dflags++    -- Search for an env file, starting in the current dir and looking upwards.+    -- Fail if we get to the users home dir or the filesystem root. That is,+    -- we don't look for an env file in the user's home dir. The user-wide+    -- env lives in ghc's versionedAppDir/environments/default+    findLocalEnvFile :: MaybeT IO FilePath+    findLocalEnvFile = do+        curdir  <- liftMaybeT getCurrentDirectory+        homedir <- tryMaybeT getHomeDirectory+        let probe dir | isDrive dir || dir == homedir+                      = mzero+            probe dir = do+              let file = dir </> localEnvFileName+              exists <- liftMaybeT (doesFileExist file)+              if exists+                then return file+                else probe (takeDirectory dir)+        probe curdir++    -- Error reporting++    cmdLineError :: String -> MaybeT IO a+    cmdLineError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $+      "Package environment " ++ show env ++ " not found"++    envError :: String -> MaybeT IO a+    envError env = liftMaybeT . throwGhcExceptionIO . CmdLineError $+         "Package environment "+      ++ show env+      ++ " (specified in GHC_ENVIRONMENT) not found"

@@ -1,5 +1,10 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-}++-- | Definitions for writing /plugins/ for GHC. Plugins can hook into+-- several areas of the compiler. See the 'Plugin' type. These plugins+-- include type-checker plugins, source plugins, and core-to-core plugins.+ module Plugins (       -- * Plugins       Plugin(..)

@@ -131,10 +131,10 @@ import Util import ApiAnnotation import Data.List-import DynFlags ( WarningFlag(..) )+import DynFlags ( WarningFlag(..), DynFlags )+import ErrUtils ( Messages )  import Control.Monad-import Control.Monad.Trans.Reader import Text.ParserCombinators.ReadP as ReadP import Data.Char import qualified Data.Monoid as Monoid@@ -160,10 +160,10 @@ --         *** See Note [The Naming story] in HsDecls ****  mkTyClD :: LTyClDecl (GhcPass p) -> LHsDecl (GhcPass p)-mkTyClD (dL->L loc d) = cL loc (TyClD noExt d)+mkTyClD (dL->L loc d) = cL loc (TyClD noExtField d)  mkInstD :: LInstDecl (GhcPass p) -> LHsDecl (GhcPass p)-mkInstD (dL->L loc d) = cL loc (InstD noExt d)+mkInstD (dL->L loc d) = cL loc (InstD noExtField d)  mkClassDecl :: SrcSpan             -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs)@@ -178,7 +178,7 @@        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan        ; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams        ; addAnnsAt loc annst -- Add any API Annotations to the top SrcSpan-       ; return (cL loc (ClassDecl { tcdCExt = noExt, tcdCtxt = cxt+       ; return (cL loc (ClassDecl { tcdCExt = noExtField, tcdCtxt = cxt                                    , tcdLName = cls, tcdTyVars = tyvars                                    , tcdFixity = fixity                                    , tcdFDs = snd (unLoc fds)@@ -202,7 +202,7 @@        ; (tyvars, anns) <- checkTyVars (ppr new_or_data) equalsDots tc tparams        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv-       ; return (cL loc (DataDecl { tcdDExt = noExt,+       ; return (cL loc (DataDecl { tcdDExt = noExtField,                                     tcdLName = tc, tcdTyVars = tyvars,                                     tcdFixity = fixity,                                     tcdDataDefn = defn })) }@@ -217,7 +217,7 @@ mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv   = do { checkDatatypeContext mcxt        ; let cxt = fromMaybe (noLoc []) mcxt-       ; return (HsDataDefn { dd_ext = noExt+       ; return (HsDataDefn { dd_ext = noExtField                             , dd_ND = new_or_data, dd_cType = cType                             , dd_ctxt = cxt                             , dd_cons = data_cons@@ -234,7 +234,7 @@        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan        ; (tyvars, anns) <- checkTyVars (text "type") equalsDots tc tparams        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan-       ; return (cL loc (SynDecl { tcdSExt = noExt+       ; return (cL loc (SynDecl { tcdSExt = noExtField                                  , tcdLName = tc, tcdTyVars = tyvars                                  , tcdFixity = fixity                                  , tcdRhs = rhs })) }@@ -246,7 +246,7 @@ mkTyFamInstEqn bndrs lhs rhs   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs        ; return (mkHsImplicitBndrs-                  (FamEqn { feqn_ext    = noExt+                  (FamEqn { feqn_ext    = noExtField                           , feqn_tycon  = tc                           , feqn_bndrs  = bndrs                           , feqn_pats   = tparams@@ -266,10 +266,10 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr)               ksig data_cons maybe_deriv   = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr-       ; mapM_ (\a -> a loc) ann -- Add any API Annotations to the top SrcSpan+       ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan        ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv-       ; return (cL loc (DataFamInstD noExt (DataFamInstDecl (mkHsImplicitBndrs-                  (FamEqn { feqn_ext    = noExt+       ; return (cL loc (DataFamInstD noExtField (DataFamInstDecl (mkHsImplicitBndrs+                  (FamEqn { feqn_ext    = noExtField                           , feqn_tycon  = tc                           , feqn_bndrs  = bndrs                           , feqn_pats   = tparams@@ -280,7 +280,7 @@             -> TyFamInstEqn GhcPs             -> P (LInstDecl GhcPs) mkTyFamInst loc eqn-  = return (cL loc (TyFamInstD noExt (TyFamInstDecl eqn)))+  = return (cL loc (TyFamInstD noExtField (TyFamInstDecl eqn)))  mkFamDecl :: SrcSpan           -> FamilyInfo GhcPs@@ -293,8 +293,8 @@        ; addAnnsAt loc ann -- Add any API Annotations to the top SrcSpan        ; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams        ; addAnnsAt loc anns -- Add any API Annotations to the top SrcSpan-       ; return (cL loc (FamDecl noExt (FamilyDecl-                                           { fdExt       = noExt+       ; return (cL loc (FamDecl noExtField (FamilyDecl+                                           { fdExt       = noExtField                                            , fdInfo      = info, fdLName = tc                                            , fdTyVars    = tyvars                                            , fdFixity    = fixity@@ -318,13 +318,13 @@ -- as spliced declaration.  See #10945 mkSpliceDecl lexpr@(dL->L loc expr)   | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr-  = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)+  = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice)    | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr-  = SpliceD noExt (SpliceDecl noExt (cL loc splice) ExplicitSplice)+  = SpliceD noExtField (SpliceDecl noExtField (cL loc splice) ExplicitSplice)    | otherwise-  = SpliceD noExt (SpliceDecl noExt (cL loc (mkUntypedSplice NoParens lexpr))+  = SpliceD noExtField (SpliceDecl noExtField (cL loc (mkUntypedSplice NoParens lexpr))                               ImplicitSplice)  mkRoleAnnotDecl :: SrcSpan@@ -333,7 +333,7 @@                 -> P (LRoleAnnotDecl GhcPs) mkRoleAnnotDecl loc tycon roles   = do { roles' <- mapM parse_role roles-       ; return $ cL loc $ RoleAnnotDecl noExt tycon roles' }+       ; return $ cL loc $ RoleAnnotDecl noExtField tycon roles' }   where     role_data_type = dataTypeOf (undefined :: Role)     all_roles = map fromConstr $ dataTypeConstrs role_data_type@@ -387,7 +387,7 @@   = do { (mbs, sigs, fam_ds, tfam_insts          , dfam_insts, _) <- cvBindsAndSigs binding        ; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)-         return $ ValBinds noExt mbs sigs }+         return $ ValBinds noExtField mbs sigs }  cvBindsAndSigs :: OrdList (LHsDecl GhcPs)   -> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]@@ -473,7 +473,7 @@         -- no arguments.  This is necessary now that variable bindings         -- with no arguments are now treated as FunBinds rather         -- than pattern bindings (tests/rename/should_fail/rnfail002).-has_args ((dL->L _ (XMatch _)) : _) = panic "has_args"+has_args ((dL->L _ (XMatch nec)) : _) = noExtCon nec has_args (_ : _) = panic "has_args:Impossible Match" -- due to #15884  {- **********************************************************************@@ -588,7 +588,7 @@         do { unless (name == patsyn_name) $                wrongNameBindingErr loc decl            ; match <- case details of-               PrefixCon pats -> return $ Match { m_ext = noExt+               PrefixCon pats -> return $ Match { m_ext = noExtField                                                 , m_ctxt = ctxt, m_pats = pats                                                 , m_grhss = rhs }                    where@@ -596,7 +596,7 @@                                    , mc_fixity = Prefix                                    , mc_strictness = NoSrcStrict } -               InfixCon p1 p2 -> return $ Match { m_ext = noExt+               InfixCon p1 p2 -> return $ Match { m_ext = noExtField                                                 , m_ctxt = ctxt                                                 , m_pats = [p1, p2]                                                 , m_grhss = rhs }@@ -635,7 +635,7 @@                 -> ConDecl GhcPs  mkConDeclH98 name mb_forall mb_cxt args-  = ConDeclH98 { con_ext    = noExt+  = ConDeclH98 { con_ext    = noExtField                , con_name   = name                , con_forall = noLoc $ isJust mb_forall                , con_ex_tvs = mb_forall `orElse` []@@ -647,7 +647,7 @@            -> LHsType GhcPs     -- Always a HsForAllTy            -> (ConDecl GhcPs, [AddAnn]) mkGadtDecl names ty-  = (ConDeclGADT { con_g_ext  = noExt+  = (ConDeclGADT { con_g_ext  = noExtField                  , con_names  = names                  , con_forall = cL l $ isLHsForAllTy ty'                  , con_qvars  = mkHsQTvs tvs@@ -809,9 +809,9 @@         -- Check that the name space is correct!     chk :: LHsType GhcPs -> P (LHsTyVarBndr GhcPs)     chk (dL->L l (HsKindSig _ (dL->L lv (HsTyVar _ _ (dL->L _ tv))) k))-        | isRdrTyVar tv    = return (cL l (KindedTyVar noExt (cL lv tv) k))+        | isRdrTyVar tv    = return (cL l (KindedTyVar noExtField (cL lv tv) k))     chk (dL->L l (HsTyVar _ _ (dL->L ltv tv)))-        | isRdrTyVar tv    = return (cL l (UserTyVar noExt (cL ltv tv)))+        | isRdrTyVar tv    = return (cL l (UserTyVar noExtField (cL ltv tv)))     chk t@(dL->L loc _)         = addFatalError loc $                 vcat [ text "Unexpected type" <+> quotes (ppr t)@@ -853,16 +853,16 @@ -- turns RuleTyTmVars into RuleBnrs - this is straightforward mkRuleBndrs :: [LRuleTyTmVar] -> [LRuleBndr GhcPs] mkRuleBndrs = fmap (fmap cvt_one)-  where cvt_one (RuleTyTmVar v Nothing)    = RuleBndr    noExt v+  where cvt_one (RuleTyTmVar v Nothing)    = RuleBndr    noExtField v         cvt_one (RuleTyTmVar v (Just sig)) =-          RuleBndrSig noExt v (mkLHsSigWcType sig)+          RuleBndrSig noExtField v (mkLHsSigWcType sig)  -- turns RuleTyTmVars into HsTyVarBndrs - this is more interesting mkRuleTyVarBndrs :: [LRuleTyTmVar] -> [LHsTyVarBndr GhcPs] mkRuleTyVarBndrs = fmap (fmap cvt_one)-  where cvt_one (RuleTyTmVar v Nothing)    = UserTyVar   noExt (fmap tm_to_ty v)+  where cvt_one (RuleTyTmVar v Nothing)    = UserTyVar   noExtField (fmap tm_to_ty v)         cvt_one (RuleTyTmVar v (Just sig))-          = KindedTyVar noExt (fmap tm_to_ty v) sig+          = KindedTyVar noExtField (fmap tm_to_ty v) sig     -- takes something in namespace 'varName' to something in namespace 'tvName'         tm_to_ty (Unqual occ) = Unqual (setOccNameSpace tvName occ)         tm_to_ty _ = panic "mkRuleTyVarBndrs"@@ -1082,7 +1082,7 @@  nPlusKPatterns <- getBit NPlusKPatternsBit  case e0 of    PatBuilderPat p -> return p-   PatBuilderVar x -> return (VarPat noExt x)+   PatBuilderVar x -> return (VarPat noExtField x)     -- Overloaded numeric patterns (e.g. f 0 x = x)    -- Negation is recorded separately, so that the literal is zero or +ve@@ -1093,7 +1093,7 @@         -> do { hintBangPat loc e0               ; e' <- checkLPat e               ; addAnnotation loc AnnBang lb-              ; return  (BangPat noExt e') }+              ; return  (BangPat noExtField e') }     -- n+k patterns    PatBuilderOpApp@@ -1109,7 +1109,7 @@          r <- checkLPat r          return (ConPatIn (cL cl c) (InfixCon l r)) -   PatBuilderPar e    -> checkLPat e >>= (return . (ParPat noExt))+   PatBuilderPar e    -> checkLPat e >>= (return . (ParPat noExtField))    _           -> patFail loc (ppr e0)  placeHolderPunRhs :: DisambECP b => PV (Located b)@@ -1176,7 +1176,7 @@         -- Add back the annotations stripped from any HsPar values in the lhs         -- mapM_ (\a -> a match_span) ann         return (ann, makeFunBind fun-                  [cL match_span (Match { m_ext = noExt+                  [cL match_span (Match { m_ext = noExtField                                         , m_ctxt = FunRhs                                             { mc_fun    = fun                                             , mc_fixity = is_infix@@ -1190,7 +1190,7 @@             -> HsBind GhcPs -- Like HsUtils.mkFunBind, but we need to be able to set the fixity too makeFunBind fn ms-  = FunBind { fun_ext = noExt,+  = FunBind { fun_ext = noExtField,               fun_id = fn,               fun_matches = mkMatchGroup FromSource ms,               fun_co_fn = idHsWrapper,@@ -1200,7 +1200,7 @@              -> Located (a,GRHSs GhcPs (LHsExpr GhcPs))              -> P ([AddAnn],HsBind GhcPs) checkPatBind lhs (dL->L _ (_,grhss))-  = return ([],PatBind noExt lhs grhss ([],[]))+  = return ([],PatBind noExtField lhs grhss ([],[]))  checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName) checkValSigLhs (dL->L _ (HsVar _ lrdr@(dL->L _ v)))@@ -1374,12 +1374,12 @@   | Just (strAnnId, str) <- tyElStrictness x1   , TyElUnpackedness (unpkAnns, prag, unpk) <- x2   = Just ( cL (combineSrcSpans l1 l2) (HsSrcBang prag unpk str)-         , unpkAnns ++ [\s -> addAnnotation s strAnnId l1]+         , unpkAnns ++ [AddAnn strAnnId l1]          , xs ) pStrictMark ((dL->L l x1) : xs)   | Just (strAnnId, str) <- tyElStrictness x1   = Just ( cL l (HsSrcBang NoSourceText NoSrcUnpack str)-         , [\s -> addAnnotation s strAnnId l]+         , [AddAnn strAnnId l]          , xs ) pStrictMark ((dL->L l x1) : xs)   | TyElUnpackedness (anns, prag, unpk) <- x1@@ -1400,7 +1400,7 @@     Nothing -> (False, lt, pure (), xs)     Just (dL->L l2 strictMark, anns, xs') ->       let bl = combineSrcSpans l1 l2-          bt = HsBangTy noExt strictMark lt+          bt = HsBangTy noExtField strictMark lt       in (True, cL bl bt, addAnnsAt bl anns, xs')  -- | Merge a /reversed/ and /non-empty/ soup of operators and operands@@ -1433,7 +1433,7 @@               ; let a = ops_acc acc'                     strictMark = HsSrcBang unpkSrc unpk NoSrcStrict                     bl = combineSrcSpans l (getLoc a)-                    bt = HsBangTy noExt strictMark a+                    bt = HsBangTy noExtField strictMark a               ; addAnnsAt bl anns               ; return (cL bl bt) }       else addFatalError l unpkError@@ -1841,8 +1841,8 @@   mkHsInfixHolePV :: SrcSpan -> PV (Located b)  instance p ~ GhcPs => DisambInfixOp (HsExpr p) where-  mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExt v)-  mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExt v)+  mkHsVarOpPV v = return $ cL (getLoc v) (HsVar noExtField v)+  mkHsConOpPV v = return $ cL (getLoc v) (HsVar noExtField v)   mkHsInfixHolePV l = return $ cL l hsHoleExpr  instance DisambInfixOp RdrName where@@ -1973,25 +1973,25 @@   type Body (HsCmd p) = HsCmd   ecpFromCmd' = return   ecpFromExp' (dL-> L l e) = cmdFail l (ppr e)-  mkHsLamPV l mg = return $ cL l (HsCmdLam noExt mg)-  mkHsLetPV l bs e = return $ cL l (HsCmdLet noExt bs e)+  mkHsLamPV l mg = return $ cL l (HsCmdLam noExtField mg)+  mkHsLetPV l bs e = return $ cL l (HsCmdLet noExtField bs e)   type InfixOp (HsCmd p) = HsExpr p   superInfixOp m = m   mkHsOpAppPV l c1 op c2 = do-    let cmdArg c = cL (getLoc c) $ HsCmdTop noExt c-    return $ cL l $ HsCmdArrForm noExt op Infix Nothing [cmdArg c1, cmdArg c2]-  mkHsCasePV l c mg = return $ cL l (HsCmdCase noExt c mg)+    let cmdArg c = cL (getLoc c) $ HsCmdTop noExtField c+    return $ cL l $ HsCmdArrForm noExtField op Infix Nothing [cmdArg c1, cmdArg c2]+  mkHsCasePV l c mg = return $ cL l (HsCmdCase noExtField c mg)   type FunArg (HsCmd p) = HsExpr p   superFunArg m = m   mkHsAppPV l c e = do     checkCmdBlockArguments c     checkExpBlockArguments e-    return $ cL l (HsCmdApp noExt c e)+    return $ cL l (HsCmdApp noExtField c e)   mkHsIfPV l c semi1 a semi2 b = do     checkDoAndIfThenElse c semi1 a semi2 b     return $ cL l (mkHsCmdIf c a b)-  mkHsDoPV l stmts = return $ cL l (HsCmdDo noExt stmts)-  mkHsParPV l c = return $ cL l (HsCmdPar noExt c)+  mkHsDoPV l stmts = return $ cL l (HsCmdDo noExtField stmts)+  mkHsParPV l c = return $ cL l (HsCmdPar noExtField c)   mkHsVarPV (dL->L l v) = cmdFail l (ppr v)   mkHsLitPV (dL->L l a) = cmdFail l (ppr a)   mkHsOverLitPV (dL->L l a) = cmdFail l (ppr a)@@ -2027,36 +2027,36 @@         nest 2 (ppr c) ]     return (cL l hsHoleExpr)   ecpFromExp' = return-  mkHsLamPV l mg = return $ cL l (HsLam noExt mg)-  mkHsLetPV l bs c = return $ cL l (HsLet noExt bs c)+  mkHsLamPV l mg = return $ cL l (HsLam noExtField mg)+  mkHsLetPV l bs c = return $ cL l (HsLet noExtField bs c)   type InfixOp (HsExpr p) = HsExpr p   superInfixOp m = m   mkHsOpAppPV l e1 op e2 = do-    return $ cL l $ OpApp noExt e1 op e2-  mkHsCasePV l e mg = return $ cL l (HsCase noExt e mg)+    return $ cL l $ OpApp noExtField e1 op e2+  mkHsCasePV l e mg = return $ cL l (HsCase noExtField e mg)   type FunArg (HsExpr p) = HsExpr p   superFunArg m = m   mkHsAppPV l e1 e2 = do     checkExpBlockArguments e1     checkExpBlockArguments e2-    return $ cL l (HsApp noExt e1 e2)+    return $ cL l (HsApp noExtField e1 e2)   mkHsIfPV l c semi1 a semi2 b = do     checkDoAndIfThenElse c semi1 a semi2 b     return $ cL l (mkHsIf c a b)-  mkHsDoPV l stmts = return $ cL l (HsDo noExt DoExpr stmts)-  mkHsParPV l e = return $ cL l (HsPar noExt e)-  mkHsVarPV v@(getLoc -> l) = return $ cL l (HsVar noExt v)-  mkHsLitPV (dL->L l a) = return $ cL l (HsLit noExt a)-  mkHsOverLitPV (dL->L l a) = return $ cL l (HsOverLit noExt a)+  mkHsDoPV l stmts = return $ cL l (HsDo noExtField DoExpr stmts)+  mkHsParPV l e = return $ cL l (HsPar noExtField e)+  mkHsVarPV v@(getLoc -> l) = return $ cL l (HsVar noExtField v)+  mkHsLitPV (dL->L l a) = return $ cL l (HsLit noExtField a)+  mkHsOverLitPV (dL->L l a) = return $ cL l (HsOverLit noExtField a)   mkHsWildCardPV l = return $ cL l hsHoleExpr-  mkHsTySigPV l a sig = return $ cL l (ExprWithTySig noExt a (mkLHsSigWcType sig))-  mkHsExplicitListPV l xs = return $ cL l (ExplicitList noExt Nothing xs)-  mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExt) sp+  mkHsTySigPV l a sig = return $ cL l (ExprWithTySig noExtField a (mkLHsSigWcType sig))+  mkHsExplicitListPV l xs = return $ cL l (ExplicitList noExtField Nothing xs)+  mkHsSplicePV sp = return $ mapLoc (HsSpliceE noExtField) sp   mkHsRecordPV l lrec a (fbinds, ddLoc) = do     r <- mkRecConstrOrUpdate a lrec (fbinds, ddLoc)     checkRecordSyntax (cL l r)-  mkHsNegAppPV l a = return $ cL l (NegApp noExt a noSyntaxExpr)-  mkHsSectionR_PV l op e = return $ cL l (SectionR noExt op e)+  mkHsNegAppPV l a = return $ cL l (NegApp noExtField a noSyntaxExpr)+  mkHsSectionR_PV l op e = return $ cL l (SectionR noExtField op e)   mkHsViewPatPV l a b = patSynErr l (ppr a <+> text "->" <+> ppr b) empty   mkHsAsPatPV l v e = do     opt_TypeApplications <- getBit TypeApplicationsBit@@ -2077,7 +2077,7 @@      ; return (cL l hsHoleExpr) }  hsHoleExpr :: HsExpr (GhcPass id)-hsHoleExpr = HsUnboundVar noExt (TrueExprHole (mkVarOcc "_"))+hsHoleExpr = HsUnboundVar noExtField (TrueExprHole (mkVarOcc "_"))  -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder] data PatBuilder p@@ -2130,16 +2130,16 @@   mkHsVarPV v@(getLoc -> l) = return $ cL l (PatBuilderVar v)   mkHsLitPV lit@(dL->L l a) = do     checkUnboxedStringLitPat lit-    return $ cL l (PatBuilderPat (LitPat noExt a))+    return $ cL l (PatBuilderPat (LitPat noExtField a))   mkHsOverLitPV (dL->L l a) = return $ cL l (PatBuilderOverLit a)-  mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExt))+  mkHsWildCardPV l = return $ cL l (PatBuilderPat (WildPat noExtField))   mkHsTySigPV l b sig = do     p <- checkLPat b-    return $ cL l (PatBuilderPat (SigPat noExt p (mkLHsSigWcType sig)))+    return $ cL l (PatBuilderPat (SigPat noExtField p (mkLHsSigWcType sig)))   mkHsExplicitListPV l xs = do     ps <- traverse checkLPat xs-    return (cL l (PatBuilderPat (ListPat noExt ps)))-  mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExt sp))+    return (cL l (PatBuilderPat (ListPat noExtField ps)))+  mkHsSplicePV (dL->L l sp) = return $ cL l (PatBuilderPat (SplicePat noExtField sp))   mkHsRecordPV l _ a (fbinds, ddLoc) = do     r <- mkPatRec a (mk_rec_fields fbinds ddLoc)     checkRecordSyntax (cL l r)@@ -2153,13 +2153,13 @@     | otherwise = patFail l (pprInfixOcc (unLoc op) <> ppr p)   mkHsViewPatPV l a b = do     p <- checkLPat b-    return $ cL l (PatBuilderPat (ViewPat noExt a p))+    return $ cL l (PatBuilderPat (ViewPat noExtField a p))   mkHsAsPatPV l v e = do     p <- checkLPat e-    return $ cL l (PatBuilderPat (AsPat noExt v p))+    return $ cL l (PatBuilderPat (AsPat noExtField v p))   mkHsLazyPatPV l e = do     p <- checkLPat e-    return $ cL l (PatBuilderPat (LazyPat noExt p))+    return $ cL l (PatBuilderPat (LazyPat noExtField p))   mkSumOrTuplePV = mkSumOrTuplePat  checkUnboxedStringLitPat :: Located (HsLit GhcPs) -> PV ()@@ -2671,13 +2671,13 @@  mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs mkRdrRecordUpd exp flds-  = RecordUpd { rupd_ext  = noExt+  = RecordUpd { rupd_ext  = noExtField               , rupd_expr = exp               , rupd_flds = flds }  mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs mkRdrRecordCon con flds-  = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }+  = RecordCon { rcon_ext = noExtField, rcon_con_name = con, rcon_flds = flds }  mk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }@@ -2686,9 +2686,9 @@  mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs mk_rec_upd_field (HsRecField (dL->L loc (FieldOcc _ rdr)) arg pun)-  = HsRecField (L loc (Unambiguous noExt rdr)) arg pun-mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc _)) _ _)-  = panic "mk_rec_upd_field"+  = HsRecField (L loc (Unambiguous noExtField rdr)) arg pun+mk_rec_upd_field (HsRecField (dL->L _ (XFieldOcc nec)) _ _)+  = noExtCon nec mk_rec_upd_field (HsRecField _ _ _)   = panic "mk_rec_upd_field: Impossible Match" -- due to #15884 @@ -2747,8 +2747,8 @@         funcTarget = CFunction (StaticTarget esrc entity' Nothing True)         importSpec = CImport cconv safety Nothing funcTarget (cL loc esrc) -    returnSpec spec = return $ ForD noExt $ ForeignImport-          { fd_i_ext  = noExt+    returnSpec spec = return $ ForD noExtField $ ForeignImport+          { fd_i_ext  = noExtField           , fd_name   = v           , fd_sig_ty = ty           , fd_fi     = spec@@ -2821,8 +2821,8 @@          -> (Located StringLiteral, Located RdrName, LHsSigType GhcPs)          -> P (HsDecl GhcPs) mkExport (dL->L lc cconv) (dL->L le (StringLiteral esrc entity), v, ty)- = return $ ForD noExt $-   ForeignExport { fd_e_ext = noExt, fd_name = v, fd_sig_ty = ty+ = return $ ForD noExtField $+   ForeignExport { fd_e_ext = noExtField, fd_name = v, fd_sig_ty = ty                  , fd_fe = CExport (cL lc (CExportStatic esrc entity' cconv))                                    (cL le esrc) }   where@@ -2855,11 +2855,11 @@   case subs of     ImpExpAbs       | isVarNameSpace (rdrNameSpace name)-                       -> return $ IEVar noExt (cL l (ieNameFromSpec specname))-      | otherwise      -> IEThingAbs noExt . cL l <$> nameT-    ImpExpAll          -> IEThingAll noExt . cL l <$> nameT+                       -> return $ IEVar noExtField (cL l (ieNameFromSpec specname))+      | otherwise      -> IEThingAbs noExtField . cL l <$> nameT+    ImpExpAll          -> IEThingAll noExtField . cL l <$> nameT     ImpExpList xs      ->-      (\newName -> IEThingWith noExt (cL l newName)+      (\newName -> IEThingWith noExtField (cL l newName)         NoIEWildcard (wrapped xs) []) <$> nameT     ImpExpAllWith xs                       ->       do allowed <- getBit PatternSynonymsBit@@ -2870,7 +2870,7 @@                           (findIndex isImpExpQcWildcard withs)                 ies   = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs             in (\newName-                        -> IEThingWith noExt (cL l newName) pos ies [])+                        -> IEThingWith noExtField (cL l newName) pos ies [])                <$> nameT           else addFatalError l             (text "Illegal export form (use PatternSynonyms to enable)")@@ -3003,32 +3003,94 @@ ----------------------------------------------------------------------------- -- Misc utils --- See Note [Parser-Validator] and Note [Parser-Validator ReaderT SDoc]-newtype PV a = PV (ReaderT SDoc P a)-  deriving (Functor, Applicative, Monad)+data PV_Context =+  PV_Context+    { pv_options :: ParserFlags+    , pv_hint :: SDoc  -- See Note [Parser-Validator Hint]+    } +data PV_Accum =+  PV_Accum+    { pv_messages :: DynFlags -> Messages+    , pv_annotations :: [(ApiAnnKey,[SrcSpan])]+    , pv_comment_q :: [Located AnnotationComment]+    , pv_annotations_comments :: [(SrcSpan,[Located AnnotationComment])]+    }++data PV_Result a = PV_Ok PV_Accum a | PV_Failed PV_Accum++-- See Note [Parser-Validator]+newtype PV a = PV { unPV :: PV_Context -> PV_Accum -> PV_Result a }++instance Functor PV where+  fmap = liftM++instance Applicative PV where+  pure a = a `seq` PV (\_ acc -> PV_Ok acc a)+  (<*>) = ap++instance Monad PV where+  m >>= f = PV $ \ctx acc ->+    case unPV m ctx acc of+      PV_Ok acc' a -> unPV (f a) ctx acc'+      PV_Failed acc' -> PV_Failed acc'+ runPV :: PV a -> P a-runPV (PV m) = runReaderT m empty+runPV = runPV_msg empty  runPV_msg :: SDoc -> PV a -> P a-runPV_msg msg (PV m) = runReaderT m msg+runPV_msg msg m =+  P $ \s ->+    let+      pv_ctx = PV_Context+        { pv_options = options s+        , pv_hint = msg }+      pv_acc = PV_Accum+        { pv_messages = messages s+        , pv_annotations = annotations s+        , pv_comment_q = comment_q s+        , pv_annotations_comments = annotations_comments s }+      mkPState acc' =+        s { messages = pv_messages acc'+          , annotations = pv_annotations acc'+          , comment_q = pv_comment_q acc'+          , annotations_comments = pv_annotations_comments acc' }+    in+      case unPV m pv_ctx pv_acc of+        PV_Ok acc' a -> POk (mkPState acc') a+        PV_Failed acc' -> PFailed (mkPState acc')  localPV_msg :: (SDoc -> SDoc) -> PV a -> PV a-localPV_msg f (PV m) = PV (local f m)+localPV_msg f m =+  let modifyHint ctx = ctx{pv_hint = f (pv_hint ctx)} in+  PV (\ctx acc -> unPV m (modifyHint ctx) acc)  instance MonadP PV where   addError srcspan msg =-    PV $ ReaderT $ \ctxMsg -> addError srcspan (msg $$ ctxMsg)-  addWarning option srcspan msg =-    PV $ ReaderT $ \_ -> addWarning option srcspan msg+    PV $ \ctx acc@PV_Accum{pv_messages=m} ->+      let msg' = msg $$ pv_hint ctx in+      PV_Ok acc{pv_messages=appendError srcspan msg' m} ()+  addWarning option srcspan warning =+    PV $ \PV_Context{pv_options=o} acc@PV_Accum{pv_messages=m} ->+      PV_Ok acc{pv_messages=appendWarning o option srcspan warning m} ()   addFatalError srcspan msg =-    PV $ ReaderT $ \ctxMsg -> addFatalError srcspan (msg $$ ctxMsg)+    addError srcspan msg >> PV (const PV_Failed)   getBit ext =-    PV $ ReaderT $ \_ -> getBit ext-  addAnnsAt loc anns =-    PV $ ReaderT $ \_ -> addAnnsAt loc anns+    PV $ \ctx acc ->+      let b = ext `xtest` pExtsBitmap (pv_options ctx) in+      PV_Ok acc $! b   addAnnotation l a v =-    PV $ ReaderT $ \_ -> addAnnotation l a v+    PV $ \_ acc ->+      let+        (comment_q', new_ann_comments) = allocateComments l (pv_comment_q acc)+        annotations_comments' = new_ann_comments ++ pv_annotations_comments acc+        annotations' = ((l,a), [v]) : pv_annotations acc+        acc' = acc+          { pv_annotations = annotations'+          , pv_comment_q = comment_q'+          , pv_annotations_comments = annotations_comments' }+      in+        PV_Ok acc' ()  {- Note [Parser-Validator] ~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -3060,7 +3122,7 @@  -} -{- Note [Parser-Validator ReaderT SDoc]+{- Note [Parser-Validator Hint] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A PV computation is parametrized by a hint for error messages, which can be set depending on validation context. We use this in checkPattern to fix #984.@@ -3096,9 +3158,9 @@     Possibly caused by a missing 'do'?  The "Possibly caused by a missing 'do'?" suggestion is the hint that is passed-via ReaderT SDoc in PV. When validating in a context other than 'bindpat' (a-pattern to the left of <-), we set the hint to 'empty' and it has no effect on-the error messages.+as the 'pv_hint' field 'PV_Context'. When validating in a context other than+'bindpat' (a pattern to the left of <-), we set the hint to 'empty' and it has+no effect on the error messages.  -} @@ -3133,14 +3195,14 @@  -- Tuple mkSumOrTupleExpr l boxity (Tuple es) =-    return $ cL l (ExplicitTuple noExt (map toTupArg es) boxity)+    return $ cL l (ExplicitTuple noExtField (map toTupArg es) boxity)   where     toTupArg :: Located (Maybe (LHsExpr GhcPs)) -> LHsTupArg GhcPs-    toTupArg = mapLoc (maybe missingTupArg (Present noExt))+    toTupArg = mapLoc (maybe missingTupArg (Present noExtField))  -- Sum mkSumOrTupleExpr l Unboxed (Sum alt arity e) =-    return $ cL l (ExplicitSum noExt alt arity e)+    return $ cL l (ExplicitSum noExtField alt arity e) mkSumOrTupleExpr l Boxed a@Sum{} =     addFatalError l (hang (text "Boxed sums not supported:") 2                       (pprSumOrTuple Boxed a))@@ -3150,7 +3212,7 @@ -- Tuple mkSumOrTuplePat l boxity (Tuple ps) = do   ps' <- traverse toTupPat ps-  return $ cL l (PatBuilderPat (TuplePat noExt ps' boxity))+  return $ cL l (PatBuilderPat (TuplePat noExtField ps' boxity))   where     toTupPat :: Located (Maybe (Located (PatBuilder GhcPs))) -> PV (LPat GhcPs)     toTupPat (dL -> L l p) = case p of@@ -3160,7 +3222,7 @@ -- Sum mkSumOrTuplePat l Unboxed (Sum alt arity p) = do    p' <- checkLPat p-   return $ cL l (PatBuilderPat (SumPat noExt p' alt arity))+   return $ cL l (PatBuilderPat (SumPat noExtField p' alt arity)) mkSumOrTuplePat l Boxed a@Sum{} =     addFatalError l (hang (text "Boxed sums not supported:") 2                       (pprSumOrTuple Boxed a))@@ -3173,7 +3235,7 @@ mkLHsDocTy :: LHsType GhcPs -> LHsDocString -> LHsType GhcPs mkLHsDocTy t doc =   let loc = getLoc t `combineSrcSpans` getLoc doc-  in cL loc (HsDocTy noExt t doc)+  in cL loc (HsDocTy noExtField t doc)  mkLHsDocTyMaybe :: LHsType GhcPs -> Maybe LHsDocString -> LHsType GhcPs mkLHsDocTyMaybe t = maybe t (mkLHsDocTy t)

@@ -2024,7 +2024,7 @@ runtimeRepSimpleDataConKeys, unliftedSimpleRepDataConKeys, unliftedRepDataConKeys :: [Unique] liftedRepDataConKey :: Unique runtimeRepSimpleDataConKeys@(liftedRepDataConKey : unliftedSimpleRepDataConKeys)-  = map mkPreludeDataConUnique [74..86]+  = map mkPreludeDataConUnique [74..88]  unliftedRepDataConKeys = vecRepDataConKey :                          tupleRepDataConKey :@@ -2034,29 +2034,29 @@ -- See Note [Wiring in RuntimeRep] in TysWiredIn -- VecCount vecCountDataConKeys :: [Unique]-vecCountDataConKeys = map mkPreludeDataConUnique [87..92]+vecCountDataConKeys = map mkPreludeDataConUnique [89..94]  -- See Note [Wiring in RuntimeRep] in TysWiredIn -- VecElem vecElemDataConKeys :: [Unique]-vecElemDataConKeys = map mkPreludeDataConUnique [93..102]+vecElemDataConKeys = map mkPreludeDataConUnique [95..104]  -- Typeable things kindRepTyConAppDataConKey, kindRepVarDataConKey, kindRepAppDataConKey,     kindRepFunDataConKey, kindRepTYPEDataConKey,     kindRepTypeLitSDataConKey, kindRepTypeLitDDataConKey     :: Unique-kindRepTyConAppDataConKey = mkPreludeDataConUnique 103-kindRepVarDataConKey      = mkPreludeDataConUnique 104-kindRepAppDataConKey      = mkPreludeDataConUnique 105-kindRepFunDataConKey      = mkPreludeDataConUnique 106-kindRepTYPEDataConKey     = mkPreludeDataConUnique 107-kindRepTypeLitSDataConKey = mkPreludeDataConUnique 108-kindRepTypeLitDDataConKey = mkPreludeDataConUnique 109+kindRepTyConAppDataConKey = mkPreludeDataConUnique 105+kindRepVarDataConKey      = mkPreludeDataConUnique 106+kindRepAppDataConKey      = mkPreludeDataConUnique 107+kindRepFunDataConKey      = mkPreludeDataConUnique 108+kindRepTYPEDataConKey     = mkPreludeDataConUnique 109+kindRepTypeLitSDataConKey = mkPreludeDataConUnique 110+kindRepTypeLitDDataConKey = mkPreludeDataConUnique 111  typeLitSymbolDataConKey, typeLitNatDataConKey :: Unique-typeLitSymbolDataConKey   = mkPreludeDataConUnique 110-typeLitNatDataConKey      = mkPreludeDataConUnique 111+typeLitSymbolDataConKey   = mkPreludeDataConUnique 112+typeLitNatDataConKey      = mkPreludeDataConUnique 113   ---------------- Template Haskell -------------------

@@ -93,9 +93,11 @@ import {-# SOURCE #-} TysWiredIn   ( runtimeRepTy, unboxedTupleKind, liftedTypeKind   , vecRepDataConTyCon, tupleRepDataConTyCon-  , liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy-  , int16RepDataConTy, word16RepDataConTy-  , wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy+  , liftedRepDataConTy, unliftedRepDataConTy+  , intRepDataConTy+  , int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy+  , wordRepDataConTy+  , word16RepDataConTy, word8RepDataConTy, word32RepDataConTy, word64RepDataConTy   , addrRepDataConTy   , floatRepDataConTy, doubleRepDataConTy   , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy@@ -549,10 +551,12 @@   IntRep        -> intRepDataConTy   Int8Rep       -> int8RepDataConTy   Int16Rep      -> int16RepDataConTy-  WordRep       -> wordRepDataConTy+  Int32Rep      -> int32RepDataConTy   Int64Rep      -> int64RepDataConTy+  WordRep       -> wordRepDataConTy   Word8Rep      -> word8RepDataConTy   Word16Rep     -> word16RepDataConTy+  Word32Rep     -> word32RepDataConTy   Word64Rep     -> word64RepDataConTy   AddrRep       -> addrRepDataConTy   FloatRep      -> floatRepDataConTy@@ -607,7 +611,7 @@ int32PrimTy :: Type int32PrimTy     = mkTyConTy int32PrimTyCon int32PrimTyCon :: TyCon-int32PrimTyCon  = pcPrimTyCon0 int32PrimTyConName IntRep+int32PrimTyCon  = pcPrimTyCon0 int32PrimTyConName Int32Rep  int64PrimTy :: Type int64PrimTy     = mkTyConTy int64PrimTyCon@@ -632,7 +636,7 @@ word32PrimTy :: Type word32PrimTy    = mkTyConTy word32PrimTyCon word32PrimTyCon :: TyCon-word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep+word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep  word64PrimTy :: Type word64PrimTy    = mkTyConTy word64PrimTyCon

@@ -108,9 +108,11 @@          vecRepDataConTyCon, tupleRepDataConTyCon, sumRepDataConTyCon, -        liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy,-        int16RepDataConTy, word16RepDataConTy,-        wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy,+        liftedRepDataConTy, unliftedRepDataConTy,+        intRepDataConTy,+        int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,+        wordRepDataConTy,+        word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,         addrRepDataConTy,         floatRepDataConTy, doubleRepDataConTy, @@ -182,6 +184,8 @@ in GHC.Types. All places where such lists exist should contain a reference to this Note, so a search for this Note's name should find all the lists. +See also Note [Getting from RuntimeRep to PrimRep] in RepType.+ ************************************************************************ *                                                                      * \subsection{Wired in type constructors}@@ -440,19 +444,13 @@ runtimeRepSimpleDataConNames :: [Name] runtimeRepSimpleDataConNames   = zipWith3Lazy mk_special_dc_name-      [ fsLit "LiftedRep"-      , fsLit "UnliftedRep"+      [ fsLit "LiftedRep", fsLit "UnliftedRep"       , fsLit "IntRep"+      , fsLit "Int8Rep", fsLit "Int16Rep", fsLit "Int32Rep", fsLit "Int64Rep"       , fsLit "WordRep"-      , fsLit "Int8Rep"-      , fsLit "Int16Rep"-      , fsLit "Int64Rep"-      , fsLit "Word8Rep"-      , fsLit "Word16Rep"-      , fsLit "Word64Rep"+      , fsLit "Word8Rep", fsLit "Word16Rep", fsLit "Word32Rep", fsLit "Word64Rep"       , fsLit "AddrRep"-      , fsLit "FloatRep"-      , fsLit "DoubleRep"+      , fsLit "FloatRep", fsLit "DoubleRep"       ]       runtimeRepSimpleDataConKeys       runtimeRepSimpleDataCons@@ -1152,6 +1150,7 @@                                  runtimeRepTyCon                                  (RuntimeRep prim_rep_fun)   where+    -- See Note [Getting from RuntimeRep to PrimRep] in RepType     prim_rep_fun [count, elem]       | VecCount n <- tyConRuntimeRepInfo (tyConAppTyCon count)       , VecElem  e <- tyConRuntimeRepInfo (tyConAppTyCon elem)@@ -1166,6 +1165,7 @@ tupleRepDataCon = pcSpecialDataCon tupleRepDataConName [ mkListTy runtimeRepTy ]                                    runtimeRepTyCon (RuntimeRep prim_rep_fun)   where+    -- See Note [Getting from RuntimeRep to PrimRep] in RepType     prim_rep_fun [rr_ty_list]       = concatMap (runtimeRepPrimRep doc) rr_tys       where@@ -1181,6 +1181,7 @@ sumRepDataCon = pcSpecialDataCon sumRepDataConName [ mkListTy runtimeRepTy ]                                  runtimeRepTyCon (RuntimeRep prim_rep_fun)   where+    -- See Note [Getting from RuntimeRep to PrimRep] in RepType     prim_rep_fun [rr_ty_list]       = map slotPrimRep (ubxSumRepType prim_repss)       where@@ -1194,12 +1195,19 @@ sumRepDataConTyCon = promoteDataCon sumRepDataCon  -- See Note [Wiring in RuntimeRep]+-- See Note [Getting from RuntimeRep to PrimRep] in RepType runtimeRepSimpleDataCons :: [DataCon] liftedRepDataCon :: DataCon runtimeRepSimpleDataCons@(liftedRepDataCon : _)   = zipWithLazy mk_runtime_rep_dc-    [ LiftedRep, UnliftedRep, IntRep, WordRep, Int8Rep, Int16Rep, Int64Rep-    , Word8Rep, Word16Rep, Word64Rep, AddrRep, FloatRep, DoubleRep ]+    [ LiftedRep, UnliftedRep+    , IntRep+    , Int8Rep, Int16Rep, Int32Rep, Int64Rep+    , WordRep+    , Word8Rep, Word16Rep, Word32Rep, Word64Rep+    , AddrRep+    , FloatRep, DoubleRep+    ]     runtimeRepSimpleDataConNames   where     mk_runtime_rep_dc primrep name@@ -1207,13 +1215,20 @@  -- See Note [Wiring in RuntimeRep] liftedRepDataConTy, unliftedRepDataConTy,-  intRepDataConTy, int8RepDataConTy, int16RepDataConTy, wordRepDataConTy, int64RepDataConTy,-  word8RepDataConTy, word16RepDataConTy, word64RepDataConTy, addrRepDataConTy,+  intRepDataConTy,+  int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,+  wordRepDataConTy,+  word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,+  addrRepDataConTy,   floatRepDataConTy, doubleRepDataConTy :: Type [liftedRepDataConTy, unliftedRepDataConTy,-   intRepDataConTy, wordRepDataConTy, int8RepDataConTy, int16RepDataConTy, int64RepDataConTy,-   word8RepDataConTy, word16RepDataConTy, word64RepDataConTy,-   addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy]+   intRepDataConTy,+   int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,+   wordRepDataConTy,+   word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,+   addrRepDataConTy,+   floatRepDataConTy, doubleRepDataConTy+   ]   = map (mkTyConTy . promoteDataCon) runtimeRepSimpleDataCons  vecCountTyCon :: TyCon

@@ -19,10 +19,13 @@  liftedRepDataConTyCon, vecRepDataConTyCon, tupleRepDataConTyCon :: TyCon -liftedRepDataConTy, unliftedRepDataConTy, intRepDataConTy, int8RepDataConTy,-  int16RepDataConTy, word16RepDataConTy,-  wordRepDataConTy, int64RepDataConTy, word8RepDataConTy, word64RepDataConTy,-  addrRepDataConTy, floatRepDataConTy, doubleRepDataConTy :: Type+liftedRepDataConTy, unliftedRepDataConTy,+  intRepDataConTy,+  int8RepDataConTy, int16RepDataConTy, int32RepDataConTy, int64RepDataConTy,+  wordRepDataConTy,+  word8RepDataConTy, word16RepDataConTy, word32RepDataConTy, word64RepDataConTy,+  addrRepDataConTy,+  floatRepDataConTy, doubleRepDataConTy :: Type  vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy,   vec64DataConTy :: Type

@@ -260,10 +260,12 @@ primRepSlot IntRep      = WordSlot primRepSlot Int8Rep     = WordSlot primRepSlot Int16Rep    = WordSlot+primRepSlot Int32Rep    = WordSlot primRepSlot Int64Rep    = Word64Slot primRepSlot WordRep     = WordSlot primRepSlot Word8Rep    = WordSlot primRepSlot Word16Rep   = WordSlot+primRepSlot Word32Rep   = WordSlot primRepSlot Word64Rep   = Word64Slot primRepSlot AddrRep     = WordSlot primRepSlot FloatRep    = FloatSlot@@ -305,11 +307,165 @@ *                                                                       *                    PrimRep *                                                                       *-********************************************************************** -}+************************************************************************* +Note [RuntimeRep and PrimRep]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+This Note describes the relationship between GHC.Types.RuntimeRep+(of levity-polymorphism fame) and TyCon.PrimRep, as these types+are closely related.++A "primitive entity" is one that can be+ * stored in one register+ * manipulated with one machine instruction+++Examples include:+ * a 32-bit integer+ * a 32-bit float+ * a 64-bit float+ * a machine address (heap pointer), etc.+ * a quad-float (on a machine with SIMD register and instructions)+ * ...etc...++The "representation or a primitive entity" specifies what kind of register is+needed and how many bits are required. The data type TyCon.PrimRep+enumerates all the possiblities.++data PrimRep+  = VoidRep+  | LiftedRep     -- ^ Lifted pointer+  | UnliftedRep   -- ^ Unlifted pointer+  | Int8Rep       -- ^ Signed, 8-bit value+  | Int16Rep      -- ^ Signed, 16-bit value+  ...etc...+  | VecRep Int PrimElemRep  -- ^ SIMD fixed-width vector++The Haskell source language is a bit more flexible: a single value may need multiple PrimReps.+For example++  utup :: (# Int, Int #) -> Bool+  utup x = ...++Here x :: (# Int, Int #), and that takes two registers, and two instructions to move around.+Unboxed sums are similar.++Every Haskell expression e has a type ty, whose kind is of form TYPE rep+   e :: ty :: TYPE rep+where rep :: RuntimeRep. Here rep describes the runtime representation for e's value,+but RuntimeRep has some extra cases:++data RuntimeRep = VecRep VecCount VecElem   -- ^ a SIMD vector type+                | TupleRep [RuntimeRep]     -- ^ An unboxed tuple of the given reps+                | SumRep [RuntimeRep]       -- ^ An unboxed sum of the given reps+                | LiftedRep       -- ^ lifted; represented by a pointer+                | UnliftedRep     -- ^ unlifted; represented by a pointer+                | IntRep          -- ^ signed, word-sized value+                ...etc...++It's all in 1-1 correspondence with PrimRep except for TupleRep and SumRep,+which describe unboxed products and sums respectively. RuntimeRep is defined+in the library ghc-prim:GHC.Types. It is also "wired-in" to GHC: see+TysWiredIn.runtimeRepTyCon. The unarisation pass, in StgUnarise, transforms the+program, so that that every variable has a type that has a PrimRep. For+example, unarisation transforms our utup function above, to take two Int+arguments instead of one (# Int, Int #) argument.++See also Note [Getting from RuntimeRep to PrimRep] and Note [VoidRep].++Note [VoidRep]+~~~~~~~~~~~~~~+PrimRep contains a constructor VoidRep, while RuntimeRep does+not. Yet representations are often characterised by a list of PrimReps,+where a void would be denoted as []. (See also Note [RuntimeRep and PrimRep].)++However, after the unariser, all identifiers have exactly one PrimRep, but+void arguments still exist. Thus, PrimRep includes VoidRep to describe these+binders. Perhaps post-unariser representations (which need VoidRep) should be+a different type than pre-unariser representations (which use a list and do+not need VoidRep), but we have what we have.++RuntimeRep instead uses TupleRep '[] to denote a void argument. When+converting a TupleRep '[] into a list of PrimReps, we get an empty list.++Note [Getting from RuntimeRep to PrimRep]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+General info on RuntimeRep and PrimRep is in Note [RuntimeRep and PrimRep].++How do we get from an Id to the the list or PrimReps used to store it? We get+the Id's type ty (using idType), then ty's kind ki (using typeKind), then+pattern-match on ki to extract rep (in kindPrimRep), then extract the PrimRep+from the RuntimeRep (in runtimeRepPrimRep).++We now must convert the RuntimeRep to a list of PrimReps. Let's look at two+examples:++  1. x :: Int#+  2. y :: (# Int, Word# #)++With these types, we can extract these kinds:++  1. Int# :: TYPE IntRep+  2. (# Int, Word# #) :: TYPE (TupleRep [LiftedRep, WordRep])++In the end, we will get these PrimReps:++  1. [IntRep]+  2. [LiftedRep, WordRep]++It would thus seem that we should have a function somewhere of+type `RuntimeRep -> [PrimRep]`. This doesn't work though: when we+look at the argument of TYPE, we get something of type Type (of course).+RuntimeRep exists in the user's program, but not in GHC as such.+Instead, we must decompose the Type of kind RuntimeRep into tycons and+extract the PrimReps from the TyCons. This is what runtimeRepPrimRep does:+it takes a Type and returns a [PrimRep]++runtimeRepPrimRep works by using tyConRuntimeRepInfo. That function+should be passed the TyCon produced by promoting one of the constructors+of RuntimeRep into type-level data. The RuntimeRep promoted datacons are+associated with a RuntimeRepInfo (stored directly in the PromotedDataCon+constructor of TyCon). This pairing happens in TysWiredIn. A RuntimeRepInfo+usually(*) contains a function from [Type] to [PrimRep]: the [Type] are+the arguments to the promoted datacon. These arguments are necessary+for the TupleRep and SumRep constructors, so that this process can recur,+producing a flattened list of PrimReps. Calling this extracted function+happens in runtimeRepPrimRep; the functions themselves are defined in+tupleRepDataCon and sumRepDataCon, both in TysWiredIn.++The (*) above is to support vector representations. RuntimeRep refers+to VecCount and VecElem, whose promoted datacons have nuggets of information+related to vectors; these form the other alternatives for RuntimeRepInfo.++Returning to our examples, the Types we get (after stripping off TYPE) are++  1. TyConApp (PromotedDataCon "IntRep") []+  2. TyConApp (PromotedDataCon "TupleRep")+              [TyConApp (PromotedDataCon ":")+                        [ TyConApp (AlgTyCon "RuntimeRep") []+                        , TyConApp (PromotedDataCon "LiftedRep") []+                        , TyConApp (PromotedDataCon ":")+                                   [ TyConApp (AlgTyCon "RuntimeRep") []+                                   , TyConApp (PromotedDataCon "WordRep") []+                                   , TyConApp (PromotedDataCon "'[]")+                                              [TyConApp (AlgTyCon "RuntimeRep") []]]]]++runtimeRepPrimRep calls tyConRuntimeRepInfo on (PromotedDataCon "IntRep"), resp.+(PromotedDataCon "TupleRep"), extracting a function that will produce the PrimReps.+In example 1, this function is passed an empty list (the empty list of args to IntRep)+and returns the PrimRep IntRep. (See the definition of runtimeRepSimpleDataCons in+TysWiredIn and its helper function mk_runtime_rep_dc.) Example 2 passes the promoted+list as the one argument to the extracted function. The extracted function is defined+as prim_rep_fun within tupleRepDataCon in TysWiredIn. It takes one argument, decomposes+the promoted list (with extractPromotedList), and then recurs back to runtimeRepPrimRep+to process the LiftedRep and WordRep, concatentating the results.++-}+ -- | Discovers the primitive representation of a 'Type'. Returns -- a list of 'PrimRep': it's a list because of the possibility of -- no runtime representation (void) or multiple (unboxed tuple/sum)+-- See also Note [Getting from RuntimeRep to PrimRep] typePrimRep :: HasDebugCallStack => Type -> [PrimRep] typePrimRep ty = kindPrimRep (text "typePrimRep" <+>                               parens (ppr ty <+> dcolon <+> ppr (typeKind ty)))@@ -317,6 +473,7 @@  -- | Like 'typePrimRep', but assumes that there is precisely one 'PrimRep' output; -- an empty list of PrimReps becomes a VoidRep+-- See also Note [RuntimeRep and PrimRep] and Note [VoidRep] typePrimRep1 :: HasDebugCallStack => UnaryType -> PrimRep typePrimRep1 ty = case typePrimRep ty of   []    -> VoidRep@@ -325,6 +482,7 @@  -- | Find the runtime representation of a 'TyCon'. Defined here to -- avoid module loops. Returns a list of the register shapes necessary.+-- See also Note [Getting from RuntimeRep to PrimRep] tyConPrimRep :: HasDebugCallStack => TyCon -> [PrimRep] tyConPrimRep tc   = kindPrimRep (text "kindRep tc" <+> ppr tc $$ ppr res_kind)@@ -334,6 +492,7 @@  -- | Like 'tyConPrimRep', but assumed that there is precisely zero or -- one 'PrimRep' output+-- See also Note [Getting from RuntimeRep to PrimRep] and Note [VoidRep] tyConPrimRep1 :: HasDebugCallStack => TyCon -> PrimRep tyConPrimRep1 tc = case tyConPrimRep tc of   []    -> VoidRep@@ -342,6 +501,7 @@  -- | Take a kind (of shape @TYPE rr@) and produce the 'PrimRep's -- of values of types of this kind.+-- See also Note [Getting from RuntimeRep to PrimRep] kindPrimRep :: HasDebugCallStack => SDoc -> Kind -> [PrimRep] kindPrimRep doc ki   | Just ki' <- coreView ki@@ -353,7 +513,7 @@   = pprPanic "kindPrimRep" (ppr ki $$ doc)  -- | Take a type of kind RuntimeRep and extract the list of 'PrimRep' that--- it encodes.+-- it encodes. See also Note [Getting from RuntimeRep to PrimRep] runtimeRepPrimRep :: HasDebugCallStack => SDoc -> Type -> [PrimRep] runtimeRepPrimRep doc rr_ty   | Just rr_ty' <- coreView rr_ty@@ -366,5 +526,6 @@  -- | Convert a PrimRep back to a Type. Used only in the unariser to give types -- to fresh Ids. Really, only the type's representation matters.+-- See also Note [RuntimeRep and PrimRep] primRepToType :: PrimRep -> Type primRepToType = anyTypeOfKind . tYPE . primRepToRuntimeRep

@@ -2587,11 +2587,9 @@       ic_skols :: [TcTyVar],     -- Introduced skolems       ic_info  :: SkolemInfo,    -- See Note [Skolems in an implication]                                  -- See Note [Shadowing in a constraint]+       ic_telescope :: Maybe SDoc,  -- User-written telescope, if there is one-                                   -- The list of skolems is order-checked-                                   -- if and only if this is a Just.-                                   -- See Note [Keeping scoped variables in order: Explicit]-                                   -- in TcHsType+                                   -- See Note [Checking telescopes]        ic_given  :: [EvVar],      -- Given evidence variables                                  --   (order does not matter)@@ -2708,7 +2706,43 @@   ppr (IC_Solved { ics_dead = dead })     = text "Solved" <+> (braces (text "Dead givens =" <+> ppr dead)) -{-+{- Note [Checking telescopes]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When kind-checking a /user-written/ type, we might have a "bad telescope"+like this one:+  data SameKind :: forall k. k -> k -> Type+  type Foo :: forall a k (b :: k). SameKind a b -> Type++The kind of 'a' mentions 'k' which is bound after 'a'.  Oops.++Knowing this means that unification etc must have happened, so it's+convenient to detect it in the constraint solver:++* We make a single implication constraint when kind-checking+  the 'forall' in Foo's kind, something like+      forall a k (b::k). { wanted constraints }++* Having solved {wanted}, before discarding the now-solved implication,+  the costraint solver checks the dependency order of the skolem+  variables (ic_skols).  This is done in setImplicationStatus.++* This check is only necessary if the implication was born from a+  user-written signature.  If, say, it comes from checking a pattern+  match that binds existentials, where the type of the data constructor+  is known to be valid (it in tcConPat), no need for the check.++  So the check is done if and only if ic_telescope is (Just blah).++* If ic_telesope is (Just d), the d::SDoc displays the original,+  user-written type variables.++* Be careful /NOT/ to discard an implication with non-Nothing+  ic_telescope, even if ic_wanted is empty.  We must give the+  constraint solver a chance to make that bad-telesope test!  Hence+  the extra guard in emitResidualTvConstraint; see #16247++See also TcHsTYpe Note [Keeping scoped variables in order: Explicit]+ Note [Needed evidence variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Th ic_need_evs field holds the free vars of ic_binds, and all the@@ -3700,7 +3734,7 @@ exprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e exprCtOrigin (HsWrap {})        = panic "exprCtOrigin HsWrap"-exprCtOrigin (XExpr {})         = panic "exprCtOrigin XExpr"+exprCtOrigin (XExpr nec)        = noExtCon nec  -- | Extract a suitable CtOrigin from a MatchGroup matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin@@ -3711,17 +3745,17 @@    | otherwise   = Shouldn'tHappenOrigin "multi-way match"-matchesCtOrigin (XMatchGroup{}) = panic "matchesCtOrigin"+matchesCtOrigin (XMatchGroup nec) = noExtCon nec  -- | Extract a suitable CtOrigin from guarded RHSs grhssCtOrigin :: GRHSs GhcRn (LHsExpr GhcRn) -> CtOrigin grhssCtOrigin (GRHSs { grhssGRHSs = lgrhss }) = lGRHSCtOrigin lgrhss-grhssCtOrigin (XGRHSs _) = panic "grhssCtOrigin"+grhssCtOrigin (XGRHSs nec) = noExtCon nec  -- | Extract a suitable CtOrigin from a list of guarded RHSs lGRHSCtOrigin :: [LGRHS GhcRn (LHsExpr GhcRn)] -> CtOrigin lGRHSCtOrigin [L _ (GRHS _ _ (L _ e))] = exprCtOrigin e-lGRHSCtOrigin [L _ (XGRHS _)] = panic "lGRHSCtOrigin"+lGRHSCtOrigin [L _ (XGRHS nec)] = noExtCon nec lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS"  pprCtLoc :: CtLoc -> SDoc@@ -3941,8 +3975,6 @@ lookupRoleAnnot :: RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl GhcRn) lookupRoleAnnot = lookupNameEnv -getRoleAnnots :: [Name] -> RoleAnnotEnv-              -> ([LRoleAnnotDecl GhcRn], RoleAnnotEnv)+getRoleAnnots :: [Name] -> RoleAnnotEnv -> [LRoleAnnotDecl GhcRn] getRoleAnnots bndrs role_env-  = ( mapMaybe (lookupRoleAnnot role_env) bndrs-    , delListFromNameEnv role_env bndrs )+  = mapMaybe (lookupRoleAnnot role_env) bndrs

@@ -196,6 +196,9 @@  import Kind import TyCoRep+import TyCoSubst ( mkTvSubst, substTyWithCoVars )+import TyCoFVs+import TyCoPpr ( pprParendTheta ) import Class import Var import ForeignCall@@ -953,78 +956,6 @@ isTyFamFree :: Type -> Bool -- ^ Check that a type does not contain any type family applications. isTyFamFree = null . tcTyFamInsts--{--************************************************************************-*                                                                      *-          The "exact" free variables of a type-*                                                                      *-************************************************************************--Note [Silly type synonym]-~~~~~~~~~~~~~~~~~~~~~~~~~-Consider-  type T a = Int-What are the free tyvars of (T x)?  Empty, of course!--exactTyCoVarsOfType is used by the type checker to figure out exactly-which type variables are mentioned in a type.  It only matters-occasionally -- see the calls to exactTyCoVarsOfType.--Historical note: years and years ago this function was used during-generalisation -- see #1813.  But that code has long since died.--}--exactTyCoVarsOfType :: Type -> TyCoVarSet--- Find the free type variables (of any kind)--- but *expand* type synonyms.  See Note [Silly type synonym] above.-exactTyCoVarsOfType ty-  = go ty-  where-    go ty | Just ty' <- tcView ty = go ty'  -- This is the key line-    go (TyVarTy tv)         = goVar tv-    go (TyConApp _ tys)     = exactTyCoVarsOfTypes tys-    go (LitTy {})           = emptyVarSet-    go (AppTy fun arg)      = go fun `unionVarSet` go arg-    go (FunTy _ arg res)    = go arg `unionVarSet` go res-    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderType bndr)-    go (CastTy ty co)       = go ty `unionVarSet` goCo co-    go (CoercionTy co)      = goCo co--    goMCo MRefl    = emptyVarSet-    goMCo (MCo co) = goCo co--    goCo (Refl ty)            = go ty-    goCo (GRefl _ ty mco)     = go ty `unionVarSet` goMCo mco-    goCo (TyConAppCo _ _ args)= goCos args-    goCo (AppCo co arg)     = goCo co `unionVarSet` goCo arg-    goCo (ForAllCo tv k_co co)-      = goCo co `delVarSet` tv `unionVarSet` goCo k_co-    goCo (FunCo _ co1 co2)   = goCo co1 `unionVarSet` goCo co2-    goCo (CoVarCo v)         = goVar v-    goCo (HoleCo h)          = goVar (coHoleCoVar h)-    goCo (AxiomInstCo _ _ args) = goCos args-    goCo (UnivCo p _ t1 t2)  = goProv p `unionVarSet` go t1 `unionVarSet` go t2-    goCo (SymCo co)          = goCo co-    goCo (TransCo co1 co2)   = goCo co1 `unionVarSet` goCo co2-    goCo (NthCo _ _ co)      = goCo co-    goCo (LRCo _ co)         = goCo co-    goCo (InstCo co arg)     = goCo co `unionVarSet` goCo arg-    goCo (KindCo co)         = goCo co-    goCo (SubCo co)          = goCo co-    goCo (AxiomRuleCo _ c)   = goCos c--    goCos cos = foldr (unionVarSet . goCo) emptyVarSet cos--    goProv UnsafeCoerceProv     = emptyVarSet-    goProv (PhantomProv kco)    = goCo kco-    goProv (ProofIrrelProv kco) = goCo kco-    goProv (PluginProv _)       = emptyVarSet--    goVar v = unitVarSet v `unionVarSet` go (varType v)--exactTyCoVarsOfTypes :: [Type] -> TyVarSet-exactTyCoVarsOfTypes tys = mapUnionVarSet exactTyCoVarsOfType tys  anyRewritableTyVar :: Bool    -- Ignore casts and coercions                    -> EqRel   -- Ambient role

@@ -26,7 +26,8 @@ import GhcPrelude  import {-# SOURCE #-} TyCon     ( TyCon )-import {-# SOURCE #-} TyCoRep   ( Type, PredType, pprType )+import {-# SOURCE #-} TyCoRep   ( Type, PredType )+import {-# SOURCE #-} TyCoPpr   ( pprType ) import Var import Name import BasicTypes

@@ -31,7 +31,8 @@  import GhcPrelude -import {-# SOURCE #-} TyCoRep ( Type, pprType )+import {-# SOURCE #-} TyCoRep ( Type )+import {-# SOURCE #-} TyCoPpr ( pprType ) import {-# SOURCE #-} TyCon ( TyCon ) import Outputable import FastString@@ -231,7 +232,6 @@                                     -- in TcTyClsDecls     , cab_roles    :: [Role]        -- See Note [CoAxBranch roles]     , cab_lhs      :: [Type]        -- Type patterns to match against-                                    -- See Note [CoAxiom saturation]     , cab_rhs      :: Type          -- Right-hand side of the equality     , cab_incomps  :: [CoAxBranch]  -- The previous incompatible branches                                     -- See Note [Storing compatibility]@@ -310,10 +310,7 @@ placeHolderIncomps :: [CoAxBranch] placeHolderIncomps = panic "placeHolderIncomps" -{- Note [CoAxiom saturation]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-* When co-+{- Note [CoAxBranch type variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the case of a CoAxBranch of an associated type-family instance,

@@ -120,6 +120,10 @@  import IfaceType import TyCoRep+import TyCoFVs+import TyCoPpr+import TyCoSubst+import TyCoTidy import Type import TyCon import CoAxiom

@@ -10,6 +10,7 @@  import DynFlags import TyCoRep+import TyCoSubst import Coercion import Type hiding( substTyVarBndr, substTy ) import TcType       ( exactTyCoVarsOfType )

@@ -0,0 +1,819 @@+module TyCoFVs+  (+        tyCoVarsOfType, tyCoVarsOfTypeDSet, tyCoVarsOfTypes, tyCoVarsOfTypesDSet,+        exactTyCoVarsOfType, exactTyCoVarsOfTypes,+        tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,+        tyCoFVsOfType, tyCoVarsOfTypeList,+        tyCoFVsOfTypes, tyCoVarsOfTypesList,+        tyCoVarsOfTypesSet, tyCoVarsOfCosSet,+        coVarsOfType, coVarsOfTypes,+        coVarsOfCo, coVarsOfCos,+        tyCoVarsOfCo, tyCoVarsOfCos,+        tyCoVarsOfCoDSet,+        tyCoFVsOfCo, tyCoFVsOfCos,+        tyCoVarsOfCoList, tyCoVarsOfProv,+        almostDevoidCoVarOfCo,+        injectiveVarsOfType, injectiveVarsOfTypes,++        noFreeVarsOfType, noFreeVarsOfTypes, noFreeVarsOfCo,++        mkTyCoInScopeSet,++        -- * Welll-scoped free variables+        scopedSort, tyCoVarsOfTypeWellScoped,+        tyCoVarsOfTypesWellScoped,+  ) where++import GhcPrelude++import {-# SOURCE #-} Type (coreView, tcView)++import TyCoRep+import TyCon+import Var+import FV++import UniqFM+import VarSet+import VarEnv+import Util+import Panic++{-+%************************************************************************+%*                                                                      *+                 Free variables of types and coercions+%*                                                                      *+%************************************************************************+-}++{- Note [Free variables of types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The family of functions tyCoVarsOfType, tyCoVarsOfTypes etc, returns+a VarSet that is closed over the types of its variables.  More precisely,+  if    S = tyCoVarsOfType( t )+  and   (a:k) is in S+  then  tyCoVarsOftype( k ) is a subset of S++Example: The tyCoVars of this ((a:* -> k) Int) is {a, k}.++We could /not/ close over the kinds of the variable occurrences, and+instead do so at call sites, but it seems that we always want to do+so, so it's easiest to do it here.++It turns out that getting the free variables of types is performance critical,+so we profiled several versions, exploring different implementation strategies.++1. Baseline version: uses FV naively. Essentially:++   tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty++   This is not nice, because FV introduces some overhead to implement+   determinism, and throught its "interesting var" function, neither of which+   we need here, so they are a complete waste.++2. UnionVarSet version: instead of reusing the FV-based code, we simply used+   VarSets directly, trying to avoid the overhead of FV. E.g.:++   -- FV version:+   tyCoFVsOfType (AppTy fun arg)    a b c = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) a b c++   -- UnionVarSet version:+   tyCoVarsOfType (AppTy fun arg)    = (tyCoVarsOfType fun `unionVarSet` tyCoVarsOfType arg)++   This looks deceptively similar, but while FV internally builds a list- and+   set-generating function, the VarSet functions manipulate sets directly, and+   the latter peforms a lot worse than the naive FV version.++3. Accumulator-style VarSet version: this is what we use now. We do use VarSet+   as our data structure, but delegate the actual work to a new+   ty_co_vars_of_...  family of functions, which use accumulator style and the+   "in-scope set" filter found in the internals of FV, but without the+   determinism overhead.++See #14880.++Note [Closing over free variable kinds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+tyCoVarsOfType and tyCoFVsOfType, while traversing a type, will also close over+free variable kinds. In previous GHC versions, this happened naively: whenever+we would encounter an occurrence of a free type variable, we would close over+its kind. This, however is wrong for two reasons (see #14880):++1. Efficiency. If we have Proxy (a::k) -> Proxy (a::k) -> Proxy (a::k), then+   we don't want to have to traverse k more than once.++2. Correctness. Imagine we have forall k. b -> k, where b has+   kind k, for some k bound in an outer scope. If we look at b's kind inside+   the forall, we'll collect that k is free and then remove k from the set of+   free variables. This is plain wrong. We must instead compute that b is free+   and then conclude that b's kind is free.++An obvious first approach is to move the closing-over-kinds from the+occurrences of a type variable to after finding the free vars - however, this+turns out to introduce performance regressions, and isn't even entirely+correct.++In fact, it isn't even important *when* we close over kinds; what matters is+that we handle each type var exactly once, and that we do it in the right+context.++So the next approach we tried was to use the "in-scope set" part of FV or the+equivalent argument in the accumulator-style `ty_co_vars_of_type` function, to+say "don't bother with variables we have already closed over". This should work+fine in theory, but the code is complicated and doesn't perform well.++But there is a simpler way, which is implemented here. Consider the two points+above:++1. Efficiency: we now have an accumulator, so the second time we encounter 'a',+   we'll ignore it, certainly not looking at its kind - this is why+   pre-checking set membership before inserting ends up not only being faster,+   but also being correct.++2. Correctness: we have an "in-scope set" (I think we should call it it a+  "bound-var set"), specifying variables that are bound by a forall in the type+  we are traversing; we simply ignore these variables, certainly not looking at+  their kind.++So now consider:++    forall k. b -> k++where b :: k->Type is free; but of course, it's a different k! When looking at+b -> k we'll have k in the bound-var set. So we'll ignore the k. But suppose+this is our first encounter with b; we want the free vars of its kind. But we+want to behave as if we took the free vars of its kind at the end; that is,+with no bound vars in scope.++So the solution is easy. The old code was this:++  ty_co_vars_of_type (TyVarTy v) is acc+    | v `elemVarSet` is  = acc+    | v `elemVarSet` acc = acc+    | otherwise          = ty_co_vars_of_type (tyVarKind v) is (extendVarSet acc v)++Now all we need to do is take the free vars of tyVarKind v *with an empty+bound-var set*, thus:++ty_co_vars_of_type (TyVarTy v) is acc+  | v `elemVarSet` is  = acc+  | v `elemVarSet` acc = acc+  | otherwise          = ty_co_vars_of_type (tyVarKind v) emptyVarSet (extendVarSet acc v)+                                                          ^^^^^^^^^^^++And that's it.++-}++tyCoVarsOfType :: Type -> TyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfType ty = ty_co_vars_of_type ty emptyVarSet emptyVarSet++tyCoVarsOfTypes :: [Type] -> TyCoVarSet+tyCoVarsOfTypes tys = ty_co_vars_of_types tys emptyVarSet emptyVarSet++ty_co_vars_of_type :: Type -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_type (TyVarTy v) is acc+  | v `elemVarSet` is  = acc+  | v `elemVarSet` acc = acc+  | otherwise          = ty_co_vars_of_type (tyVarKind v)+                            emptyVarSet  -- See Note [Closing over free variable kinds]+                            (extendVarSet acc v)++ty_co_vars_of_type (TyConApp _ tys)   is acc = ty_co_vars_of_types tys is acc+ty_co_vars_of_type (LitTy {})         _  acc = acc+ty_co_vars_of_type (AppTy fun arg)    is acc = ty_co_vars_of_type fun is (ty_co_vars_of_type arg is acc)+ty_co_vars_of_type (FunTy _ arg res)  is acc = ty_co_vars_of_type arg is (ty_co_vars_of_type res is acc)+ty_co_vars_of_type (ForAllTy (Bndr tv _) ty) is acc = ty_co_vars_of_type (varType tv) is $+                                                      ty_co_vars_of_type ty (extendVarSet is tv) acc+ty_co_vars_of_type (CastTy ty co)     is acc = ty_co_vars_of_type ty is (ty_co_vars_of_co co is acc)+ty_co_vars_of_type (CoercionTy co)    is acc = ty_co_vars_of_co co is acc++ty_co_vars_of_types :: [Type] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_types []       _  acc = acc+ty_co_vars_of_types (ty:tys) is acc = ty_co_vars_of_type ty is (ty_co_vars_of_types tys is acc)++tyCoVarsOfCo :: Coercion -> TyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfCo co = ty_co_vars_of_co co emptyVarSet emptyVarSet++tyCoVarsOfCos :: [Coercion] -> TyCoVarSet+tyCoVarsOfCos cos = ty_co_vars_of_cos cos emptyVarSet emptyVarSet+++ty_co_vars_of_co :: Coercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_co (Refl ty)            is acc = ty_co_vars_of_type ty is acc+ty_co_vars_of_co (GRefl _ ty mco)     is acc = ty_co_vars_of_type ty is $+                                               ty_co_vars_of_mco mco is acc+ty_co_vars_of_co (TyConAppCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc+ty_co_vars_of_co (AppCo co arg)       is acc = ty_co_vars_of_co co is $+                                               ty_co_vars_of_co arg is acc+ty_co_vars_of_co (ForAllCo tv kind_co co) is acc = ty_co_vars_of_co kind_co is $+                                                   ty_co_vars_of_co co (extendVarSet is tv) acc+ty_co_vars_of_co (FunCo _ co1 co2)    is acc = ty_co_vars_of_co co1 is $+                                               ty_co_vars_of_co co2 is acc+ty_co_vars_of_co (CoVarCo v)          is acc = ty_co_vars_of_co_var v is acc+ty_co_vars_of_co (HoleCo h)           is acc = ty_co_vars_of_co_var (coHoleCoVar h) is acc+    -- See Note [CoercionHoles and coercion free variables]+ty_co_vars_of_co (AxiomInstCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc+ty_co_vars_of_co (UnivCo p _ t1 t2)    is acc = ty_co_vars_of_prov p is $+                                                ty_co_vars_of_type t1 is $+                                                ty_co_vars_of_type t2 is acc+ty_co_vars_of_co (SymCo co)          is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (TransCo co1 co2)   is acc = ty_co_vars_of_co co1 is $+                                              ty_co_vars_of_co co2 is acc+ty_co_vars_of_co (NthCo _ _ co)      is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (LRCo _ co)         is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (InstCo co arg)     is acc = ty_co_vars_of_co co is $+                                              ty_co_vars_of_co arg is acc+ty_co_vars_of_co (KindCo co)         is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (SubCo co)          is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_co (AxiomRuleCo _ cs)  is acc = ty_co_vars_of_cos cs is acc++ty_co_vars_of_mco :: MCoercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_mco MRefl    _is acc = acc+ty_co_vars_of_mco (MCo co) is  acc = ty_co_vars_of_co co is acc++ty_co_vars_of_co_var :: CoVar -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_co_var v is acc+  | v `elemVarSet` is  = acc+  | v `elemVarSet` acc = acc+  | otherwise          = ty_co_vars_of_type (varType v)+                            emptyVarSet  -- See Note [Closing over free variable kinds]+                            (extendVarSet acc v)++ty_co_vars_of_cos :: [Coercion] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_cos []       _  acc = acc+ty_co_vars_of_cos (co:cos) is acc = ty_co_vars_of_co co is (ty_co_vars_of_cos cos is acc)++tyCoVarsOfProv :: UnivCoProvenance -> TyCoVarSet+tyCoVarsOfProv prov = ty_co_vars_of_prov prov emptyVarSet emptyVarSet++ty_co_vars_of_prov :: UnivCoProvenance -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet+ty_co_vars_of_prov (PhantomProv co)    is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_prov (ProofIrrelProv co) is acc = ty_co_vars_of_co co is acc+ty_co_vars_of_prov UnsafeCoerceProv    _  acc = acc+ty_co_vars_of_prov (PluginProv _)      _  acc = acc++-- | Generates an in-scope set from the free variables in a list of types+-- and a list of coercions+mkTyCoInScopeSet :: [Type] -> [Coercion] -> InScopeSet+mkTyCoInScopeSet tys cos+  = mkInScopeSet (ty_co_vars_of_types tys emptyVarSet $+                  ty_co_vars_of_cos   cos emptyVarSet emptyVarSet)++-- | `tyCoFVsOfType` that returns free variables of a type in a deterministic+-- set. For explanation of why using `VarSet` is not deterministic see+-- Note [Deterministic FV] in FV.+tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty++-- | `tyCoFVsOfType` that returns free variables of a type in deterministic+-- order. For explanation of why using `VarSet` is not deterministic see+-- Note [Deterministic FV] in FV.+tyCoVarsOfTypeList :: Type -> [TyCoVar]+-- See Note [Free variables of types]+tyCoVarsOfTypeList ty = fvVarList $ tyCoFVsOfType ty++-- | Returns free variables of types, including kind variables as+-- a non-deterministic set. For type synonyms it does /not/ expand the+-- synonym.+tyCoVarsOfTypesSet :: TyVarEnv Type -> TyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfTypesSet tys = tyCoVarsOfTypes $ nonDetEltsUFM tys+  -- It's OK to use nonDetEltsUFM here because we immediately forget the+  -- ordering by returning a set++-- | Returns free variables of types, including kind variables as+-- a deterministic set. For type synonyms it does /not/ expand the+-- synonym.+tyCoVarsOfTypesDSet :: [Type] -> DTyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfTypesDSet tys = fvDVarSet $ tyCoFVsOfTypes tys++-- | Returns free variables of types, including kind variables as+-- a deterministically ordered list. For type synonyms it does /not/ expand the+-- synonym.+tyCoVarsOfTypesList :: [Type] -> [TyCoVar]+-- See Note [Free variables of types]+tyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys++{-+************************************************************************+*                                                                      *+          The "exact" free variables of a type+*                                                                      *+************************************************************************++Note [Silly type synonym]+~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+  type T a = Int+What are the free tyvars of (T x)?  Empty, of course!++exactTyCoVarsOfType is used by the type checker to figure out exactly+which type variables are mentioned in a type.  It only matters+occasionally -- see the calls to exactTyCoVarsOfType.+-}++exactTyCoVarsOfType :: Type -> TyCoVarSet+-- Find the free type variables (of any kind)+-- but *expand* type synonyms.  See Note [Silly type synonym] above.+exactTyCoVarsOfType ty+  = go ty+  where+    go ty | Just ty' <- tcView ty = go ty'  -- This is the key line+    go (TyVarTy tv)         = goVar tv+    go (TyConApp _ tys)     = exactTyCoVarsOfTypes tys+    go (LitTy {})           = emptyVarSet+    go (AppTy fun arg)      = go fun `unionVarSet` go arg+    go (FunTy _ arg res)    = go arg `unionVarSet` go res+    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderType bndr)+    go (CastTy ty co)       = go ty `unionVarSet` goCo co+    go (CoercionTy co)      = goCo co++    goMCo MRefl    = emptyVarSet+    goMCo (MCo co) = goCo co++    goCo (Refl ty)            = go ty+    goCo (GRefl _ ty mco)     = go ty `unionVarSet` goMCo mco+    goCo (TyConAppCo _ _ args)= goCos args+    goCo (AppCo co arg)     = goCo co `unionVarSet` goCo arg+    goCo (ForAllCo tv k_co co)+      = goCo co `delVarSet` tv `unionVarSet` goCo k_co+    goCo (FunCo _ co1 co2)   = goCo co1 `unionVarSet` goCo co2+    goCo (CoVarCo v)         = goVar v+    goCo (HoleCo h)          = goVar (coHoleCoVar h)+    goCo (AxiomInstCo _ _ args) = goCos args+    goCo (UnivCo p _ t1 t2)  = goProv p `unionVarSet` go t1 `unionVarSet` go t2+    goCo (SymCo co)          = goCo co+    goCo (TransCo co1 co2)   = goCo co1 `unionVarSet` goCo co2+    goCo (NthCo _ _ co)      = goCo co+    goCo (LRCo _ co)         = goCo co+    goCo (InstCo co arg)     = goCo co `unionVarSet` goCo arg+    goCo (KindCo co)         = goCo co+    goCo (SubCo co)          = goCo co+    goCo (AxiomRuleCo _ c)   = goCos c++    goCos cos = foldr (unionVarSet . goCo) emptyVarSet cos++    goProv UnsafeCoerceProv     = emptyVarSet+    goProv (PhantomProv kco)    = goCo kco+    goProv (ProofIrrelProv kco) = goCo kco+    goProv (PluginProv _)       = emptyVarSet++    goVar v = unitVarSet v `unionVarSet` go (varType v)++exactTyCoVarsOfTypes :: [Type] -> TyVarSet+exactTyCoVarsOfTypes tys = mapUnionVarSet exactTyCoVarsOfType tys++-- | The worker for `tyCoFVsOfType` and `tyCoFVsOfTypeList`.+-- The previous implementation used `unionVarSet` which is O(n+m) and can+-- make the function quadratic.+-- It's exported, so that it can be composed with+-- other functions that compute free variables.+-- See Note [FV naming conventions] in FV.+--+-- Eta-expanded because that makes it run faster (apparently)+-- See Note [FV eta expansion] in FV for explanation.+tyCoFVsOfType :: Type -> FV+-- See Note [Free variables of types]+tyCoFVsOfType (TyVarTy v)        f bound_vars (acc_list, acc_set)+  | not (f v) = (acc_list, acc_set)+  | v `elemVarSet` bound_vars = (acc_list, acc_set)+  | v `elemVarSet` acc_set = (acc_list, acc_set)+  | otherwise = tyCoFVsOfType (tyVarKind v) f+                               emptyVarSet   -- See Note [Closing over free variable kinds]+                               (v:acc_list, extendVarSet acc_set v)+tyCoFVsOfType (TyConApp _ tys)   f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc+tyCoFVsOfType (LitTy {})         f bound_vars acc = emptyFV f bound_vars acc+tyCoFVsOfType (AppTy fun arg)    f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc+tyCoFVsOfType (FunTy _ arg res)  f bound_vars acc = (tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) f bound_vars acc+tyCoFVsOfType (ForAllTy bndr ty) f bound_vars acc = tyCoFVsBndr bndr (tyCoFVsOfType ty)  f bound_vars acc+tyCoFVsOfType (CastTy ty co)     f bound_vars acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfCo co) f bound_vars acc+tyCoFVsOfType (CoercionTy co)    f bound_vars acc = tyCoFVsOfCo co f bound_vars acc++tyCoFVsBndr :: TyCoVarBinder -> FV -> FV+-- Free vars of (forall b. <thing with fvs>)+tyCoFVsBndr (Bndr tv _) fvs = tyCoFVsVarBndr tv fvs++tyCoFVsVarBndrs :: [Var] -> FV -> FV+tyCoFVsVarBndrs vars fvs = foldr tyCoFVsVarBndr fvs vars++tyCoFVsVarBndr :: Var -> FV -> FV+tyCoFVsVarBndr var fvs+  = tyCoFVsOfType (varType var)   -- Free vars of its type/kind+    `unionFV` delFV var fvs       -- Delete it from the thing-inside++tyCoFVsOfTypes :: [Type] -> FV+-- See Note [Free variables of types]+tyCoFVsOfTypes (ty:tys) fv_cand in_scope acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfTypes tys) fv_cand in_scope acc+tyCoFVsOfTypes []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc++-- | Get a deterministic set of the vars free in a coercion+tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet+-- See Note [Free variables of types]+tyCoVarsOfCoDSet co = fvDVarSet $ tyCoFVsOfCo co++tyCoVarsOfCoList :: Coercion -> [TyCoVar]+-- See Note [Free variables of types]+tyCoVarsOfCoList co = fvVarList $ tyCoFVsOfCo co++tyCoFVsOfMCo :: MCoercion -> FV+tyCoFVsOfMCo MRefl    = emptyFV+tyCoFVsOfMCo (MCo co) = tyCoFVsOfCo co++tyCoVarsOfCosSet :: CoVarEnv Coercion -> TyCoVarSet+tyCoVarsOfCosSet cos = tyCoVarsOfCos $ nonDetEltsUFM cos+  -- It's OK to use nonDetEltsUFM here because we immediately forget the+  -- ordering by returning a set++tyCoFVsOfCo :: Coercion -> FV+-- Extracts type and coercion variables from a coercion+-- See Note [Free variables of types]+tyCoFVsOfCo (Refl ty) fv_cand in_scope acc+  = tyCoFVsOfType ty fv_cand in_scope acc+tyCoFVsOfCo (GRefl _ ty mco) fv_cand in_scope acc+  = (tyCoFVsOfType ty `unionFV` tyCoFVsOfMCo mco) fv_cand in_scope acc+tyCoFVsOfCo (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc+tyCoFVsOfCo (AppCo co arg) fv_cand in_scope acc+  = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc+tyCoFVsOfCo (ForAllCo tv kind_co co) fv_cand in_scope acc+  = (tyCoFVsVarBndr tv (tyCoFVsOfCo co) `unionFV` tyCoFVsOfCo kind_co) fv_cand in_scope acc+tyCoFVsOfCo (FunCo _ co1 co2)    fv_cand in_scope acc+  = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc+tyCoFVsOfCo (CoVarCo v) fv_cand in_scope acc+  = tyCoFVsOfCoVar v fv_cand in_scope acc+tyCoFVsOfCo (HoleCo h) fv_cand in_scope acc+  = tyCoFVsOfCoVar (coHoleCoVar h) fv_cand in_scope acc+    -- See Note [CoercionHoles and coercion free variables]+tyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc+tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc+  = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1+                     `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc+tyCoFVsOfCo (SymCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (TransCo co1 co2)   fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc+tyCoFVsOfCo (NthCo _ _ co)      fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (LRCo _ co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (InstCo co arg)     fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc+tyCoFVsOfCo (KindCo co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (SubCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfCo (AxiomRuleCo _ cs)  fv_cand in_scope acc = tyCoFVsOfCos cs fv_cand in_scope acc++tyCoFVsOfCoVar :: CoVar -> FV+tyCoFVsOfCoVar v fv_cand in_scope acc+  = (unitFV v `unionFV` tyCoFVsOfType (varType v)) fv_cand in_scope acc++tyCoFVsOfProv :: UnivCoProvenance -> FV+tyCoFVsOfProv UnsafeCoerceProv    fv_cand in_scope acc = emptyFV fv_cand in_scope acc+tyCoFVsOfProv (PhantomProv co)    fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc+tyCoFVsOfProv (PluginProv _)      fv_cand in_scope acc = emptyFV fv_cand in_scope acc++tyCoFVsOfCos :: [Coercion] -> FV+tyCoFVsOfCos []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc+tyCoFVsOfCos (co:cos) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCos cos) fv_cand in_scope acc+++------------- Extracting the CoVars of a type or coercion -----------++{-++Note [CoVarsOfX and the InterestingVarFun]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++The coVarsOfType, coVarsOfTypes, coVarsOfCo, and coVarsOfCos functions are+implemented in terms of the respective FV equivalents (tyCoFVsOf...), rather+than the VarSet-based flavors (tyCoVarsOf...), despite the performance+considerations outlined in Note [Free variables of types].++This is because FV includes the InterestingVarFun, which is useful here,+because we can cleverly use it to restrict our calculations to CoVars - this+is what getCoVarSet achieves.++See #14880.++-}++getCoVarSet :: FV -> CoVarSet+getCoVarSet fv = snd (fv isCoVar emptyVarSet ([], emptyVarSet))++coVarsOfType :: Type -> CoVarSet+coVarsOfType ty = getCoVarSet (tyCoFVsOfType ty)++coVarsOfTypes :: [Type] -> TyCoVarSet+coVarsOfTypes tys = getCoVarSet (tyCoFVsOfTypes tys)++coVarsOfCo :: Coercion -> CoVarSet+coVarsOfCo co = getCoVarSet (tyCoFVsOfCo co)++coVarsOfCos :: [Coercion] -> CoVarSet+coVarsOfCos cos = getCoVarSet (tyCoFVsOfCos cos)++----- Whether a covar is /Almost Devoid/ in a type or coercion ----++-- | Given a covar and a coercion, returns True if covar is almost devoid in+-- the coercion. That is, covar can only appear in Refl and GRefl.+-- See last wrinkle in Note [Unused coercion variable in ForAllCo] in Coercion+almostDevoidCoVarOfCo :: CoVar -> Coercion -> Bool+almostDevoidCoVarOfCo cv co =+  almost_devoid_co_var_of_co co cv++almost_devoid_co_var_of_co :: Coercion -> CoVar -> Bool+almost_devoid_co_var_of_co (Refl {}) _ = True   -- covar is allowed in Refl and+almost_devoid_co_var_of_co (GRefl {}) _ = True  -- GRefl, so we don't look into+                                                -- the coercions+almost_devoid_co_var_of_co (TyConAppCo _ _ cos) cv+  = almost_devoid_co_var_of_cos cos cv+almost_devoid_co_var_of_co (AppCo co arg) cv+  = almost_devoid_co_var_of_co co cv+  && almost_devoid_co_var_of_co arg cv+almost_devoid_co_var_of_co (ForAllCo v kind_co co) cv+  = almost_devoid_co_var_of_co kind_co cv+  && (v == cv || almost_devoid_co_var_of_co co cv)+almost_devoid_co_var_of_co (FunCo _ co1 co2) cv+  = almost_devoid_co_var_of_co co1 cv+  && almost_devoid_co_var_of_co co2 cv+almost_devoid_co_var_of_co (CoVarCo v) cv = v /= cv+almost_devoid_co_var_of_co (HoleCo h)  cv = (coHoleCoVar h) /= cv+almost_devoid_co_var_of_co (AxiomInstCo _ _ cos) cv+  = almost_devoid_co_var_of_cos cos cv+almost_devoid_co_var_of_co (UnivCo p _ t1 t2) cv+  = almost_devoid_co_var_of_prov p cv+  && almost_devoid_co_var_of_type t1 cv+  && almost_devoid_co_var_of_type t2 cv+almost_devoid_co_var_of_co (SymCo co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (TransCo co1 co2) cv+  = almost_devoid_co_var_of_co co1 cv+  && almost_devoid_co_var_of_co co2 cv+almost_devoid_co_var_of_co (NthCo _ _ co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (LRCo _ co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (InstCo co arg) cv+  = almost_devoid_co_var_of_co co cv+  && almost_devoid_co_var_of_co arg cv+almost_devoid_co_var_of_co (KindCo co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (SubCo co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_co (AxiomRuleCo _ cs) cv+  = almost_devoid_co_var_of_cos cs cv++almost_devoid_co_var_of_cos :: [Coercion] -> CoVar -> Bool+almost_devoid_co_var_of_cos [] _ = True+almost_devoid_co_var_of_cos (co:cos) cv+  = almost_devoid_co_var_of_co co cv+  && almost_devoid_co_var_of_cos cos cv++almost_devoid_co_var_of_prov :: UnivCoProvenance -> CoVar -> Bool+almost_devoid_co_var_of_prov (PhantomProv co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_prov (ProofIrrelProv co) cv+  = almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_prov UnsafeCoerceProv _ = True+almost_devoid_co_var_of_prov (PluginProv _) _ = True++almost_devoid_co_var_of_type :: Type -> CoVar -> Bool+almost_devoid_co_var_of_type (TyVarTy _) _ = True+almost_devoid_co_var_of_type (TyConApp _ tys) cv+  = almost_devoid_co_var_of_types tys cv+almost_devoid_co_var_of_type (LitTy {}) _ = True+almost_devoid_co_var_of_type (AppTy fun arg) cv+  = almost_devoid_co_var_of_type fun cv+  && almost_devoid_co_var_of_type arg cv+almost_devoid_co_var_of_type (FunTy _ arg res) cv+  = almost_devoid_co_var_of_type arg cv+  && almost_devoid_co_var_of_type res cv+almost_devoid_co_var_of_type (ForAllTy (Bndr v _) ty) cv+  = almost_devoid_co_var_of_type (varType v) cv+  && (v == cv || almost_devoid_co_var_of_type ty cv)+almost_devoid_co_var_of_type (CastTy ty co) cv+  = almost_devoid_co_var_of_type ty cv+  && almost_devoid_co_var_of_co co cv+almost_devoid_co_var_of_type (CoercionTy co) cv+  = almost_devoid_co_var_of_co co cv++almost_devoid_co_var_of_types :: [Type] -> CoVar -> Bool+almost_devoid_co_var_of_types [] _ = True+almost_devoid_co_var_of_types (ty:tys) cv+  = almost_devoid_co_var_of_type ty cv+  && almost_devoid_co_var_of_types tys cv++------------- Injective free vars -----------------++-- | Returns the free variables of a 'Type' that are in injective positions.+-- Specifically, it finds the free variables while:+--+-- * Expanding type synonyms+--+-- * Ignoring the coercion in @(ty |> co)@+--+-- * Ignoring the non-injective fields of a 'TyConApp'+--+--+-- For example, if @F@ is a non-injective type family, then:+--+-- @+-- injectiveTyVarsOf( Either c (Maybe (a, F b c)) ) = {a,c}+-- @+--+-- If @'injectiveVarsOfType' ty = itvs@, then knowing @ty@ fixes @itvs@.+-- More formally, if+-- @a@ is in @'injectiveVarsOfType' ty@+-- and  @S1(ty) ~ S2(ty)@,+-- then @S1(a)  ~ S2(a)@,+-- where @S1@ and @S2@ are arbitrary substitutions.+--+-- See @Note [When does a tycon application need an explicit kind signature?]@.+injectiveVarsOfType :: Type -> FV+injectiveVarsOfType = go+  where+    go ty                 | Just ty' <- coreView ty+                          = go ty'+    go (TyVarTy v)        = unitFV v `unionFV` go (tyVarKind v)+    go (AppTy f a)        = go f `unionFV` go a+    go (FunTy _ ty1 ty2)  = go ty1 `unionFV` go ty2+    go (TyConApp tc tys)  =+      case tyConInjectivityInfo tc of+        NotInjective  -> emptyFV+        Injective inj -> mapUnionFV go $+                         filterByList (inj ++ repeat True) tys+                         -- Oversaturated arguments to a tycon are+                         -- always injective, hence the repeat True+    go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go ty+    go LitTy{}           = emptyFV+    go (CastTy ty _)     = go ty+    go CoercionTy{}      = emptyFV++-- | Returns the free variables of a 'Type' that are in injective positions.+-- Specifically, it finds the free variables while:+--+-- * Expanding type synonyms+--+-- * Ignoring the coercion in @(ty |> co)@+--+-- * Ignoring the non-injective fields of a 'TyConApp'+--+-- See @Note [When does a tycon application need an explicit kind signature?]@.+injectiveVarsOfTypes :: [Type] -> FV+injectiveVarsOfTypes tys = mapUnionFV injectiveVarsOfType tys++------------- No free vars -----------------++-- | Returns True if this type has no free variables. Should be the same as+-- isEmptyVarSet . tyCoVarsOfType, but faster in the non-forall case.+noFreeVarsOfType :: Type -> Bool+noFreeVarsOfType (TyVarTy _)      = False+noFreeVarsOfType (AppTy t1 t2)    = noFreeVarsOfType t1 && noFreeVarsOfType t2+noFreeVarsOfType (TyConApp _ tys) = all noFreeVarsOfType tys+noFreeVarsOfType ty@(ForAllTy {}) = isEmptyVarSet (tyCoVarsOfType ty)+noFreeVarsOfType (FunTy _ t1 t2)  = noFreeVarsOfType t1 && noFreeVarsOfType t2+noFreeVarsOfType (LitTy _)        = True+noFreeVarsOfType (CastTy ty co)   = noFreeVarsOfType ty && noFreeVarsOfCo co+noFreeVarsOfType (CoercionTy co)  = noFreeVarsOfCo co++noFreeVarsOfMCo :: MCoercion -> Bool+noFreeVarsOfMCo MRefl    = True+noFreeVarsOfMCo (MCo co) = noFreeVarsOfCo co++noFreeVarsOfTypes :: [Type] -> Bool+noFreeVarsOfTypes = all noFreeVarsOfType++-- | Returns True if this coercion has no free variables. Should be the same as+-- isEmptyVarSet . tyCoVarsOfCo, but faster in the non-forall case.+noFreeVarsOfCo :: Coercion -> Bool+noFreeVarsOfCo (Refl ty)              = noFreeVarsOfType ty+noFreeVarsOfCo (GRefl _ ty co)        = noFreeVarsOfType ty && noFreeVarsOfMCo co+noFreeVarsOfCo (TyConAppCo _ _ args)  = all noFreeVarsOfCo args+noFreeVarsOfCo (AppCo c1 c2)          = noFreeVarsOfCo c1 && noFreeVarsOfCo c2+noFreeVarsOfCo co@(ForAllCo {})       = isEmptyVarSet (tyCoVarsOfCo co)+noFreeVarsOfCo (FunCo _ c1 c2)        = noFreeVarsOfCo c1 && noFreeVarsOfCo c2+noFreeVarsOfCo (CoVarCo _)            = False+noFreeVarsOfCo (HoleCo {})            = True    -- I'm unsure; probably never happens+noFreeVarsOfCo (AxiomInstCo _ _ args) = all noFreeVarsOfCo args+noFreeVarsOfCo (UnivCo p _ t1 t2)     = noFreeVarsOfProv p &&+                                        noFreeVarsOfType t1 &&+                                        noFreeVarsOfType t2+noFreeVarsOfCo (SymCo co)             = noFreeVarsOfCo co+noFreeVarsOfCo (TransCo co1 co2)      = noFreeVarsOfCo co1 && noFreeVarsOfCo co2+noFreeVarsOfCo (NthCo _ _ co)         = noFreeVarsOfCo co+noFreeVarsOfCo (LRCo _ co)            = noFreeVarsOfCo co+noFreeVarsOfCo (InstCo co1 co2)       = noFreeVarsOfCo co1 && noFreeVarsOfCo co2+noFreeVarsOfCo (KindCo co)            = noFreeVarsOfCo co+noFreeVarsOfCo (SubCo co)             = noFreeVarsOfCo co+noFreeVarsOfCo (AxiomRuleCo _ cs)     = all noFreeVarsOfCo cs++-- | Returns True if this UnivCoProv has no free variables. Should be the same as+-- isEmptyVarSet . tyCoVarsOfProv, but faster in the non-forall case.+noFreeVarsOfProv :: UnivCoProvenance -> Bool+noFreeVarsOfProv UnsafeCoerceProv    = True+noFreeVarsOfProv (PhantomProv co)    = noFreeVarsOfCo co+noFreeVarsOfProv (ProofIrrelProv co) = noFreeVarsOfCo co+noFreeVarsOfProv (PluginProv {})     = True++{-+%************************************************************************+%*                                                                      *+         Well-scoped tyvars+*                                                                      *+************************************************************************++Note [ScopedSort]+~~~~~~~~~~~~~~~~~+Consider++  foo :: Proxy a -> Proxy (b :: k) -> Proxy (a :: k2) -> ()++This function type is implicitly generalised over [a, b, k, k2]. These+variables will be Specified; that is, they will be available for visible+type application. This is because they are written in the type signature+by the user.++However, we must ask: what order will they appear in? In cases without+dependency, this is easy: we just use the lexical left-to-right ordering+of first occurrence. With dependency, we cannot get off the hook so+easily.++We thus state:++ * These variables appear in the order as given by ScopedSort, where+   the input to ScopedSort is the left-to-right order of first occurrence.++Note that this applies only to *implicit* quantification, without a+`forall`. If the user writes a `forall`, then we just use the order given.++ScopedSort is defined thusly (as proposed in #15743):+  * Work left-to-right through the input list, with a cursor.+  * If variable v at the cursor is depended on by any earlier variable w,+    move v immediately before the leftmost such w.++INVARIANT: The prefix of variables before the cursor form a valid telescope.++Note that ScopedSort makes sense only after type inference is done and all+types/kinds are fully settled and zonked.++-}++-- | Do a topological sort on a list of tyvars,+--   so that binders occur before occurrences+-- E.g. given  [ a::k, k::*, b::k ]+-- it'll return a well-scoped list [ k::*, a::k, b::k ]+--+-- This is a deterministic sorting operation+-- (that is, doesn't depend on Uniques).+--+-- It is also meant to be stable: that is, variables should not+-- be reordered unnecessarily. This is specified in Note [ScopedSort]+-- See also Note [Ordering of implicit variables] in RnTypes++scopedSort :: [TyCoVar] -> [TyCoVar]+scopedSort = go [] []+  where+    go :: [TyCoVar] -- already sorted, in reverse order+       -> [TyCoVarSet] -- each set contains all the variables which must be placed+                       -- before the tv corresponding to the set; they are accumulations+                       -- of the fvs in the sorted tvs' kinds++                       -- This list is in 1-to-1 correspondence with the sorted tyvars+                       -- INVARIANT:+                       --   all (\tl -> all (`subVarSet` head tl) (tail tl)) (tails fv_list)+                       -- That is, each set in the list is a superset of all later sets.++       -> [TyCoVar] -- yet to be sorted+       -> [TyCoVar]+    go acc _fv_list [] = reverse acc+    go acc  fv_list (tv:tvs)+      = go acc' fv_list' tvs+      where+        (acc', fv_list') = insert tv acc fv_list++    insert :: TyCoVar       -- var to insert+           -> [TyCoVar]     -- sorted list, in reverse order+           -> [TyCoVarSet]  -- list of fvs, as above+           -> ([TyCoVar], [TyCoVarSet])   -- augmented lists+    insert tv []     []         = ([tv], [tyCoVarsOfType (tyVarKind tv)])+    insert tv (a:as) (fvs:fvss)+      | tv `elemVarSet` fvs+      , (as', fvss') <- insert tv as fvss+      = (a:as', fvs `unionVarSet` fv_tv : fvss')++      | otherwise+      = (tv:a:as, fvs `unionVarSet` fv_tv : fvs : fvss)+      where+        fv_tv = tyCoVarsOfType (tyVarKind tv)++       -- lists not in correspondence+    insert _ _ _ = panic "scopedSort"++-- | Get the free vars of a type in scoped order+tyCoVarsOfTypeWellScoped :: Type -> [TyVar]+tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList++-- | Get the free vars of types in scoped order+tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar]+tyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList+

@@ -0,0 +1,308 @@+-- | Pretty-printing types and coercions.+module TyCoPpr+  (+        -- * Pretty-printing+        pprType, pprParendType, pprPrecType, pprPrecTypeX,+        pprTypeApp, pprTCvBndr, pprTCvBndrs,+        pprSigmaType,+        pprTheta, pprParendTheta, pprForAll, pprUserForAll,+        pprTyVar, pprTyVars,+        pprThetaArrowTy, pprClassPred,+        pprKind, pprParendKind, pprTyLit,+        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,+        pprDataCons, pprWithExplicitKindsWhen,++        pprCo, pprParendCo,++        debugPprType,+  ) where++import GhcPrelude++import {-# SOURCE #-} ToIface( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr+                             , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )+import {-# SOURCE #-} DataCon( dataConFullSig+                             , dataConUserTyVarBinders+                             , DataCon )++import TyCon+import TyCoRep+import TyCoTidy+import TyCoFVs+import Class+import Var++import IfaceType++import VarSet+import VarEnv++import DynFlags   ( gopt_set, GeneralFlag(Opt_PrintExplicitKinds) )+import Outputable+import BasicTypes ( PprPrec(..), topPrec, sigPrec, opPrec+                  , funPrec, appPrec, maybeParen )++{-+%************************************************************************+%*                                                                      *+                   Pretty-printing types++       Defined very early because of debug printing in assertions+%*                                                                      *+%************************************************************************++@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is+defined to use this.  @pprParendType@ is the same, except it puts+parens around the type, except for the atomic cases.  @pprParendType@+works just by setting the initial context precedence very high.++Note that any function which pretty-prints a @Type@ first converts the @Type@+to an @IfaceType@. See Note [IfaceType and pretty-printing] in IfaceType.++See Note [Precedence in types] in BasicTypes.+-}++--------------------------------------------------------+-- When pretty-printing types, we convert to IfaceType,+--   and pretty-print that.+-- See Note [Pretty printing via IfaceSyn] in PprTyThing+--------------------------------------------------------++pprType, pprParendType :: Type -> SDoc+pprType       = pprPrecType topPrec+pprParendType = pprPrecType appPrec++pprPrecType :: PprPrec -> Type -> SDoc+pprPrecType = pprPrecTypeX emptyTidyEnv++pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc+pprPrecTypeX env prec ty+  = getPprStyle $ \sty ->+    if debugStyle sty           -- Use debugPprType when in+    then debug_ppr_ty prec ty   -- when in debug-style+    else pprPrecIfaceType prec (tidyToIfaceTypeStyX env ty sty)+    -- NB: debug-style is used for -dppr-debug+    --     dump-style  is used for -ddump-tc-trace etc++pprTyLit :: TyLit -> SDoc+pprTyLit = pprIfaceTyLit . toIfaceTyLit++pprKind, pprParendKind :: Kind -> SDoc+pprKind       = pprType+pprParendKind = pprParendType++tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType+tidyToIfaceTypeStyX env ty sty+  | userStyle sty = tidyToIfaceTypeX env ty+  | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty+     -- in latter case, don't tidy, as we'll be printing uniques.++tidyToIfaceType :: Type -> IfaceType+tidyToIfaceType = tidyToIfaceTypeX emptyTidyEnv++tidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType+-- It's vital to tidy before converting to an IfaceType+-- or nested binders will become indistinguishable!+--+-- Also for the free type variables, tell toIfaceTypeX to+-- leave them as IfaceFreeTyVar.  This is super-important+-- for debug printing.+tidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty)+  where+    env'      = tidyFreeTyCoVars env free_tcvs+    free_tcvs = tyCoVarsOfTypeWellScoped ty++------------+pprCo, pprParendCo :: Coercion -> SDoc+pprCo       co = getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty)+pprParendCo co = getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty)++tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion+tidyToIfaceCoSty co sty+  | userStyle sty = tidyToIfaceCo co+  | otherwise     = toIfaceCoercionX (tyCoVarsOfCo co) co+     -- in latter case, don't tidy, as we'll be printing uniques.++tidyToIfaceCo :: Coercion -> IfaceCoercion+-- It's vital to tidy before converting to an IfaceType+-- or nested binders will become indistinguishable!+--+-- Also for the free type variables, tell toIfaceCoercionX to+-- leave them as IfaceFreeCoVar.  This is super-important+-- for debug printing.+tidyToIfaceCo co = toIfaceCoercionX (mkVarSet free_tcvs) (tidyCo env co)+  where+    env       = tidyFreeTyCoVars emptyTidyEnv free_tcvs+    free_tcvs = scopedSort $ tyCoVarsOfCoList co+------------+pprClassPred :: Class -> [Type] -> SDoc+pprClassPred clas tys = pprTypeApp (classTyCon clas) tys++------------+pprTheta :: ThetaType -> SDoc+pprTheta = pprIfaceContext topPrec . map tidyToIfaceType++pprParendTheta :: ThetaType -> SDoc+pprParendTheta = pprIfaceContext appPrec . map tidyToIfaceType++pprThetaArrowTy :: ThetaType -> SDoc+pprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType++------------------+pprSigmaType :: Type -> SDoc+pprSigmaType = pprIfaceSigmaType ShowForAllWhen . tidyToIfaceType++pprForAll :: [TyCoVarBinder] -> SDoc+pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)++-- | Print a user-level forall; see Note [When to print foralls] in this module.+pprUserForAll :: [TyCoVarBinder] -> SDoc+pprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr++pprTCvBndrs :: [TyCoVarBinder] -> SDoc+pprTCvBndrs tvs = sep (map pprTCvBndr tvs)++pprTCvBndr :: TyCoVarBinder -> SDoc+pprTCvBndr = pprTyVar . binderVar++pprTyVars :: [TyVar] -> SDoc+pprTyVars tvs = sep (map pprTyVar tvs)++pprTyVar :: TyVar -> SDoc+-- Print a type variable binder with its kind (but not if *)+-- Here we do not go via IfaceType, because the duplication with+-- pprIfaceTvBndr is minimal, and the loss of uniques etc in+-- debug printing is disastrous+pprTyVar tv+  | isLiftedTypeKind kind = ppr tv+  | otherwise             = parens (ppr tv <+> dcolon <+> ppr kind)+  where+    kind = tyVarKind tv++-----------------+debugPprType :: Type -> SDoc+-- ^ debugPprType is a simple pretty printer that prints a type+-- without going through IfaceType.  It does not format as prettily+-- as the normal route, but it's much more direct, and that can+-- be useful for debugging.  E.g. with -dppr-debug it prints the+-- kind on type-variable /occurrences/ which the normal route+-- fundamentally cannot do.+debugPprType ty = debug_ppr_ty topPrec ty++debug_ppr_ty :: PprPrec -> Type -> SDoc+debug_ppr_ty _ (LitTy l)+  = ppr l++debug_ppr_ty _ (TyVarTy tv)+  = ppr tv  -- With -dppr-debug we get (tv :: kind)++debug_ppr_ty prec (FunTy { ft_af = af, ft_arg = arg, ft_res = res })+  = maybeParen prec funPrec $+    sep [debug_ppr_ty funPrec arg, arrow <+> debug_ppr_ty prec res]+  where+    arrow = case af of+              VisArg   -> text "->"+              InvisArg -> text "=>"++debug_ppr_ty prec (TyConApp tc tys)+  | null tys  = ppr tc+  | otherwise = maybeParen prec appPrec $+                hang (ppr tc) 2 (sep (map (debug_ppr_ty appPrec) tys))++debug_ppr_ty _ (AppTy t1 t2)+  = hang (debug_ppr_ty appPrec t1)  -- Print parens so we see ((a b) c)+       2 (debug_ppr_ty appPrec t2)  -- so that we can distinguish+                                    -- TyConApp from AppTy++debug_ppr_ty prec (CastTy ty co)+  = maybeParen prec topPrec $+    hang (debug_ppr_ty topPrec ty)+       2 (text "|>" <+> ppr co)++debug_ppr_ty _ (CoercionTy co)+  = parens (text "CO" <+> ppr co)++debug_ppr_ty prec ty@(ForAllTy {})+  | (tvs, body) <- split ty+  = maybeParen prec funPrec $+    hang (text "forall" <+> fsep (map ppr tvs) <> dot)+         -- The (map ppr tvs) will print kind-annotated+         -- tvs, because we are (usually) in debug-style+       2 (ppr body)+  where+    split ty | ForAllTy tv ty' <- ty+             , (tvs, body) <- split ty'+             = (tv:tvs, body)+             | otherwise+             = ([], ty)++{-+Note [When to print foralls]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Mostly we want to print top-level foralls when (and only when) the user specifies+-fprint-explicit-foralls.  But when kind polymorphism is at work, that suppresses+too much information; see #9018.++So I'm trying out this rule: print explicit foralls if+  a) User specifies -fprint-explicit-foralls, or+  b) Any of the quantified type variables has a kind+     that mentions a kind variable++This catches common situations, such as a type siguature+     f :: m a+which means+      f :: forall k. forall (m :: k->*) (a :: k). m a+We really want to see both the "forall k" and the kind signatures+on m and a.  The latter comes from pprTCvBndr.++Note [Infix type variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+With TypeOperators you can say++   f :: (a ~> b) -> b++and the (~>) is considered a type variable.  However, the type+pretty-printer in this module will just see (a ~> b) as++   App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")++So it'll print the type in prefix form.  To avoid confusion we must+remember to parenthesise the operator, thus++   (~>) a b -> b++See #2766.+-}++pprDataCons :: TyCon -> SDoc+pprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons+  where+    sepWithVBars [] = empty+    sepWithVBars docs = sep (punctuate (space <> vbar) docs)++pprDataConWithArgs :: DataCon -> SDoc+pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]+  where+    (_univ_tvs, _ex_tvs, _eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc+    user_bndrs = dataConUserTyVarBinders dc+    forAllDoc  = pprUserForAll user_bndrs+    thetaDoc   = pprThetaArrowTy theta+    argsDoc    = hsep (fmap pprParendType arg_tys)+++pprTypeApp :: TyCon -> [Type] -> SDoc+pprTypeApp tc tys+  = pprIfaceTypeApp topPrec (toIfaceTyCon tc)+                            (toIfaceTcArgs tc tys)+    -- TODO: toIfaceTcArgs seems rather wasteful here++------------------+-- | Display all kind information (with @-fprint-explicit-kinds@) when the+-- provided 'Bool' argument is 'True'.+-- See @Note [Kind arguments in error messages]@ in "TcErrors".+pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc+pprWithExplicitKindsWhen b+  = updSDocDynFlags $ \dflags ->+      if b then gopt_set dflags Opt_PrintExplicitKinds+           else dflags+

@@ -0,0 +1,10 @@+module TyCoPpr where++import {-# SOURCE #-} TyCoRep (Type, Kind, Coercion, TyLit)+import Outputable++pprType :: Type -> SDoc+pprKind :: Kind -> SDoc+pprCo :: Coercion -> SDoc+pprTyLit :: TyLit -> SDoc+

@@ -9,4079 +9,1715 @@   CoAxiom   TyCon    imports Class, CoAxiom   TyCoRep  imports Class, CoAxiom, TyCon-  TysPrim  imports TyCoRep ( including mkTyConTy )-  Kind     imports TysPrim ( mainly for primitive kinds )-  Type     imports Kind-  Coercion imports Type--}---- We expose the relevant stuff from this module via the Type module-{-# OPTIONS_HADDOCK not-home #-}-{-# LANGUAGE CPP, DeriveDataTypeable, MultiWayIf, PatternSynonyms, BangPatterns #-}--module TyCoRep (-        TyThing(..), tyThingCategory, pprTyThingCategory, pprShortTyThing,--        -- * Types-        Type( TyVarTy, AppTy, TyConApp, ForAllTy-            , LitTy, CastTy, CoercionTy-            , FunTy, ft_arg, ft_res, ft_af-            ),  -- Export the type synonym FunTy too--        TyLit(..),-        KindOrType, Kind,-        KnotTied,-        PredType, ThetaType,      -- Synonyms-        ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),--        -- * Coercions-        Coercion(..),-        UnivCoProvenance(..),-        CoercionHole(..), coHoleCoVar, setCoHoleCoVar,-        CoercionN, CoercionR, CoercionP, KindCoercion,-        MCoercion(..), MCoercionR, MCoercionN,--        -- * Functions over types-        mkTyConTy, mkTyVarTy, mkTyVarTys,-        mkTyCoVarTy, mkTyCoVarTys,-        mkFunTy, mkVisFunTy, mkInvisFunTy, mkVisFunTys, mkInvisFunTys,-        mkForAllTy, mkForAllTys,-        mkPiTy, mkPiTys,--        kindRep_maybe, kindRep,-        isLiftedTypeKind, isUnliftedTypeKind,-        isLiftedRuntimeRep, isUnliftedRuntimeRep,-        isRuntimeRepTy, isRuntimeRepVar,-        sameVis,--        -- * Functions over binders-        TyCoBinder(..), TyCoVarBinder, TyBinder,-        binderVar, binderVars, binderType, binderArgFlag,-        delBinderVar,-        isInvisibleArgFlag, isVisibleArgFlag,-        isInvisibleBinder, isVisibleBinder,-        isTyBinder, isNamedBinder,--        -- * Functions over coercions-        pickLR,--        -- * Pretty-printing-        pprType, pprParendType, pprPrecType, pprPrecTypeX,-        pprTypeApp, pprTCvBndr, pprTCvBndrs,-        pprSigmaType,-        pprTheta, pprParendTheta, pprForAll, pprUserForAll,-        pprTyVar, pprTyVars,-        pprThetaArrowTy, pprClassPred,-        pprKind, pprParendKind, pprTyLit,-        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,-        pprDataCons, pprWithExplicitKindsWhen,--        pprCo, pprParendCo,--        debugPprType,--        -- * Free variables-        tyCoVarsOfType, tyCoVarsOfTypeDSet, tyCoVarsOfTypes, tyCoVarsOfTypesDSet,-        tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,-        tyCoFVsOfType, tyCoVarsOfTypeList,-        tyCoFVsOfTypes, tyCoVarsOfTypesList,-        coVarsOfType, coVarsOfTypes,-        coVarsOfCo, coVarsOfCos,-        tyCoVarsOfCo, tyCoVarsOfCos,-        tyCoVarsOfCoDSet,-        tyCoFVsOfCo, tyCoFVsOfCos,-        tyCoVarsOfCoList, tyCoVarsOfProv,-        almostDevoidCoVarOfCo,-        injectiveVarsOfType, tyConAppNeedsKindSig,--        noFreeVarsOfType, noFreeVarsOfCo,--        -- * Substitutions-        TCvSubst(..), TvSubstEnv, CvSubstEnv,-        emptyTvSubstEnv, emptyCvSubstEnv, composeTCvSubstEnv, composeTCvSubst,-        emptyTCvSubst, mkEmptyTCvSubst, isEmptyTCvSubst,-        mkTCvSubst, mkTvSubst, mkCvSubst,-        getTvSubstEnv,-        getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs,-        isInScope, notElemTCvSubst,-        setTvSubstEnv, setCvSubstEnv, zapTCvSubst,-        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,-        extendTCvSubst, extendTCvSubstWithClone,-        extendCvSubst, extendCvSubstWithClone,-        extendTvSubst, extendTvSubstBinderAndInScope, extendTvSubstWithClone,-        extendTvSubstList, extendTvSubstAndInScope,-        extendTCvSubstList,-        unionTCvSubst, zipTyEnv, zipCoEnv, mkTyCoInScopeSet,-        zipTvSubst, zipCvSubst,-        zipTCvSubst,-        mkTvSubstPrs,--        substTyWith, substTyWithCoVars, substTysWith, substTysWithCoVars,-        substCoWith,-        substTy, substTyAddInScope,-        substTyUnchecked, substTysUnchecked, substThetaUnchecked,-        substTyWithUnchecked,-        substCoUnchecked, substCoWithUnchecked,-        substTyWithInScope,-        substTys, substTheta,-        lookupTyVar,-        substCo, substCos, substCoVar, substCoVars, lookupCoVar,-        cloneTyVarBndr, cloneTyVarBndrs,-        substVarBndr, substVarBndrs,-        substTyVarBndr, substTyVarBndrs,-        substCoVarBndr,-        substTyVar, substTyVars, substTyCoVars,-        substForAllCoBndr,-        substVarBndrUsing, substForAllCoBndrUsing,-        checkValidSubst, isValidTCvSubst,--        -- * Tidying type related things up for printing-        tidyType,      tidyTypes,-        tidyOpenType,  tidyOpenTypes,-        tidyOpenKind,-        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars, avoidNameClashes,-        tidyOpenTyCoVar, tidyOpenTyCoVars,-        tidyTyCoVarOcc,-        tidyTopType,-        tidyKind,-        tidyCo, tidyCos,-        tidyTyCoVarBinder, tidyTyCoVarBinders,--        -- * Sizes-        typeSize, coercionSize, provSize-    ) where--#include "HsVersions.h"--import GhcPrelude--import {-# SOURCE #-} DataCon( dataConFullSig-                             , dataConUserTyVarBinders-                             , DataCon )-import {-# SOURCE #-} Type( isCoercionTy, mkAppTy, mkCastTy-                          , tyCoVarsOfTypeWellScoped-                          , tyCoVarsOfTypesWellScoped-                          , scopedSort-                          , coreView )-   -- Transitively pulls in a LOT of stuff, better to break the loop--import {-# SOURCE #-} Coercion-import {-# SOURCE #-} ConLike ( ConLike(..), conLikeName )-import {-# SOURCE #-} ToIface( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr-                             , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )---- friends:-import IfaceType-import Var-import VarEnv-import VarSet-import Name hiding ( varName )-import TyCon-import Class-import CoAxiom-import FV---- others-import BasicTypes ( LeftOrRight(..), PprPrec(..), topPrec, sigPrec, opPrec-                  , funPrec, appPrec, maybeParen, pickLR )-import PrelNames-import Outputable-import DynFlags-import FastString-import Pair-import UniqSupply-import Util-import UniqFM-import UniqSet---- libraries-import qualified Data.Data as Data hiding ( TyCon )-import Data.List-import Data.IORef ( IORef )   -- for CoercionHole--{--%************************************************************************-%*                                                                      *-                        TyThing-%*                                                                      *-%************************************************************************--Despite the fact that DataCon has to be imported via a hi-boot route,-this module seems the right place for TyThing, because it's needed for-funTyCon and all the types in TysPrim.--It is also SOURCE-imported into Name.hs---Note [ATyCon for classes]-~~~~~~~~~~~~~~~~~~~~~~~~~-Both classes and type constructors are represented in the type environment-as ATyCon.  You can tell the difference, and get to the class, with-   isClassTyCon :: TyCon -> Bool-   tyConClass_maybe :: TyCon -> Maybe Class-The Class and its associated TyCon have the same Name.--}---- | A global typecheckable-thing, essentially anything that has a name.--- Not to be confused with a 'TcTyThing', which is also a typecheckable--- thing but in the *local* context.  See 'TcEnv' for how to retrieve--- a 'TyThing' given a 'Name'.-data TyThing-  = AnId     Id-  | AConLike ConLike-  | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]-  | ACoAxiom (CoAxiom Branched)--instance Outputable TyThing where-  ppr = pprShortTyThing--instance NamedThing TyThing where       -- Can't put this with the type-  getName (AnId id)     = getName id    -- decl, because the DataCon instance-  getName (ATyCon tc)   = getName tc    -- isn't visible there-  getName (ACoAxiom cc) = getName cc-  getName (AConLike cl) = conLikeName cl--pprShortTyThing :: TyThing -> SDoc--- c.f. PprTyThing.pprTyThing, which prints all the details-pprShortTyThing thing-  = pprTyThingCategory thing <+> quotes (ppr (getName thing))--pprTyThingCategory :: TyThing -> SDoc-pprTyThingCategory = text . capitalise . tyThingCategory--tyThingCategory :: TyThing -> String-tyThingCategory (ATyCon tc)-  | isClassTyCon tc = "class"-  | otherwise       = "type constructor"-tyThingCategory (ACoAxiom _) = "coercion axiom"-tyThingCategory (AnId   _)   = "identifier"-tyThingCategory (AConLike (RealDataCon _)) = "data constructor"-tyThingCategory (AConLike (PatSynCon _))  = "pattern synonym"---{- **********************************************************************-*                                                                       *-                        Type-*                                                                       *-********************************************************************** -}---- | The key representation of types within the compiler--type KindOrType = Type -- See Note [Arguments to type constructors]---- | The key type representing kinds in the compiler.-type Kind = Type---- If you edit this type, you may need to update the GHC formalism--- See Note [GHC Formalism] in coreSyn/CoreLint.hs-data Type-  -- See Note [Non-trivial definitional equality]-  = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)--  | AppTy-        Type-        Type            -- ^ Type application to something other than a 'TyCon'. Parameters:-                        ---                        --  1) Function: must /not/ be a 'TyConApp' or 'CastTy',-                        --     must be another 'AppTy', or 'TyVarTy'-                        --     See Note [Respecting definitional equality] (EQ1) about the-                        --     no 'CastTy' requirement-                        ---                        --  2) Argument type--  | TyConApp-        TyCon-        [KindOrType]    -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.-                        -- Invariant: saturated applications of 'FunTyCon' must-                        -- use 'FunTy' and saturated synonyms must use their own-                        -- constructors. However, /unsaturated/ 'FunTyCon's-                        -- do appear as 'TyConApp's.-                        -- Parameters:-                        ---                        -- 1) Type constructor being applied to.-                        ---                        -- 2) Type arguments. Might not have enough type arguments-                        --    here to saturate the constructor.-                        --    Even type synonyms are not necessarily saturated;-                        --    for example unsaturated type synonyms-                        --    can appear as the right hand side of a type synonym.--  | ForAllTy-        {-# UNPACK #-} !TyCoVarBinder-        Type            -- ^ A Π type.--  | FunTy      -- ^ t1 -> t2   Very common, so an important special case-                -- See Note [Function types]-     { ft_af  :: AnonArgFlag  -- Is this (->) or (=>)?-     , ft_arg :: Type           -- Argument type-     , ft_res :: Type }         -- Result type--  | LitTy TyLit     -- ^ Type literals are similar to type constructors.--  | CastTy-        Type-        KindCoercion  -- ^ A kind cast. The coercion is always nominal.-                      -- INVARIANT: The cast is never refl.-                      -- INVARIANT: The Type is not a CastTy (use TransCo instead)-                      -- See Note [Respecting definitional equality] (EQ2) and (EQ3)--  | CoercionTy-        Coercion    -- ^ Injection of a Coercion into a type-                    -- This should only ever be used in the RHS of an AppTy,-                    -- in the list of a TyConApp, when applying a promoted-                    -- GADT data constructor--  deriving Data.Data---- NOTE:  Other parts of the code assume that type literals do not contain--- types or type variables.-data TyLit-  = NumTyLit Integer-  | StrTyLit FastString-  deriving (Eq, Ord, Data.Data)---{- Note [Function types]-~~~~~~~~~~~~~~~~~~~~~~~~-FFunTy is the constructor for a function type.  Lots of things to say-about it!--* FFunTy is the data constructor, meaning "full function type".--* The function type constructor (->) has kind-     (->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> Type LiftedRep-  mkTyConApp ensure that we convert a saturated application-    TyConApp (->) [r1,r2,t1,t2] into FunTy t1 t2-  dropping the 'r1' and 'r2' arguments; they are easily recovered-  from 't1' and 't2'.--* The ft_af field says whether or not this is an invisible argument-     VisArg:   t1 -> t2    Ordinary function type-     InvisArg: t1 => t2    t1 is guaranteed to be a predicate type,-                           i.e. t1 :: Constraint-  See Note [Types for coercions, predicates, and evidence]--  This visibility info makes no difference in Core; it matters-  only when we regard the type as a Haskell source type.--* FunTy is a (unidirectional) pattern synonym that allows-  positional pattern matching (FunTy arg res), ignoring the-  ArgFlag.--}--{- ------------------------      Commented out until the pattern match-      checker can handle it; see #16185--      For now we use the CPP macro #define FunTy FFunTy _-      (see HsVersions.h) to allow pattern matching on a-      (positional) FunTy constructor.--{-# COMPLETE FunTy, TyVarTy, AppTy, TyConApp-           , ForAllTy, LitTy, CastTy, CoercionTy :: Type #-}---- | 'FunTy' is a (uni-directional) pattern synonym for the common--- case where we want to match on the argument/result type, but--- ignoring the AnonArgFlag-pattern FunTy :: Type -> Type -> Type-pattern FunTy arg res <- FFunTy { ft_arg = arg, ft_res = res }--       End of commented out block----------------------------------- -}--{- Note [Types for coercions, predicates, and evidence]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We treat differently:--  (a) Predicate types-        Test: isPredTy-        Binders: DictIds-        Kind: Constraint-        Examples: (Eq a), and (a ~ b)--  (b) Coercion types are primitive, unboxed equalities-        Test: isCoVarTy-        Binders: CoVars (can appear in coercions)-        Kind: TYPE (TupleRep [])-        Examples: (t1 ~# t2) or (t1 ~R# t2)--  (c) Evidence types is the type of evidence manipulated by-      the type constraint solver.-        Test: isEvVarType-        Binders: EvVars-        Kind: Constraint or TYPE (TupleRep [])-        Examples: all coercion types and predicate types--Coercion types and predicate types are mutually exclusive,-but evidence types are a superset of both.--When treated as a user type,--  - Predicates (of kind Constraint) are invisible and are-    implicitly instantiated--  - Coercion types, and non-pred evidence types (i.e. not-    of kind Constrain), are just regular old types, are-    visible, and are not implicitly instantiated.--In a FunTy { ft_af = InvisArg }, the argument type is always-a Predicate type.--Note [Constraints in kinds]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-Do we allow a type constructor to have a kind like-   S :: Eq a => a -> Type--No, we do not.  Doing so would mean would need a TyConApp like-   S @k @(d :: Eq k) (ty :: k)- and we have no way to build, or decompose, evidence like- (d :: Eq k) at the type level.--But we admit one exception: equality.  We /do/ allow, say,-   MkT :: (a ~ b) => a -> b -> Type a b--Why?  Because we can, without much difficulty.  Moreover-we can promote a GADT data constructor (see TyCon-Note [Promoted data constructors]), like-  data GT a b where-    MkGT : a -> a -> GT a a-so programmers might reasonably expect to be able to-promote MkT as well.--How does this work?--* In TcValidity.checkConstraintsOK we reject kinds that-  have constraints other than (a~b) and (a~~b).--* In Inst.tcInstInvisibleTyBinder we instantiate a call-  of MkT by emitting-     [W] co :: alpha ~# beta-  and producing the elaborated term-     MkT @alpha @beta (Eq# alpha beta co)-  We don't generate a boxed "Wanted"; we generate only a-  regular old /unboxed/ primitive-equality Wanted, and build-  the box on the spot.--* How can we get such a MkT?  By promoting a GADT-style data-  constructor-     data T a b where-       MkT :: (a~b) => a -> b -> T a b-  See DataCon.mkPromotedDataCon-  and Note [Promoted data constructors] in TyCon--* We support both homogeneous (~) and heterogeneous (~~)-  equality.  (See Note [The equality types story]-  in TysPrim for a primer on these equality types.)--* How do we prevent a MkT having an illegal constraint like-  Eq a?  We check for this at use-sites; see TcHsType.tcTyVar,-  specifically dc_theta_illegal_constraint.--* Notice that nothing special happens if-    K :: (a ~# b) => blah-  because (a ~# b) is not a predicate type, and is never-  implicitly instantiated. (Mind you, it's not clear how you-  could creates a type constructor with such a kind.) See-  Note [Types for coercions, predicates, and evidence]--* The existence of promoted MkT with an equality-constraint-  argument is the (only) reason that the AnonTCB constructor-  of TyConBndrVis carries an AnonArgFlag (VisArg/InvisArg).-  For example, when we promote the data constructor-     MkT :: forall a b. (a~b) => a -> b -> T a b-  we get a PromotedDataCon with tyConBinders-      Bndr (a :: Type)  (NamedTCB Inferred)-      Bndr (b :: Type)  (NamedTCB Inferred)-      Bndr (_ :: a ~ b) (AnonTCB InvisArg)-      Bndr (_ :: a)     (AnonTCB VisArg))-      Bndr (_ :: b)     (AnonTCB VisArg))--* One might reasonably wonder who *unpacks* these boxes once they are-  made. After all, there is no type-level `case` construct. The-  surprising answer is that no one ever does. Instead, if a GADT-  constructor is used on the left-hand side of a type family equation,-  that occurrence forces GHC to unify the types in question. For-  example:--  data G a where-    MkG :: G Bool--  type family F (x :: G a) :: a where-    F MkG = False--  When checking the LHS `F MkG`, GHC sees the MkG constructor and then must-  unify F's implicit parameter `a` with Bool. This succeeds, making the equation--    F Bool (MkG @Bool <Bool>) = False--  Note that we never need unpack the coercion. This is because type-  family equations are *not* parametric in their kind variables. That-  is, we could have just said--  type family H (x :: G a) :: a where-    H _ = False--  The presence of False on the RHS also forces `a` to become Bool,-  giving us--    H Bool _ = False--  The fact that any of this works stems from the lack of phase-  separation between types and kinds (unlike the very present phase-  separation between terms and types).--  Once we have the ability to pattern-match on types below top-level,-  this will no longer cut it, but it seems fine for now.---Note [Arguments to type constructors]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Because of kind polymorphism, in addition to type application we now-have kind instantiation. We reuse the same notations to do so.--For example:--  Just (* -> *) Maybe-  Right * Nat Zero--are represented by:--  TyConApp (PromotedDataCon Just) [* -> *, Maybe]-  TyConApp (PromotedDataCon Right) [*, Nat, (PromotedDataCon Zero)]--Important note: Nat is used as a *kind* and not as a type. This can be-confusing, since type-level Nat and kind-level Nat are identical. We-use the kind of (PromotedDataCon Right) to know if its arguments are-kinds or types.--This kind instantiation only happens in TyConApp currently.--Note [Non-trivial definitional equality]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Is Int |> <*> the same as Int? YES! In order to reduce headaches,-we decide that any reflexive casts in types are just ignored.-(Indeed they must be. See Note [Respecting definitional equality].)-More generally, the `eqType` function, which defines Core's type equality-relation, ignores casts and coercion arguments, as long as the-two types have the same kind. This allows us to be a little sloppier-in keeping track of coercions, which is a good thing. It also means-that eqType does not depend on eqCoercion, which is also a good thing.--Why is this sensible? That is, why is something different than α-equivalence-appropriate for the implementation of eqType?--Anything smaller than ~ and homogeneous is an appropriate definition for-equality. The type safety of FC depends only on ~. Let's say η : τ ~ σ. Any-expression of type τ can be transmuted to one of type σ at any point by-casting. The same is true of expressions of type σ. So in some sense, τ and σ-are interchangeable.--But let's be more precise. If we examine the typing rules of FC (say, those in-https://cs.brynmawr.edu/~rae/papers/2015/equalities/equalities.pdf)-there are several places where the same metavariable is used in two different-premises to a rule. (For example, see Ty_App.) There is an implicit equality-check here. What definition of equality should we use? By convention, we use-α-equivalence. Take any rule with one (or more) of these implicit equality-checks. Then there is an admissible rule that uses ~ instead of the implicit-check, adding in casts as appropriate.--The only problem here is that ~ is heterogeneous. To make the kinds work out-in the admissible rule that uses ~, it is necessary to homogenize the-coercions. That is, if we have η : (τ : κ1) ~ (σ : κ2), then we don't use η;-we use η |> kind η, which is homogeneous.--The effect of this all is that eqType, the implementation of the implicit-equality check, can use any homogeneous relation that is smaller than ~, as-those rules must also be admissible.--A more drawn out argument around all of this is presented in Section 7.2 of-Richard E's thesis (http://cs.brynmawr.edu/~rae/papers/2016/thesis/eisenberg-thesis.pdf).--What would go wrong if we insisted on the casts matching? See the beginning of-Section 8 in the unpublished paper above. Theoretically, nothing at all goes-wrong. But in practical terms, getting the coercions right proved to be-nightmarish. And types would explode: during kind-checking, we often produce-reflexive kind coercions. When we try to cast by these, mkCastTy just discards-them. But if we used an eqType that distinguished between Int and Int |> <*>,-then we couldn't discard -- the output of kind-checking would be enormous,-and we would need enormous casts with lots of CoherenceCo's to straighten-them out.--Would anything go wrong if eqType respected type families? No, not at all. But-that makes eqType rather hard to implement.--Thus, the guideline for eqType is that it should be the largest-easy-to-implement relation that is still smaller than ~ and homogeneous. The-precise choice of relation is somewhat incidental, as long as the smart-constructors and destructors in Type respect whatever relation is chosen.--Another helpful principle with eqType is this:-- (EQ) If (t1 `eqType` t2) then I can replace t1 by t2 anywhere.--This principle also tells us that eqType must relate only types with the-same kinds.--Note [Respecting definitional equality]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Note [Non-trivial definitional equality] introduces the property (EQ).-How is this upheld?--Any function that pattern matches on all the constructors will have to-consider the possibility of CastTy. Presumably, those functions will handle-CastTy appropriately and we'll be OK.--More dangerous are the splitXXX functions. Let's focus on splitTyConApp.-We don't want it to fail on (T a b c |> co). Happily, if we have-  (T a b c |> co) `eqType` (T d e f)-then co must be reflexive. Why? eqType checks that the kinds are equal, as-well as checking that (a `eqType` d), (b `eqType` e), and (c `eqType` f).-By the kind check, we know that (T a b c |> co) and (T d e f) have the same-kind. So the only way that co could be non-reflexive is for (T a b c) to have-a different kind than (T d e f). But because T's kind is closed (all tycon kinds-are closed), the only way for this to happen is that one of the arguments has-to differ, leading to a contradiction. Thus, co is reflexive.--Accordingly, by eliminating reflexive casts, splitTyConApp need not worry-about outermost casts to uphold (EQ). Eliminating reflexive casts is done-in mkCastTy.--Unforunately, that's not the end of the story. Consider comparing-  (T a b c)      =?       (T a b |> (co -> <Type>)) (c |> co)-These two types have the same kind (Type), but the left type is a TyConApp-while the right type is not. To handle this case, we say that the right-hand-type is ill-formed, requiring an AppTy never to have a casted TyConApp-on its left. It is easy enough to pull around the coercions to maintain-this invariant, as done in Type.mkAppTy. In the example above, trying to-form the right-hand type will instead yield (T a b (c |> co |> sym co) |> <Type>).-Both the casts there are reflexive and will be dropped. Huzzah.--This idea of pulling coercions to the right works for splitAppTy as well.--However, there is one hiccup: it's possible that a coercion doesn't relate two-Pi-types. For example, if we have @type family Fun a b where Fun a b = a -> b@,-then we might have (T :: Fun Type Type) and (T |> axFun) Int. That axFun can't-be pulled to the right. But we don't need to pull it: (T |> axFun) Int is not-`eqType` to any proper TyConApp -- thus, leaving it where it is doesn't violate-our (EQ) property.--Lastly, in order to detect reflexive casts reliably, we must make sure not-to have nested casts: we update (t |> co1 |> co2) to (t |> (co1 `TransCo` co2)).--In sum, in order to uphold (EQ), we need the following three invariants:--  (EQ1) No decomposable CastTy to the left of an AppTy, where a decomposable-        cast is one that relates either a FunTy to a FunTy or a-        ForAllTy to a ForAllTy.-  (EQ2) No reflexive casts in CastTy.-  (EQ3) No nested CastTys.-  (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body).-        See Note [Weird typing rule for ForAllTy] in Type.--These invariants are all documented above, in the declaration for Type.--Note [Unused coercion variable in ForAllTy]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Suppose we have-  \(co:t1 ~ t2). e--What type should we give to this expression?-  (1) forall (co:t1 ~ t2) -> t-  (2) (t1 ~ t2) -> t--If co is used in t, (1) should be the right choice.-if co is not used in t, we would like to have (1) and (2) equivalent.--However, we want to keep eqType simple and don't want eqType (1) (2) to return-True in any case.--We decide to always construct (2) if co is not used in t.--Thus in mkLamType, we check whether the variable is a coercion-variable (of type (t1 ~# t2), and whether it is un-used in the-body. If so, it returns a FunTy instead of a ForAllTy.--There are cases we want to skip the check. For example, the check is-unnecessary when it is known from the context that the input variable-is a type variable.  In those cases, we use mkForAllTy.---}---- | A type labeled 'KnotTied' might have knot-tied tycons in it. See--- Note [Type checking recursive type and class declarations] in--- TcTyClsDecls-type KnotTied ty = ty--{- **********************************************************************-*                                                                       *-                  TyCoBinder and ArgFlag-*                                                                       *-********************************************************************** -}---- | A 'TyCoBinder' represents an argument to a function. TyCoBinders can be--- dependent ('Named') or nondependent ('Anon'). They may also be visible or--- not. See Note [TyCoBinders]-data TyCoBinder-  = Named TyCoVarBinder    -- A type-lambda binder-  | Anon AnonArgFlag Type  -- A term-lambda binder. Type here can be CoercionTy.-                           -- Visibility is determined by the AnonArgFlag-  deriving Data.Data---- | 'TyBinder' is like 'TyCoBinder', but there can only be 'TyVarBinder'--- in the 'Named' field.-type TyBinder = TyCoBinder---- | Remove the binder's variable from the set, if the binder has--- a variable.-delBinderVar :: VarSet -> TyCoVarBinder -> VarSet-delBinderVar vars (Bndr tv _) = vars `delVarSet` tv---- | Does this binder bind an invisible argument?-isInvisibleBinder :: TyCoBinder -> Bool-isInvisibleBinder (Named (Bndr _ vis)) = isInvisibleArgFlag vis-isInvisibleBinder (Anon InvisArg _)    = True-isInvisibleBinder (Anon VisArg   _)    = False---- | Does this binder bind a visible argument?-isVisibleBinder :: TyCoBinder -> Bool-isVisibleBinder = not . isInvisibleBinder--isNamedBinder :: TyCoBinder -> Bool-isNamedBinder (Named {}) = True-isNamedBinder (Anon {})  = False---- | If its a named binder, is the binder a tyvar?--- Returns True for nondependent binder.--- This check that we're really returning a *Ty*Binder (as opposed to a--- coercion binder). That way, if/when we allow coercion quantification--- in more places, we'll know we missed updating some function.-isTyBinder :: TyCoBinder -> Bool-isTyBinder (Named bnd) = isTyVarBinder bnd-isTyBinder _ = True--{- Note [TyCoBinders]-~~~~~~~~~~~~~~~~~~~-A ForAllTy contains a TyCoVarBinder.  But a type can be decomposed-to a telescope consisting of a [TyCoBinder]--A TyCoBinder represents the type of binders -- that is, the type of an-argument to a Pi-type. GHC Core currently supports two different-Pi-types:-- * A non-dependent function type,-   written with ->, e.g. ty1 -> ty2-   represented as FunTy ty1 ty2. These are-   lifted to Coercions with the corresponding FunCo.-- * A dependent compile-time-only polytype,-   written with forall, e.g.  forall (a:*). ty-   represented as ForAllTy (Bndr a v) ty--Both Pi-types classify terms/types that take an argument. In other-words, if `x` is either a function or a polytype, `x arg` makes sense-(for an appropriate `arg`).---Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-* A ForAllTy (used for both types and kinds) contains a TyCoVarBinder.-  Each TyCoVarBinder-      Bndr a tvis-  is equipped with tvis::ArgFlag, which says whether or not arguments-  for this binder should be visible (explicit) in source Haskell.--* A TyCon contains a list of TyConBinders.  Each TyConBinder-      Bndr a cvis-  is equipped with cvis::TyConBndrVis, which says whether or not type-  and kind arguments for this TyCon should be visible (explicit) in-  source Haskell.--This table summarises the visibility rules:-----------------------------------------------------------------------------------------|                                                      Occurrences look like this-|                             GHC displays type as     in Haskell source code-|---------------------------------------------------------------------------------------| Bndr a tvis :: TyCoVarBinder, in the binder of ForAllTy for a term-|  tvis :: ArgFlag-|  tvis = Inferred:            f :: forall {a}. type    Arg not allowed:  f-                               f :: forall {co}. type   Arg not allowed:  f-|  tvis = Specified:           f :: forall a. type      Arg optional:     f  or  f @Int-|  tvis = Required:            T :: forall k -> type    Arg required:     T *-|    This last form is illegal in terms: See Note [No Required TyCoBinder in terms]-|-| Bndr k cvis :: TyConBinder, in the TyConBinders of a TyCon-|  cvis :: TyConBndrVis-|  cvis = AnonTCB:             T :: kind -> kind        Required:            T *-|  cvis = NamedTCB Inferred:   T :: forall {k}. kind    Arg not allowed:     T-|                              T :: forall {co}. kind   Arg not allowed:     T-|  cvis = NamedTCB Specified:  T :: forall k. kind      Arg not allowed[1]:  T-|  cvis = NamedTCB Required:   T :: forall k -> kind    Required:            T *------------------------------------------------------------------------------------------[1] In types, in the Specified case, it would make sense to allow-    optional kind applications, thus (T @*), but we have not-    yet implemented that------ In term declarations ------* Inferred.  Function defn, with no signature:  f1 x = x-  We infer f1 :: forall {a}. a -> a, with 'a' Inferred-  It's Inferred because it doesn't appear in any-  user-written signature for f1--* Specified.  Function defn, with signature (implicit forall):-     f2 :: a -> a; f2 x = x-  So f2 gets the type f2 :: forall a. a -> a, with 'a' Specified-  even though 'a' is not bound in the source code by an explicit forall--* Specified.  Function defn, with signature (explicit forall):-     f3 :: forall a. a -> a; f3 x = x-  So f3 gets the type f3 :: forall a. a -> a, with 'a' Specified--* Inferred/Specified.  Function signature with inferred kind polymorphism.-     f4 :: a b -> Int-  So 'f4' gets the type f4 :: forall {k} (a:k->*) (b:k). a b -> Int-  Here 'k' is Inferred (it's not mentioned in the type),-  but 'a' and 'b' are Specified.--* Specified.  Function signature with explicit kind polymorphism-     f5 :: a (b :: k) -> Int-  This time 'k' is Specified, because it is mentioned explicitly,-  so we get f5 :: forall (k:*) (a:k->*) (b:k). a b -> Int--* Similarly pattern synonyms:-  Inferred - from inferred types (e.g. no pattern type signature)-           - or from inferred kind polymorphism------ In type declarations ------* Inferred (k)-     data T1 a b = MkT1 (a b)-  Here T1's kind is  T1 :: forall {k:*}. (k->*) -> k -> *-  The kind variable 'k' is Inferred, since it is not mentioned--  Note that 'a' and 'b' correspond to /Anon/ TyCoBinders in T1's kind,-  and Anon binders don't have a visibility flag. (Or you could think-  of Anon having an implicit Required flag.)--* Specified (k)-     data T2 (a::k->*) b = MkT (a b)-  Here T's kind is  T :: forall (k:*). (k->*) -> k -> *-  The kind variable 'k' is Specified, since it is mentioned in-  the signature.--* Required (k)-     data T k (a::k->*) b = MkT (a b)-  Here T's kind is  T :: forall k:* -> (k->*) -> k -> *-  The kind is Required, since it bound in a positional way in T's declaration-  Every use of T must be explicitly applied to a kind--* Inferred (k1), Specified (k)-     data T a b (c :: k) = MkT (a b) (Proxy c)-  Here T's kind is  T :: forall {k1:*} (k:*). (k1->*) -> k1 -> k -> *-  So 'k' is Specified, because it appears explicitly,-  but 'k1' is Inferred, because it does not--Generally, in the list of TyConBinders for a TyCon,--* Inferred arguments always come first-* Specified, Anon and Required can be mixed--e.g.-  data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where ...--Here Foo's TyConBinders are-   [Required 'a', Specified 'b', Anon]-and its kind prints as-   Foo :: forall a -> forall b. (a -> b -> Type) -> Type--See also Note [Required, Specified, and Inferred for types] in TcTyClsDecls------ Printing ------- We print forall types with enough syntax to tell you their visibility- flag.  But this is not source Haskell, and these types may not all- be parsable.-- Specified: a list of Specified binders is written between `forall` and `.`:-               const :: forall a b. a -> b -> a-- Inferred:  with -fprint-explicit-foralls, Inferred binders are written-            in braces:-               f :: forall {k} (a:k). S k a -> Int-            Otherwise, they are printed like Specified binders.-- Required: binders are put between `forall` and `->`:-              T :: forall k -> *------ Other points -------* In classic Haskell, all named binders (that is, the type variables in-  a polymorphic function type f :: forall a. a -> a) have been Inferred.--* Inferred variables correspond to "generalized" variables from the-  Visible Type Applications paper (ESOP'16).--Note [No Required TyCoBinder in terms]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We don't allow Required foralls for term variables, including pattern-synonyms and data constructors.  Why?  Because then an application-would need a /compulsory/ type argument (possibly without an "@"?),-thus (f Int); and we don't have concrete syntax for that.--We could change this decision, but Required, Named TyCoBinders are rare-anyway.  (Most are Anons.)--However the type of a term can (just about) have a required quantifier;-see Note [Required quantifiers in the type of a term] in TcExpr.--}---{- **********************************************************************-*                                                                       *-                        PredType-*                                                                       *-********************************************************************** -}----- | A type of the form @p@ of kind @Constraint@ represents a value whose type is--- the Haskell predicate @p@, where a predicate is what occurs before--- the @=>@ in a Haskell type.------ We use 'PredType' as documentation to mark those types that we guarantee to have--- this kind.------ It can be expanded into its representation, but:------ * The type checker must treat it as opaque------ * The rest of the compiler treats it as transparent------ Consider these examples:------ > f :: (Eq a) => a -> Int--- > g :: (?x :: Int -> Int) => a -> Int--- > h :: (r\l) => {r} => {l::Int | r}------ Here the @Eq a@ and @?x :: Int -> Int@ and @r\l@ are all called \"predicates\"-type PredType = Type---- | A collection of 'PredType's-type ThetaType = [PredType]--{--(We don't support TREX records yet, but the setup is designed-to expand to allow them.)--A Haskell qualified type, such as that for f,g,h above, is-represented using-        * a FunTy for the double arrow-        * with a type of kind Constraint as the function argument--The predicate really does turn into a real extra argument to the-function.  If the argument has type (p :: Constraint) then the predicate p is-represented by evidence of type p.---%************************************************************************-%*                                                                      *-            Simple constructors-%*                                                                      *-%************************************************************************--These functions are here so that they can be used by TysPrim,-which in turn is imported by Type--}--mkTyVarTy  :: TyVar   -> Type-mkTyVarTy v = ASSERT2( isTyVar v, ppr v <+> dcolon <+> ppr (tyVarKind v) )-              TyVarTy v--mkTyVarTys :: [TyVar] -> [Type]-mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy--mkTyCoVarTy :: TyCoVar -> Type-mkTyCoVarTy v-  | isTyVar v-  = TyVarTy v-  | otherwise-  = CoercionTy (CoVarCo v)--mkTyCoVarTys :: [TyCoVar] -> [Type]-mkTyCoVarTys = map mkTyCoVarTy--infixr 3 `mkFunTy`, `mkVisFunTy`, `mkInvisFunTy`      -- Associates to the right--mkFunTy :: AnonArgFlag -> Type -> Type -> Type-mkFunTy af arg res = FunTy { ft_af = af, ft_arg = arg, ft_res = res }--mkVisFunTy, mkInvisFunTy :: Type -> Type -> Type-mkVisFunTy   = mkFunTy VisArg-mkInvisFunTy = mkFunTy InvisArg---- | Make nested arrow types-mkVisFunTys, mkInvisFunTys :: [Type] -> Type -> Type-mkVisFunTys   tys ty = foldr mkVisFunTy   ty tys-mkInvisFunTys tys ty = foldr mkInvisFunTy ty tys---- | Like 'mkTyCoForAllTy', but does not check the occurrence of the binder--- See Note [Unused coercion variable in ForAllTy]-mkForAllTy :: TyCoVar -> ArgFlag -> Type -> Type-mkForAllTy tv vis ty = ForAllTy (Bndr tv vis) ty---- | Wraps foralls over the type using the provided 'TyCoVar's from left to right-mkForAllTys :: [TyCoVarBinder] -> Type -> Type-mkForAllTys tyvars ty = foldr ForAllTy ty tyvars--mkPiTy:: TyCoBinder -> Type -> Type-mkPiTy (Anon af ty1) ty2        = FunTy { ft_af = af, ft_arg = ty1, ft_res = ty2 }-mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty--mkPiTys :: [TyCoBinder] -> Type -> Type-mkPiTys tbs ty = foldr mkPiTy ty tbs---- | Create the plain type constructor type which has been applied to no type arguments at all.-mkTyConTy :: TyCon -> Type-mkTyConTy tycon = TyConApp tycon []--{--Some basic functions, put here to break loops eg with the pretty printer--}---- | Extract the RuntimeRep classifier of a type from its kind. For example,--- @kindRep * = LiftedRep@; Panics if this is not possible.--- Treats * and Constraint as the same-kindRep :: HasDebugCallStack => Kind -> Type-kindRep k = case kindRep_maybe k of-              Just r  -> r-              Nothing -> pprPanic "kindRep" (ppr k)---- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr.--- For example, @kindRep_maybe * = Just LiftedRep@--- Returns 'Nothing' if the kind is not of form (TYPE rr)--- Treats * and Constraint as the same-kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type-kindRep_maybe kind-  | Just kind' <- coreView kind = kindRep_maybe kind'-  | TyConApp tc [arg] <- kind-  , tc `hasKey` tYPETyConKey    = Just arg-  | otherwise                   = Nothing---- | This version considers Constraint to be the same as *. Returns True--- if the argument is equivalent to Type/Constraint and False otherwise.--- See Note [Kind Constraint and kind Type]-isLiftedTypeKind :: Kind -> Bool-isLiftedTypeKind kind-  = case kindRep_maybe kind of-      Just rep -> isLiftedRuntimeRep rep-      Nothing  -> False---- | Returns True if the kind classifies unlifted types and False otherwise.--- Note that this returns False for levity-polymorphic kinds, which may--- be specialized to a kind that classifies unlifted types.-isUnliftedTypeKind :: Kind -> Bool-isUnliftedTypeKind kind-  = case kindRep_maybe kind of-      Just rep -> isUnliftedRuntimeRep rep-      Nothing  -> False--isLiftedRuntimeRep :: Type -> Bool--- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep--- False of type variables (a :: RuntimeRep)---   and of other reps e.g. (IntRep :: RuntimeRep)-isLiftedRuntimeRep rep-  | Just rep' <- coreView rep          = isLiftedRuntimeRep rep'-  | TyConApp rr_tc args <- rep-  , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True-  | otherwise                          = False--isUnliftedRuntimeRep :: Type -> Bool--- True of definitely-unlifted RuntimeReps--- False of           (LiftedRep :: RuntimeRep)---   and of variables (a :: RuntimeRep)-isUnliftedRuntimeRep rep-  | Just rep' <- coreView rep = isUnliftedRuntimeRep rep'-  | TyConApp rr_tc _ <- rep   -- NB: args might be non-empty-                              --     e.g. TupleRep [r1, .., rn]-  = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)-        -- Avoid searching all the unlifted RuntimeRep type cons-        -- In the RuntimeRep data type, only LiftedRep is lifted-        -- But be careful of type families (F tys) :: RuntimeRep-  | otherwise {- Variables, applications -}-  = False---- | Is this the type 'RuntimeRep'?-isRuntimeRepTy :: Type -> Bool-isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty'-isRuntimeRepTy (TyConApp tc args)-  | tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True-isRuntimeRepTy _ = False---- | Is a tyvar of type 'RuntimeRep'?-isRuntimeRepVar :: TyVar -> Bool-isRuntimeRepVar = isRuntimeRepTy . tyVarKind--{--%************************************************************************-%*                                                                      *-            Coercions-%*                                                                      *-%************************************************************************--}---- | A 'Coercion' is concrete evidence of the equality/convertibility--- of two types.---- If you edit this type, you may need to update the GHC formalism--- See Note [GHC Formalism] in coreSyn/CoreLint.hs-data Coercion-  -- Each constructor has a "role signature", indicating the way roles are-  -- propagated through coercions.-  --    -  P, N, and R stand for coercions of the given role-  --    -  e stands for a coercion of a specific unknown role-  --           (think "role polymorphism")-  --    -  "e" stands for an explicit role parameter indicating role e.-  --    -   _ stands for a parameter that is not a Role or Coercion.--  -- These ones mirror the shape of types-  = -- Refl :: _ -> N-    Refl Type  -- See Note [Refl invariant]-          -- Invariant: applications of (Refl T) to a bunch of identity coercions-          --            always show up as Refl.-          -- For example  (Refl T) (Refl a) (Refl b) shows up as (Refl (T a b)).--          -- Applications of (Refl T) to some coercions, at least one of-          -- which is NOT the identity, show up as TyConAppCo.-          -- (They may not be fully saturated however.)-          -- ConAppCo coercions (like all coercions other than Refl)-          -- are NEVER the identity.--          -- Use (GRefl Representational ty MRefl), not (SubCo (Refl ty))--  -- GRefl :: "e" -> _ -> Maybe N -> e-  -- See Note [Generalized reflexive coercion]-  | GRefl Role Type MCoercionN  -- See Note [Refl invariant]-          -- Use (Refl ty), not (GRefl Nominal ty MRefl)-          -- Use (GRefl Representational _ _), not (SubCo (GRefl Nominal _ _))--  -- These ones simply lift the correspondingly-named-  -- Type constructors into Coercions--  -- TyConAppCo :: "e" -> _ -> ?? -> e-  -- See Note [TyConAppCo roles]-  | TyConAppCo Role TyCon [Coercion]    -- lift TyConApp-               -- The TyCon is never a synonym;-               -- we expand synonyms eagerly-               -- But it can be a type function--  | AppCo Coercion CoercionN             -- lift AppTy-          -- AppCo :: e -> N -> e--  -- See Note [Forall coercions]-  | ForAllCo TyCoVar KindCoercion Coercion-         -- ForAllCo :: _ -> N -> e -> e--  | FunCo Role Coercion Coercion         -- lift FunTy-         -- FunCo :: "e" -> e -> e -> e-         -- Note: why doesn't FunCo have a AnonArgFlag, like FunTy?-         -- Because the AnonArgFlag has no impact on Core; it is only-         -- there to guide implicit instantiation of Haskell source-         -- types, and that is irrelevant for coercions, which are-         -- Core-only.--  -- These are special-  | CoVarCo CoVar      -- :: _ -> (N or R)-                       -- result role depends on the tycon of the variable's type--    -- AxiomInstCo :: e -> _ -> [N] -> e-  | AxiomInstCo (CoAxiom Branched) BranchIndex [Coercion]-     -- See also [CoAxiom index]-     -- The coercion arguments always *precisely* saturate-     -- arity of (that branch of) the CoAxiom. If there are-     -- any left over, we use AppCo.-     -- See [Coercion axioms applied to coercions]--  | AxiomRuleCo CoAxiomRule [Coercion]-    -- AxiomRuleCo is very like AxiomInstCo, but for a CoAxiomRule-    -- The number coercions should match exactly the expectations-    -- of the CoAxiomRule (i.e., the rule is fully saturated).--  | UnivCo UnivCoProvenance Role Type Type-      -- :: _ -> "e" -> _ -> _ -> e--  | SymCo Coercion             -- :: e -> e-  | TransCo Coercion Coercion  -- :: e -> e -> e--  | NthCo  Role Int Coercion     -- Zero-indexed; decomposes (T t0 ... tn)-    -- :: "e" -> _ -> e0 -> e (inverse of TyConAppCo, see Note [TyConAppCo roles])-    -- Using NthCo on a ForAllCo gives an N coercion always-    -- See Note [NthCo and newtypes]-    ---    -- Invariant:  (NthCo r i co), it is always the case that r = role of (Nth i co)-    -- That is: the role of the entire coercion is redundantly cached here.-    -- See Note [NthCo Cached Roles]--  | LRCo   LeftOrRight CoercionN     -- Decomposes (t_left t_right)-    -- :: _ -> N -> N-  | InstCo Coercion CoercionN-    -- :: e -> N -> e-    -- See Note [InstCo roles]--  -- Extract a kind coercion from a (heterogeneous) type coercion-  -- NB: all kind coercions are Nominal-  | KindCo Coercion-     -- :: e -> N--  | SubCo CoercionN                  -- Turns a ~N into a ~R-    -- :: N -> R--  | HoleCo CoercionHole              -- ^ See Note [Coercion holes]-                                     -- Only present during typechecking-  deriving Data.Data--type CoercionN = Coercion       -- always nominal-type CoercionR = Coercion       -- always representational-type CoercionP = Coercion       -- always phantom-type KindCoercion = CoercionN   -- always nominal---- | A semantically more meaningful type to represent what may or may not be a--- useful 'Coercion'.-data MCoercion-  = MRefl-    -- A trivial Reflexivity coercion-  | MCo Coercion-    -- Other coercions-  deriving Data.Data-type MCoercionR = MCoercion-type MCoercionN = MCoercion--instance Outputable MCoercion where-  ppr MRefl    = text "MRefl"-  ppr (MCo co) = text "MCo" <+> ppr co--{--Note [Refl invariant]-~~~~~~~~~~~~~~~~~~~~~-Invariant 1:--Coercions have the following invariant-     Refl (similar for GRefl r ty MRefl) is always lifted as far as possible.--You might think that a consequencs is:-     Every identity coercions has Refl at the root--But that's not quite true because of coercion variables.  Consider-     g         where g :: Int~Int-     Left h    where h :: Maybe Int ~ Maybe Int-etc.  So the consequence is only true of coercions that-have no coercion variables.--Note [Generalized reflexive coercion]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--GRefl is a generalized reflexive coercion (see #15192). It wraps a kind-coercion, which might be reflexive (MRefl) or any coercion (MCo co). The typing-rules for GRefl:--  ty : k1-  -------------------------------------  GRefl r ty MRefl: ty ~r ty--  ty : k1       co :: k1 ~ k2-  -------------------------------------  GRefl r ty (MCo co) : ty ~r ty |> co--Consider we have--   g1 :: s ~r t-   s  :: k1-   g2 :: k1 ~ k2--and we want to construct a coercions co which has type--   (s |> g2) ~r t--We can define--   co = Sym (GRefl r s g2) ; g1--It is easy to see that--   Refl == GRefl Nominal ty MRefl :: ty ~n ty--A nominal reflexive coercion is quite common, so we keep the special form Refl to-save allocation.--Note [Coercion axioms applied to coercions]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The reason coercion axioms can be applied to coercions and not just-types is to allow for better optimization.  There are some cases where-we need to be able to "push transitivity inside" an axiom in order to-expose further opportunities for optimization.--For example, suppose we have--  C a : t[a] ~ F a-  g   : b ~ c--and we want to optimize--  sym (C b) ; t[g] ; C c--which has the kind--  F b ~ F c--(stopping through t[b] and t[c] along the way).--We'd like to optimize this to just F g -- but how?  The key is-that we need to allow axioms to be instantiated by *coercions*,-not just by types.  Then we can (in certain cases) push-transitivity inside the axiom instantiations, and then react-opposite-polarity instantiations of the same axiom.  In this-case, e.g., we match t[g] against the LHS of (C c)'s kind, to-obtain the substitution  a |-> g  (note this operation is sort-of the dual of lifting!) and hence end up with--  C g : t[b] ~ F c--which indeed has the same kind as  t[g] ; C c.--Now we have--  sym (C b) ; C g--which can be optimized to F g.--Note [CoAxiom index]-~~~~~~~~~~~~~~~~~~~~-A CoAxiom has 1 or more branches. Each branch has contains a list-of the free type variables in that branch, the LHS type patterns,-and the RHS type for that branch. When we apply an axiom to a list-of coercions, we must choose which branch of the axiom we wish to-use, as the different branches may have different numbers of free-type variables. (The number of type patterns is always the same-among branches, but that doesn't quite concern us here.)--The Int in the AxiomInstCo constructor is the 0-indexed number-of the chosen branch.--Note [Forall coercions]-~~~~~~~~~~~~~~~~~~~~~~~-Constructing coercions between forall-types can be a bit tricky,-because the kinds of the bound tyvars can be different.--The typing rule is:---  kind_co : k1 ~ k2-  tv1:k1 |- co : t1 ~ t2-  --------------------------------------------------------------------  ForAllCo tv1 kind_co co : all tv1:k1. t1  ~-                            all tv1:k2. (t2[tv1 |-> tv1 |> sym kind_co])--First, the TyCoVar stored in a ForAllCo is really an optimisation: this field-should be a Name, as its kind is redundant. Thinking of the field as a Name-is helpful in understanding what a ForAllCo means.-The kind of TyCoVar always matches the left-hand kind of the coercion.--The idea is that kind_co gives the two kinds of the tyvar. See how, in the-conclusion, tv1 is assigned kind k1 on the left but kind k2 on the right.--Of course, a type variable can't have different kinds at the same time. So,-we arbitrarily prefer the first kind when using tv1 in the inner coercion-co, which shows that t1 equals t2.--The last wrinkle is that we need to fix the kinds in the conclusion. In-t2, tv1 is assumed to have kind k1, but it has kind k2 in the conclusion of-the rule. So we do a kind-fixing substitution, replacing (tv1:k1) with-(tv1:k2) |> sym kind_co. This substitution is slightly bizarre, because it-mentions the same name with different kinds, but it *is* well-kinded, noting-that `(tv1:k2) |> sym kind_co` has kind k1.--This all really would work storing just a Name in the ForAllCo. But we can't-add Names to, e.g., VarSets, and there generally is just an impedance mismatch-in a bunch of places. So we use tv1. When we need tv2, we can use-setTyVarKind.--Note [Predicate coercions]-~~~~~~~~~~~~~~~~~~~~~~~~~~-Suppose we have-   g :: a~b-How can we coerce between types-   ([c]~a) => [a] -> c-and-   ([c]~b) => [b] -> c-where the equality predicate *itself* differs?--Answer: we simply treat (~) as an ordinary type constructor, so these-types really look like--   ((~) [c] a) -> [a] -> c-   ((~) [c] b) -> [b] -> c--So the coercion between the two is obviously--   ((~) [c] g) -> [g] -> c--Another way to see this to say that we simply collapse predicates to-their representation type (see Type.coreView and Type.predTypeRep).--This collapse is done by mkPredCo; there is no PredCo constructor-in Coercion.  This is important because we need Nth to work on-predicates too:-    Nth 1 ((~) [c] g) = g-See Simplify.simplCoercionF, which generates such selections.--Note [Roles]-~~~~~~~~~~~~-Roles are a solution to the GeneralizedNewtypeDeriving problem, articulated-in #1496. The full story is in docs/core-spec/core-spec.pdf. Also, see-https://gitlab.haskell.org/ghc/ghc/wikis/roles-implementation--Here is one way to phrase the problem:--Given:-newtype Age = MkAge Int-type family F x-type instance F Age = Bool-type instance F Int = Char--This compiles down to:-axAge :: Age ~ Int-axF1 :: F Age ~ Bool-axF2 :: F Int ~ Char--Then, we can make:-(sym (axF1) ; F axAge ; axF2) :: Bool ~ Char--Yikes!--The solution is _roles_, as articulated in "Generative Type Abstraction and-Type-level Computation" (POPL 2010), available at-http://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf--The specification for roles has evolved somewhat since that paper. For the-current full details, see the documentation in docs/core-spec. Here are some-highlights.--We label every equality with a notion of type equivalence, of which there are-three options: Nominal, Representational, and Phantom. A ground type is-nominally equivalent only with itself. A newtype (which is considered a ground-type in Haskell) is representationally equivalent to its representation.-Anything is "phantomly" equivalent to anything else. We use "N", "R", and "P"-to denote the equivalences.--The axioms above would be:-axAge :: Age ~R Int-axF1 :: F Age ~N Bool-axF2 :: F Age ~N Char--Then, because transitivity applies only to coercions proving the same notion-of equivalence, the above construction is impossible.--However, there is still an escape hatch: we know that any two types that are-nominally equivalent are representationally equivalent as well. This is what-the form SubCo proves -- it "demotes" a nominal equivalence into a-representational equivalence. So, it would seem the following is possible:--sub (sym axF1) ; F axAge ; sub axF2 :: Bool ~R Char   -- WRONG--What saves us here is that the arguments to a type function F, lifted into a-coercion, *must* prove nominal equivalence. So, (F axAge) is ill-formed, and-we are safe.--Roles are attached to parameters to TyCons. When lifting a TyCon into a-coercion (through TyConAppCo), we need to ensure that the arguments to the-TyCon respect their roles. For example:--data T a b = MkT a (F b)--If we know that a1 ~R a2, then we know (T a1 b) ~R (T a2 b). But, if we know-that b1 ~R b2, we know nothing about (T a b1) and (T a b2)! This is because-the type function F branches on b's *name*, not representation. So, we say-that 'a' has role Representational and 'b' has role Nominal. The third role,-Phantom, is for parameters not used in the type's definition. Given the-following definition--data Q a = MkQ Int--the Phantom role allows us to say that (Q Bool) ~R (Q Char), because we-can construct the coercion Bool ~P Char (using UnivCo).--See the paper cited above for more examples and information.--Note [TyConAppCo roles]-~~~~~~~~~~~~~~~~~~~~~~~-The TyConAppCo constructor has a role parameter, indicating the role at-which the coercion proves equality. The choice of this parameter affects-the required roles of the arguments of the TyConAppCo. To help explain-it, assume the following definition:--  type instance F Int = Bool   -- Axiom axF : F Int ~N Bool-  newtype Age = MkAge Int      -- Axiom axAge : Age ~R Int-  data Foo a = MkFoo a         -- Role on Foo's parameter is Representational--TyConAppCo Nominal Foo axF : Foo (F Int) ~N Foo Bool-  For (TyConAppCo Nominal) all arguments must have role Nominal. Why?-  So that Foo Age ~N Foo Int does *not* hold.--TyConAppCo Representational Foo (SubCo axF) : Foo (F Int) ~R Foo Bool-TyConAppCo Representational Foo axAge       : Foo Age     ~R Foo Int-  For (TyConAppCo Representational), all arguments must have the roles-  corresponding to the result of tyConRoles on the TyCon. This is the-  whole point of having roles on the TyCon to begin with. So, we can-  have Foo Age ~R Foo Int, if Foo's parameter has role R.--  If a Representational TyConAppCo is over-saturated (which is otherwise fine),-  the spill-over arguments must all be at Nominal. This corresponds to the-  behavior for AppCo.--TyConAppCo Phantom Foo (UnivCo Phantom Int Bool) : Foo Int ~P Foo Bool-  All arguments must have role Phantom. This one isn't strictly-  necessary for soundness, but this choice removes ambiguity.--The rules here dictate the roles of the parameters to mkTyConAppCo-(should be checked by Lint).--Note [NthCo and newtypes]-~~~~~~~~~~~~~~~~~~~~~~~~~-Suppose we have--  newtype N a = MkN Int-  type role N representational--This yields axiom--  NTCo:N :: forall a. N a ~R Int--We can then build--  co :: forall a b. N a ~R N b-  co = NTCo:N a ; sym (NTCo:N b)--for any `a` and `b`. Because of the role annotation on N, if we use-NthCo, we'll get out a representational coercion. That is:--  NthCo r 0 co :: forall a b. a ~R b--Yikes! Clearly, this is terrible. The solution is simple: forbid-NthCo to be used on newtypes if the internal coercion is representational.--This is not just some corner case discovered by a segfault somewhere;-it was discovered in the proof of soundness of roles and described-in the "Safe Coercions" paper (ICFP '14).--Note [NthCo Cached Roles]-~~~~~~~~~~~~~~~~~~~~~~~~~-Why do we cache the role of NthCo in the NthCo constructor?-Because computing role(Nth i co) involves figuring out that--  co :: T tys1 ~ T tys2--using coercionKind, and finding (coercionRole co), and then looking-at the tyConRoles of T. Avoiding bad asymptotic behaviour here means-we have to compute the kind and role of a coercion simultaneously,-which makes the code complicated and inefficient.--This only happens for NthCo. Caching the role solves the problem, and-allows coercionKind and coercionRole to be simple.--See #11735--Note [InstCo roles]-~~~~~~~~~~~~~~~~~~~-Here is (essentially) the typing rule for InstCo:--g :: (forall a. t1) ~r (forall a. t2)-w :: s1 ~N s2-------------------------------- InstCo-InstCo g w :: (t1 [a |-> s1]) ~r (t2 [a |-> s2])--Note that the Coercion w *must* be nominal. This is necessary-because the variable a might be used in a "nominal position"-(that is, a place where role inference would require a nominal-role) in t1 or t2. If we allowed w to be representational, we-could get bogus equalities.--A more nuanced treatment might be able to relax this condition-somewhat, by checking if t1 and/or t2 use their bound variables-in nominal ways. If not, having w be representational is OK.---%************************************************************************-%*                                                                      *-                UnivCoProvenance-%*                                                                      *-%************************************************************************--A UnivCo is a coercion whose proof does not directly express its role-and kind (indeed for some UnivCos, like UnsafeCoerceProv, there /is/-no proof).--The different kinds of UnivCo are described by UnivCoProvenance.  Really-each is entirely separate, but they all share the need to represent their-role and kind, which is done in the UnivCo constructor.---}---- | For simplicity, we have just one UnivCo that represents a coercion from--- some type to some other type, with (in general) no restrictions on the--- type. The UnivCoProvenance specifies more exactly what the coercion really--- is and why a program should (or shouldn't!) trust the coercion.--- It is reasonable to consider each constructor of 'UnivCoProvenance'--- as a totally independent coercion form; their only commonality is--- that they don't tell you what types they coercion between. (That info--- is in the 'UnivCo' constructor of 'Coercion'.-data UnivCoProvenance-  = UnsafeCoerceProv   -- ^ From @unsafeCoerce#@. These are unsound.--  | PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom-                             -- roled coercions--  | ProofIrrelProv KindCoercion  -- ^ From the fact that any two coercions are-                                 --   considered equivalent. See Note [ProofIrrelProv].-                                 -- Can be used in Nominal or Representational coercions--  | PluginProv String  -- ^ From a plugin, which asserts that this coercion-                       --   is sound. The string is for the use of the plugin.--  deriving Data.Data--instance Outputable UnivCoProvenance where-  ppr UnsafeCoerceProv   = text "(unsafeCoerce#)"-  ppr (PhantomProv _)    = text "(phantom)"-  ppr (ProofIrrelProv _) = text "(proof irrel.)"-  ppr (PluginProv str)   = parens (text "plugin" <+> brackets (text str))---- | A coercion to be filled in by the type-checker. See Note [Coercion holes]-data CoercionHole-  = CoercionHole { ch_co_var :: CoVar-                       -- See Note [CoercionHoles and coercion free variables]--                 , ch_ref    :: IORef (Maybe Coercion)-                 }--coHoleCoVar :: CoercionHole -> CoVar-coHoleCoVar = ch_co_var--setCoHoleCoVar :: CoercionHole -> CoVar -> CoercionHole-setCoHoleCoVar h cv = h { ch_co_var = cv }--instance Data.Data CoercionHole where-  -- don't traverse?-  toConstr _   = abstractConstr "CoercionHole"-  gunfold _ _  = error "gunfold"-  dataTypeOf _ = mkNoRepType "CoercionHole"--instance Outputable CoercionHole where-  ppr (CoercionHole { ch_co_var = cv }) = braces (ppr cv)---{- Note [Phantom coercions]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider-     data T a = T1 | T2-Then we have-     T s ~R T t-for any old s,t. The witness for this is (TyConAppCo T Rep co),-where (co :: s ~P t) is a phantom coercion built with PhantomProv.-The role of the UnivCo is always Phantom.  The Coercion stored is the-(nominal) kind coercion between the types-   kind(s) ~N kind (t)--Note [Coercion holes]-~~~~~~~~~~~~~~~~~~~~~~~~-During typechecking, constraint solving for type classes works by-  - Generate an evidence Id,  d7 :: Num a-  - Wrap it in a Wanted constraint, [W] d7 :: Num a-  - Use the evidence Id where the evidence is needed-  - Solve the constraint later-  - When solved, add an enclosing let-binding  let d7 = .... in ....-    which actually binds d7 to the (Num a) evidence--For equality constraints we use a different strategy.  See Note [The-equality types story] in TysPrim for background on equality constraints.-  - For /boxed/ equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just-    like type classes above. (Indeed, boxed equality constraints *are* classes.)-  - But for /unboxed/ equality constraints (t1 ~R# t2) and (t1 ~N# t2)-    we use a different plan--For unboxed equalities:-  - Generate a CoercionHole, a mutable variable just like a unification-    variable-  - Wrap the CoercionHole in a Wanted constraint; see TcRnTypes.TcEvDest-  - Use the CoercionHole in a Coercion, via HoleCo-  - Solve the constraint later-  - When solved, fill in the CoercionHole by side effect, instead of-    doing the let-binding thing--The main reason for all this is that there may be no good place to let-bind-the evidence for unboxed equalities:--  - We emit constraints for kind coercions, to be used to cast a-    type's kind. These coercions then must be used in types. Because-    they might appear in a top-level type, there is no place to bind-    these (unlifted) coercions in the usual way.--  - A coercion for (forall a. t1) ~ (forall a. t2) will look like-       forall a. (coercion for t1~t2)-    But the coercion for (t1~t2) may mention 'a', and we don't have-    let-bindings within coercions.  We could add them, but coercion-    holes are easier.--  - Moreover, nothing is lost from the lack of let-bindings. For-    dicionaries want to achieve sharing to avoid recomoputing the-    dictionary.  But coercions are entirely erased, so there's little-    benefit to sharing. Indeed, even if we had a let-binding, we-    always inline types and coercions at every use site and drop the-    binding.--Other notes about HoleCo:-- * INVARIANT: CoercionHole and HoleCo are used only during type checking,-   and should never appear in Core. Just like unification variables; a Type-   can contain a TcTyVar, but only during type checking. If, one day, we-   use type-level information to separate out forms that can appear during-   type-checking vs forms that can appear in core proper, holes in Core will-   be ruled out.-- * See Note [CoercionHoles and coercion free variables]-- * Coercion holes can be compared for equality like other coercions:-   by looking at the types coerced.---Note [CoercionHoles and coercion free variables]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Why does a CoercionHole contain a CoVar, as well as reference to-fill in?  Because we want to treat that CoVar as a free variable of-the coercion.  See #14584, and Note [What prevents a-constraint from floating] in TcSimplify, item (4):--        forall k. [W] co1 :: t1 ~# t2 |> co2-                  [W] co2 :: k ~# *--Here co2 is a CoercionHole. But we /must/ know that it is free in-co1, because that's all that stops it floating outside the-implication.---Note [ProofIrrelProv]-~~~~~~~~~~~~~~~~~~~~~-A ProofIrrelProv is a coercion between coercions. For example:--  data G a where-    MkG :: G Bool--In core, we get--  G :: * -> *-  MkG :: forall (a :: *). (a ~ Bool) -> G a--Now, consider 'MkG -- that is, MkG used in a type -- and suppose we want-a proof that ('MkG a1 co1) ~ ('MkG a2 co2). This will have to be--  TyConAppCo Nominal MkG [co3, co4]-  where-    co3 :: co1 ~ co2-    co4 :: a1 ~ a2--Note that-  co1 :: a1 ~ Bool-  co2 :: a2 ~ Bool--Here,-  co3 = UnivCo (ProofIrrelProv co5) Nominal (CoercionTy co1) (CoercionTy co2)-  where-    co5 :: (a1 ~ Bool) ~ (a2 ~ Bool)-    co5 = TyConAppCo Nominal (~#) [<*>, <*>, co4, <Bool>]---%************************************************************************-%*                                                                      *-                 Free variables of types and coercions-%*                                                                      *-%************************************************************************--}--{- Note [Free variables of types]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The family of functions tyCoVarsOfType, tyCoVarsOfTypes etc, returns-a VarSet that is closed over the types of its variables.  More precisely,-  if    S = tyCoVarsOfType( t )-  and   (a:k) is in S-  then  tyCoVarsOftype( k ) is a subset of S--Example: The tyCoVars of this ((a:* -> k) Int) is {a, k}.--We could /not/ close over the kinds of the variable occurrences, and-instead do so at call sites, but it seems that we always want to do-so, so it's easiest to do it here.--It turns out that getting the free variables of types is performance critical,-so we profiled several versions, exploring different implementation strategies.--1. Baseline version: uses FV naively. Essentially:--   tyCoVarsOfType ty = fvVarSet $ tyCoFVsOfType ty--   This is not nice, because FV introduces some overhead to implement-   determinism, and throught its "interesting var" function, neither of which-   we need here, so they are a complete waste.--2. UnionVarSet version: instead of reusing the FV-based code, we simply used-   VarSets directly, trying to avoid the overhead of FV. E.g.:--   -- FV version:-   tyCoFVsOfType (AppTy fun arg)    a b c = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) a b c--   -- UnionVarSet version:-   tyCoVarsOfType (AppTy fun arg)    = (tyCoVarsOfType fun `unionVarSet` tyCoVarsOfType arg)--   This looks deceptively similar, but while FV internally builds a list- and-   set-generating function, the VarSet functions manipulate sets directly, and-   the latter peforms a lot worse than the naive FV version.--3. Accumulator-style VarSet version: this is what we use now. We do use VarSet-   as our data structure, but delegate the actual work to a new-   ty_co_vars_of_...  family of functions, which use accumulator style and the-   "in-scope set" filter found in the internals of FV, but without the-   determinism overhead.--See #14880.--Note [Closing over free variable kinds]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-tyCoVarsOfType and tyCoFVsOfType, while traversing a type, will also close over-free variable kinds. In previous GHC versions, this happened naively: whenever-we would encounter an occurrence of a free type variable, we would close over-its kind. This, however is wrong for two reasons (see #14880):--1. Efficiency. If we have Proxy (a::k) -> Proxy (a::k) -> Proxy (a::k), then-   we don't want to have to traverse k more than once.--2. Correctness. Imagine we have forall k. b -> k, where b has-   kind k, for some k bound in an outer scope. If we look at b's kind inside-   the forall, we'll collect that k is free and then remove k from the set of-   free variables. This is plain wrong. We must instead compute that b is free-   and then conclude that b's kind is free.--An obvious first approach is to move the closing-over-kinds from the-occurrences of a type variable to after finding the free vars - however, this-turns out to introduce performance regressions, and isn't even entirely-correct.--In fact, it isn't even important *when* we close over kinds; what matters is-that we handle each type var exactly once, and that we do it in the right-context.--So the next approach we tried was to use the "in-scope set" part of FV or the-equivalent argument in the accumulator-style `ty_co_vars_of_type` function, to-say "don't bother with variables we have already closed over". This should work-fine in theory, but the code is complicated and doesn't perform well.--But there is a simpler way, which is implemented here. Consider the two points-above:--1. Efficiency: we now have an accumulator, so the second time we encounter 'a',-   we'll ignore it, certainly not looking at its kind - this is why-   pre-checking set membership before inserting ends up not only being faster,-   but also being correct.--2. Correctness: we have an "in-scope set" (I think we should call it it a-  "bound-var set"), specifying variables that are bound by a forall in the type-  we are traversing; we simply ignore these variables, certainly not looking at-  their kind.--So now consider:--    forall k. b -> k--where b :: k->Type is free; but of course, it's a different k! When looking at-b -> k we'll have k in the bound-var set. So we'll ignore the k. But suppose-this is our first encounter with b; we want the free vars of its kind. But we-want to behave as if we took the free vars of its kind at the end; that is,-with no bound vars in scope.--So the solution is easy. The old code was this:--  ty_co_vars_of_type (TyVarTy v) is acc-    | v `elemVarSet` is  = acc-    | v `elemVarSet` acc = acc-    | otherwise          = ty_co_vars_of_type (tyVarKind v) is (extendVarSet acc v)--Now all we need to do is take the free vars of tyVarKind v *with an empty-bound-var set*, thus:--ty_co_vars_of_type (TyVarTy v) is acc-  | v `elemVarSet` is  = acc-  | v `elemVarSet` acc = acc-  | otherwise          = ty_co_vars_of_type (tyVarKind v) emptyVarSet (extendVarSet acc v)-                                                          ^^^^^^^^^^^--And that's it.---}--tyCoVarsOfType :: Type -> TyCoVarSet--- See Note [Free variables of types]-tyCoVarsOfType ty = ty_co_vars_of_type ty emptyVarSet emptyVarSet--tyCoVarsOfTypes :: [Type] -> TyCoVarSet-tyCoVarsOfTypes tys = ty_co_vars_of_types tys emptyVarSet emptyVarSet--ty_co_vars_of_type :: Type -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet-ty_co_vars_of_type (TyVarTy v) is acc-  | v `elemVarSet` is  = acc-  | v `elemVarSet` acc = acc-  | otherwise          = ty_co_vars_of_type (tyVarKind v)-                            emptyVarSet  -- See Note [Closing over free variable kinds]-                            (extendVarSet acc v)--ty_co_vars_of_type (TyConApp _ tys)   is acc = ty_co_vars_of_types tys is acc-ty_co_vars_of_type (LitTy {})         _  acc = acc-ty_co_vars_of_type (AppTy fun arg)    is acc = ty_co_vars_of_type fun is (ty_co_vars_of_type arg is acc)-ty_co_vars_of_type (FunTy _ arg res)  is acc = ty_co_vars_of_type arg is (ty_co_vars_of_type res is acc)-ty_co_vars_of_type (ForAllTy (Bndr tv _) ty) is acc = ty_co_vars_of_type (varType tv) is $-                                                      ty_co_vars_of_type ty (extendVarSet is tv) acc-ty_co_vars_of_type (CastTy ty co)     is acc = ty_co_vars_of_type ty is (ty_co_vars_of_co co is acc)-ty_co_vars_of_type (CoercionTy co)    is acc = ty_co_vars_of_co co is acc--ty_co_vars_of_types :: [Type] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet-ty_co_vars_of_types []       _  acc = acc-ty_co_vars_of_types (ty:tys) is acc = ty_co_vars_of_type ty is (ty_co_vars_of_types tys is acc)--tyCoVarsOfCo :: Coercion -> TyCoVarSet--- See Note [Free variables of types]-tyCoVarsOfCo co = ty_co_vars_of_co co emptyVarSet emptyVarSet--tyCoVarsOfCos :: [Coercion] -> TyCoVarSet-tyCoVarsOfCos cos = ty_co_vars_of_cos cos emptyVarSet emptyVarSet---ty_co_vars_of_co :: Coercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet-ty_co_vars_of_co (Refl ty)            is acc = ty_co_vars_of_type ty is acc-ty_co_vars_of_co (GRefl _ ty mco)     is acc = ty_co_vars_of_type ty is $-                                               ty_co_vars_of_mco mco is acc-ty_co_vars_of_co (TyConAppCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc-ty_co_vars_of_co (AppCo co arg)       is acc = ty_co_vars_of_co co is $-                                               ty_co_vars_of_co arg is acc-ty_co_vars_of_co (ForAllCo tv kind_co co) is acc = ty_co_vars_of_co kind_co is $-                                                   ty_co_vars_of_co co (extendVarSet is tv) acc-ty_co_vars_of_co (FunCo _ co1 co2)    is acc = ty_co_vars_of_co co1 is $-                                               ty_co_vars_of_co co2 is acc-ty_co_vars_of_co (CoVarCo v)          is acc = ty_co_vars_of_co_var v is acc-ty_co_vars_of_co (HoleCo h)           is acc = ty_co_vars_of_co_var (coHoleCoVar h) is acc-    -- See Note [CoercionHoles and coercion free variables]-ty_co_vars_of_co (AxiomInstCo _ _ cos) is acc = ty_co_vars_of_cos cos is acc-ty_co_vars_of_co (UnivCo p _ t1 t2)    is acc = ty_co_vars_of_prov p is $-                                                ty_co_vars_of_type t1 is $-                                                ty_co_vars_of_type t2 is acc-ty_co_vars_of_co (SymCo co)          is acc = ty_co_vars_of_co co is acc-ty_co_vars_of_co (TransCo co1 co2)   is acc = ty_co_vars_of_co co1 is $-                                              ty_co_vars_of_co co2 is acc-ty_co_vars_of_co (NthCo _ _ co)      is acc = ty_co_vars_of_co co is acc-ty_co_vars_of_co (LRCo _ co)         is acc = ty_co_vars_of_co co is acc-ty_co_vars_of_co (InstCo co arg)     is acc = ty_co_vars_of_co co is $-                                              ty_co_vars_of_co arg is acc-ty_co_vars_of_co (KindCo co)         is acc = ty_co_vars_of_co co is acc-ty_co_vars_of_co (SubCo co)          is acc = ty_co_vars_of_co co is acc-ty_co_vars_of_co (AxiomRuleCo _ cs)  is acc = ty_co_vars_of_cos cs is acc--ty_co_vars_of_mco :: MCoercion -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet-ty_co_vars_of_mco MRefl    _is acc = acc-ty_co_vars_of_mco (MCo co) is  acc = ty_co_vars_of_co co is acc--ty_co_vars_of_co_var :: CoVar -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet-ty_co_vars_of_co_var v is acc-  | v `elemVarSet` is  = acc-  | v `elemVarSet` acc = acc-  | otherwise          = ty_co_vars_of_type (varType v)-                            emptyVarSet  -- See Note [Closing over free variable kinds]-                            (extendVarSet acc v)--ty_co_vars_of_cos :: [Coercion] -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet-ty_co_vars_of_cos []       _  acc = acc-ty_co_vars_of_cos (co:cos) is acc = ty_co_vars_of_co co is (ty_co_vars_of_cos cos is acc)--tyCoVarsOfProv :: UnivCoProvenance -> TyCoVarSet-tyCoVarsOfProv prov = ty_co_vars_of_prov prov emptyVarSet emptyVarSet--ty_co_vars_of_prov :: UnivCoProvenance -> TyCoVarSet -> TyCoVarSet -> TyCoVarSet-ty_co_vars_of_prov (PhantomProv co)    is acc = ty_co_vars_of_co co is acc-ty_co_vars_of_prov (ProofIrrelProv co) is acc = ty_co_vars_of_co co is acc-ty_co_vars_of_prov UnsafeCoerceProv    _  acc = acc-ty_co_vars_of_prov (PluginProv _)      _  acc = acc---- | Generates an in-scope set from the free variables in a list of types--- and a list of coercions-mkTyCoInScopeSet :: [Type] -> [Coercion] -> InScopeSet-mkTyCoInScopeSet tys cos-  = mkInScopeSet (ty_co_vars_of_types tys emptyVarSet $-                  ty_co_vars_of_cos   cos emptyVarSet emptyVarSet)---- | `tyCoFVsOfType` that returns free variables of a type in a deterministic--- set. For explanation of why using `VarSet` is not deterministic see--- Note [Deterministic FV] in FV.-tyCoVarsOfTypeDSet :: Type -> DTyCoVarSet--- See Note [Free variables of types]-tyCoVarsOfTypeDSet ty = fvDVarSet $ tyCoFVsOfType ty---- | `tyCoFVsOfType` that returns free variables of a type in deterministic--- order. For explanation of why using `VarSet` is not deterministic see--- Note [Deterministic FV] in FV.-tyCoVarsOfTypeList :: Type -> [TyCoVar]--- See Note [Free variables of types]-tyCoVarsOfTypeList ty = fvVarList $ tyCoFVsOfType ty---- | Returns free variables of types, including kind variables as--- a non-deterministic set. For type synonyms it does /not/ expand the--- synonym.-tyCoVarsOfTypesSet :: TyVarEnv Type -> TyCoVarSet--- See Note [Free variables of types]-tyCoVarsOfTypesSet tys = tyCoVarsOfTypes $ nonDetEltsUFM tys-  -- It's OK to use nonDetEltsUFM here because we immediately forget the-  -- ordering by returning a set---- | Returns free variables of types, including kind variables as--- a deterministic set. For type synonyms it does /not/ expand the--- synonym.-tyCoVarsOfTypesDSet :: [Type] -> DTyCoVarSet--- See Note [Free variables of types]-tyCoVarsOfTypesDSet tys = fvDVarSet $ tyCoFVsOfTypes tys---- | Returns free variables of types, including kind variables as--- a deterministically ordered list. For type synonyms it does /not/ expand the--- synonym.-tyCoVarsOfTypesList :: [Type] -> [TyCoVar]--- See Note [Free variables of types]-tyCoVarsOfTypesList tys = fvVarList $ tyCoFVsOfTypes tys---- | The worker for `tyCoFVsOfType` and `tyCoFVsOfTypeList`.--- The previous implementation used `unionVarSet` which is O(n+m) and can--- make the function quadratic.--- It's exported, so that it can be composed with--- other functions that compute free variables.--- See Note [FV naming conventions] in FV.------ Eta-expanded because that makes it run faster (apparently)--- See Note [FV eta expansion] in FV for explanation.-tyCoFVsOfType :: Type -> FV--- See Note [Free variables of types]-tyCoFVsOfType (TyVarTy v)        f bound_vars (acc_list, acc_set)-  | not (f v) = (acc_list, acc_set)-  | v `elemVarSet` bound_vars = (acc_list, acc_set)-  | v `elemVarSet` acc_set = (acc_list, acc_set)-  | otherwise = tyCoFVsOfType (tyVarKind v) f-                               emptyVarSet   -- See Note [Closing over free variable kinds]-                               (v:acc_list, extendVarSet acc_set v)-tyCoFVsOfType (TyConApp _ tys)   f bound_vars acc = tyCoFVsOfTypes tys f bound_vars acc-tyCoFVsOfType (LitTy {})         f bound_vars acc = emptyFV f bound_vars acc-tyCoFVsOfType (AppTy fun arg)    f bound_vars acc = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) f bound_vars acc-tyCoFVsOfType (FunTy _ arg res)  f bound_vars acc = (tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) f bound_vars acc-tyCoFVsOfType (ForAllTy bndr ty) f bound_vars acc = tyCoFVsBndr bndr (tyCoFVsOfType ty)  f bound_vars acc-tyCoFVsOfType (CastTy ty co)     f bound_vars acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfCo co) f bound_vars acc-tyCoFVsOfType (CoercionTy co)    f bound_vars acc = tyCoFVsOfCo co f bound_vars acc--tyCoFVsBndr :: TyCoVarBinder -> FV -> FV--- Free vars of (forall b. <thing with fvs>)-tyCoFVsBndr (Bndr tv _) fvs = tyCoFVsVarBndr tv fvs--tyCoFVsVarBndrs :: [Var] -> FV -> FV-tyCoFVsVarBndrs vars fvs = foldr tyCoFVsVarBndr fvs vars--tyCoFVsVarBndr :: Var -> FV -> FV-tyCoFVsVarBndr var fvs-  = tyCoFVsOfType (varType var)   -- Free vars of its type/kind-    `unionFV` delFV var fvs       -- Delete it from the thing-inside--tyCoFVsOfTypes :: [Type] -> FV--- See Note [Free variables of types]-tyCoFVsOfTypes (ty:tys) fv_cand in_scope acc = (tyCoFVsOfType ty `unionFV` tyCoFVsOfTypes tys) fv_cand in_scope acc-tyCoFVsOfTypes []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc---- | Get a deterministic set of the vars free in a coercion-tyCoVarsOfCoDSet :: Coercion -> DTyCoVarSet--- See Note [Free variables of types]-tyCoVarsOfCoDSet co = fvDVarSet $ tyCoFVsOfCo co--tyCoVarsOfCoList :: Coercion -> [TyCoVar]--- See Note [Free variables of types]-tyCoVarsOfCoList co = fvVarList $ tyCoFVsOfCo co--tyCoFVsOfMCo :: MCoercion -> FV-tyCoFVsOfMCo MRefl    = emptyFV-tyCoFVsOfMCo (MCo co) = tyCoFVsOfCo co--tyCoVarsOfCosSet :: CoVarEnv Coercion -> TyCoVarSet-tyCoVarsOfCosSet cos = tyCoVarsOfCos $ nonDetEltsUFM cos-  -- It's OK to use nonDetEltsUFM here because we immediately forget the-  -- ordering by returning a set--tyCoFVsOfCo :: Coercion -> FV--- Extracts type and coercion variables from a coercion--- See Note [Free variables of types]-tyCoFVsOfCo (Refl ty) fv_cand in_scope acc-  = tyCoFVsOfType ty fv_cand in_scope acc-tyCoFVsOfCo (GRefl _ ty mco) fv_cand in_scope acc-  = (tyCoFVsOfType ty `unionFV` tyCoFVsOfMCo mco) fv_cand in_scope acc-tyCoFVsOfCo (TyConAppCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc-tyCoFVsOfCo (AppCo co arg) fv_cand in_scope acc-  = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc-tyCoFVsOfCo (ForAllCo tv kind_co co) fv_cand in_scope acc-  = (tyCoFVsVarBndr tv (tyCoFVsOfCo co) `unionFV` tyCoFVsOfCo kind_co) fv_cand in_scope acc-tyCoFVsOfCo (FunCo _ co1 co2)    fv_cand in_scope acc-  = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc-tyCoFVsOfCo (CoVarCo v) fv_cand in_scope acc-  = tyCoFVsOfCoVar v fv_cand in_scope acc-tyCoFVsOfCo (HoleCo h) fv_cand in_scope acc-  = tyCoFVsOfCoVar (coHoleCoVar h) fv_cand in_scope acc-    -- See Note [CoercionHoles and coercion free variables]-tyCoFVsOfCo (AxiomInstCo _ _ cos) fv_cand in_scope acc = tyCoFVsOfCos cos fv_cand in_scope acc-tyCoFVsOfCo (UnivCo p _ t1 t2) fv_cand in_scope acc-  = (tyCoFVsOfProv p `unionFV` tyCoFVsOfType t1-                     `unionFV` tyCoFVsOfType t2) fv_cand in_scope acc-tyCoFVsOfCo (SymCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfCo (TransCo co1 co2)   fv_cand in_scope acc = (tyCoFVsOfCo co1 `unionFV` tyCoFVsOfCo co2) fv_cand in_scope acc-tyCoFVsOfCo (NthCo _ _ co)      fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfCo (LRCo _ co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfCo (InstCo co arg)     fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCo arg) fv_cand in_scope acc-tyCoFVsOfCo (KindCo co)         fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfCo (SubCo co)          fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfCo (AxiomRuleCo _ cs)  fv_cand in_scope acc = tyCoFVsOfCos cs fv_cand in_scope acc--tyCoFVsOfCoVar :: CoVar -> FV-tyCoFVsOfCoVar v fv_cand in_scope acc-  = (unitFV v `unionFV` tyCoFVsOfType (varType v)) fv_cand in_scope acc--tyCoFVsOfProv :: UnivCoProvenance -> FV-tyCoFVsOfProv UnsafeCoerceProv    fv_cand in_scope acc = emptyFV fv_cand in_scope acc-tyCoFVsOfProv (PhantomProv co)    fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfProv (ProofIrrelProv co) fv_cand in_scope acc = tyCoFVsOfCo co fv_cand in_scope acc-tyCoFVsOfProv (PluginProv _)      fv_cand in_scope acc = emptyFV fv_cand in_scope acc--tyCoFVsOfCos :: [Coercion] -> FV-tyCoFVsOfCos []       fv_cand in_scope acc = emptyFV fv_cand in_scope acc-tyCoFVsOfCos (co:cos) fv_cand in_scope acc = (tyCoFVsOfCo co `unionFV` tyCoFVsOfCos cos) fv_cand in_scope acc---------------- Extracting the CoVars of a type or coercion -------------{---Note [CoVarsOfX and the InterestingVarFun]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--The coVarsOfType, coVarsOfTypes, coVarsOfCo, and coVarsOfCos functions are-implemented in terms of the respective FV equivalents (tyCoFVsOf...), rather-than the VarSet-based flavors (tyCoVarsOf...), despite the performance-considerations outlined in Note [Free variables of types].--This is because FV includes the InterestingVarFun, which is useful here,-because we can cleverly use it to restrict our calculations to CoVars - this-is what getCoVarSet achieves.--See #14880.---}--getCoVarSet :: FV -> CoVarSet-getCoVarSet fv = snd (fv isCoVar emptyVarSet ([], emptyVarSet))--coVarsOfType :: Type -> CoVarSet-coVarsOfType ty = getCoVarSet (tyCoFVsOfType ty)--coVarsOfTypes :: [Type] -> TyCoVarSet-coVarsOfTypes tys = getCoVarSet (tyCoFVsOfTypes tys)--coVarsOfCo :: Coercion -> CoVarSet-coVarsOfCo co = getCoVarSet (tyCoFVsOfCo co)--coVarsOfCos :: [Coercion] -> CoVarSet-coVarsOfCos cos = getCoVarSet (tyCoFVsOfCos cos)------- Whether a covar is /Almost Devoid/ in a type or coercion -------- | Given a covar and a coercion, returns True if covar is almost devoid in--- the coercion. That is, covar can only appear in Refl and GRefl.--- See last wrinkle in Note [Unused coercion variable in ForAllCo] in Coercion-almostDevoidCoVarOfCo :: CoVar -> Coercion -> Bool-almostDevoidCoVarOfCo cv co =-  almost_devoid_co_var_of_co co cv--almost_devoid_co_var_of_co :: Coercion -> CoVar -> Bool-almost_devoid_co_var_of_co (Refl {}) _ = True   -- covar is allowed in Refl and-almost_devoid_co_var_of_co (GRefl {}) _ = True  -- GRefl, so we don't look into-                                                -- the coercions-almost_devoid_co_var_of_co (TyConAppCo _ _ cos) cv-  = almost_devoid_co_var_of_cos cos cv-almost_devoid_co_var_of_co (AppCo co arg) cv-  = almost_devoid_co_var_of_co co cv-  && almost_devoid_co_var_of_co arg cv-almost_devoid_co_var_of_co (ForAllCo v kind_co co) cv-  = almost_devoid_co_var_of_co kind_co cv-  && (v == cv || almost_devoid_co_var_of_co co cv)-almost_devoid_co_var_of_co (FunCo _ co1 co2) cv-  = almost_devoid_co_var_of_co co1 cv-  && almost_devoid_co_var_of_co co2 cv-almost_devoid_co_var_of_co (CoVarCo v) cv = v /= cv-almost_devoid_co_var_of_co (HoleCo h)  cv = (coHoleCoVar h) /= cv-almost_devoid_co_var_of_co (AxiomInstCo _ _ cos) cv-  = almost_devoid_co_var_of_cos cos cv-almost_devoid_co_var_of_co (UnivCo p _ t1 t2) cv-  = almost_devoid_co_var_of_prov p cv-  && almost_devoid_co_var_of_type t1 cv-  && almost_devoid_co_var_of_type t2 cv-almost_devoid_co_var_of_co (SymCo co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_co (TransCo co1 co2) cv-  = almost_devoid_co_var_of_co co1 cv-  && almost_devoid_co_var_of_co co2 cv-almost_devoid_co_var_of_co (NthCo _ _ co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_co (LRCo _ co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_co (InstCo co arg) cv-  = almost_devoid_co_var_of_co co cv-  && almost_devoid_co_var_of_co arg cv-almost_devoid_co_var_of_co (KindCo co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_co (SubCo co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_co (AxiomRuleCo _ cs) cv-  = almost_devoid_co_var_of_cos cs cv--almost_devoid_co_var_of_cos :: [Coercion] -> CoVar -> Bool-almost_devoid_co_var_of_cos [] _ = True-almost_devoid_co_var_of_cos (co:cos) cv-  = almost_devoid_co_var_of_co co cv-  && almost_devoid_co_var_of_cos cos cv--almost_devoid_co_var_of_prov :: UnivCoProvenance -> CoVar -> Bool-almost_devoid_co_var_of_prov (PhantomProv co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_prov (ProofIrrelProv co) cv-  = almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_prov UnsafeCoerceProv _ = True-almost_devoid_co_var_of_prov (PluginProv _) _ = True--almost_devoid_co_var_of_type :: Type -> CoVar -> Bool-almost_devoid_co_var_of_type (TyVarTy _) _ = True-almost_devoid_co_var_of_type (TyConApp _ tys) cv-  = almost_devoid_co_var_of_types tys cv-almost_devoid_co_var_of_type (LitTy {}) _ = True-almost_devoid_co_var_of_type (AppTy fun arg) cv-  = almost_devoid_co_var_of_type fun cv-  && almost_devoid_co_var_of_type arg cv-almost_devoid_co_var_of_type (FunTy _ arg res) cv-  = almost_devoid_co_var_of_type arg cv-  && almost_devoid_co_var_of_type res cv-almost_devoid_co_var_of_type (ForAllTy (Bndr v _) ty) cv-  = almost_devoid_co_var_of_type (varType v) cv-  && (v == cv || almost_devoid_co_var_of_type ty cv)-almost_devoid_co_var_of_type (CastTy ty co) cv-  = almost_devoid_co_var_of_type ty cv-  && almost_devoid_co_var_of_co co cv-almost_devoid_co_var_of_type (CoercionTy co) cv-  = almost_devoid_co_var_of_co co cv--almost_devoid_co_var_of_types :: [Type] -> CoVar -> Bool-almost_devoid_co_var_of_types [] _ = True-almost_devoid_co_var_of_types (ty:tys) cv-  = almost_devoid_co_var_of_type ty cv-  && almost_devoid_co_var_of_types tys cv--------------- Injective free vars --------------------- | Returns the free variables of a 'Type' that are in injective positions.--- For example, if @F@ is a non-injective type family, then:------ @--- injectiveTyVarsOf( Either c (Maybe (a, F b c)) ) = {a,c}--- @------ If @'injectiveVarsOfType' ty = itvs@, then knowing @ty@ fixes @itvs@.--- More formally, if--- @a@ is in @'injectiveVarsOfType' ty@--- and  @S1(ty) ~ S2(ty)@,--- then @S1(a)  ~ S2(a)@,--- where @S1@ and @S2@ are arbitrary substitutions.------ See @Note [When does a tycon application need an explicit kind signature?]@.-injectiveVarsOfType :: Type -> FV-injectiveVarsOfType = go-  where-    go ty                 | Just ty' <- coreView ty-                          = go ty'-    go (TyVarTy v)        = unitFV v `unionFV` go (tyVarKind v)-    go (AppTy f a)        = go f `unionFV` go a-    go (FunTy _ ty1 ty2)  = go ty1 `unionFV` go ty2-    go (TyConApp tc tys)  =-      case tyConInjectivityInfo tc of-        NotInjective  -> emptyFV-        Injective inj -> mapUnionFV go $-                         filterByList (inj ++ repeat True) tys-                         -- Oversaturated arguments to a tycon are-                         -- always injective, hence the repeat True-    go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go ty-    go LitTy{}           = emptyFV-    go (CastTy ty _)     = go ty-    go CoercionTy{}      = emptyFV---- | Does a 'TyCon' (that is applied to some number of arguments) need to be--- ascribed with an explicit kind signature to resolve ambiguity if rendered as--- a source-syntax type?--- (See @Note [When does a tycon application need an explicit kind signature?]@--- for a full explanation of what this function checks for.)---- Morally, this function ought to belong in TyCon.hs, not TyCoRep.hs, but--- accomplishing this requires a fair deal of futzing aruond with .hs-boot--- files.-tyConAppNeedsKindSig-  :: Bool  -- ^ Should specified binders count towards injective positions in-           --   the kind of the TyCon? (If you're using visible kind-           --   applications, then you want True here.-  -> TyCon-  -> Int   -- ^ The number of args the 'TyCon' is applied to.-  -> Bool  -- ^ Does @T t_1 ... t_n@ need a kind signature? (Where @n@ is the-           --   number of arguments)-tyConAppNeedsKindSig spec_inj_pos tc n_args-  | LT <- listLengthCmp tc_binders n_args-  = False-  | otherwise-  = let (dropped_binders, remaining_binders)-          = splitAt n_args tc_binders-        result_kind  = mkTyConKind remaining_binders tc_res_kind-        result_vars  = tyCoVarsOfType result_kind-        dropped_vars = fvVarSet $-                       mapUnionFV injective_vars_of_binder dropped_binders--    in not (subVarSet result_vars dropped_vars)-  where-    tc_binders  = tyConBinders tc-    tc_res_kind = tyConResKind tc--    -- Returns the variables that would be fixed by knowing a TyConBinder. See-    -- Note [When does a tycon application need an explicit kind signature?]-    -- for a more detailed explanation of what this function does.-    injective_vars_of_binder :: TyConBinder -> FV-    injective_vars_of_binder (Bndr tv vis) =-      case vis of-        AnonTCB VisArg -> injectiveVarsOfType (varType tv)-        NamedTCB argf  | source_of_injectivity argf-                       -> unitFV tv `unionFV` injectiveVarsOfType (varType tv)-        _              -> emptyFV--    source_of_injectivity Required  = True-    source_of_injectivity Specified = spec_inj_pos-    source_of_injectivity Inferred  = False--{--Note [When does a tycon application need an explicit kind signature?]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-There are a couple of places in GHC where we convert Core Types into forms that-more closely resemble user-written syntax. These include:--1. Template Haskell Type reification (see, for instance, TcSplice.reify_tc_app)-2. Converting Types to LHsTypes (in HsUtils.typeToLHsType, or in Haddock)--This conversion presents a challenge: how do we ensure that the resulting type-has enough kind information so as not to be ambiguous? To better motivate this-question, consider the following Core type:--  -- Foo :: Type -> Type-  type Foo = Proxy Type--There is nothing ambiguous about the RHS of Foo in Core. But if we were to,-say, reify it into a TH Type, then it's tempting to just drop the invisible-Type argument and simply return `Proxy`. But now we've lost crucial kind-information: we don't know if we're dealing with `Proxy Type` or `Proxy Bool`-or `Proxy Int` or something else! We've inadvertently introduced ambiguity.--Unlike in other situations in GHC, we can't just turn on--fprint-explicit-kinds, as we need to produce something which has the same-structure as a source-syntax type. Moreover, we can't rely on visible kind-application, since the first kind argument to Proxy is inferred, not specified.-Our solution is to annotate certain tycons with their kinds whenever they-appear in applied form in order to resolve the ambiguity. For instance, we-would reify the RHS of Foo like so:--  type Foo = (Proxy :: Type -> Type)--We need to devise an algorithm that determines precisely which tycons need-these explicit kind signatures. We certainly don't want to annotate _every_-tycon with a kind signature, or else we might end up with horribly bloated-types like the following:--  (Either :: Type -> Type -> Type) (Int :: Type) (Char :: Type)--We only want to annotate tycons that absolutely require kind signatures in-order to resolve some sort of ambiguity, and nothing more.--Suppose we have a tycon application (T ty_1 ... ty_n). Why might this type-require a kind signature? It might require it when we need to fill in any of-T's omitted arguments. By "omitted argument", we mean one that is dropped when-reifying ty_1 ... ty_n. Sometimes, the omitted arguments are inferred and-specified arguments (e.g., TH reification in TcSplice), and sometimes the-omitted arguments are only the inferred ones (e.g., in HsUtils.typeToLHsType,-which reifies specified arguments through visible kind application).-Regardless, the key idea is that _some_ arguments are going to be omitted after-reification, and the only mechanism we have at our disposal for filling them in-is through explicit kind signatures.--What do we mean by "fill in"? Let's consider this small example:--  T :: forall {k}. Type -> (k -> Type) -> k--Moreover, we have this application of T:--  T @{j} Int aty--When we reify this type, we omit the inferred argument @{j}. Is it fixed by the-other (non-inferred) arguments? Yes! If we know the kind of (aty :: blah), then-we'll generate an equality constraint (kappa -> Type) and, assuming we can-solve it, that will fix `kappa`. (Here, `kappa` is the unification variable-that we instantiate `k` with.)--Therefore, for any application of a tycon T to some arguments, the Question We-Must Answer is:--* Given the first n arguments of T, do the kinds of the non-omitted arguments-  fill in the omitted arguments?--(This is still a bit hand-wavey, but we'll refine this question incrementally-as we explain more of the machinery underlying this process.)--Answering this question is precisely the role that the `injectiveVarsOfType`-and `injective_vars_of_binder` functions exist to serve. If an omitted argument-`a` appears in the set returned by `injectiveVarsOfType ty`, then knowing-`ty` determines (i.e., fills in) `a`. (More on `injective_vars_of_binder` in a-bit.)--More formally, if-`a` is in `injectiveVarsOfType ty`-and  S1(ty) ~ S2(ty),-then S1(a)  ~ S2(a),-where S1 and S2 are arbitrary substitutions.--For example, is `F` is a non-injective type family, then--  injectiveVarsOfType(Either c (Maybe (a, F b c))) = {a, c}--Now that we know what this function does, here is a second attempt at the-Question We Must Answer:--* Given the first n arguments of T (ty_1 ... ty_n), consider the binders-  of T that are instantiated by non-omitted arguments. Do the injective-  variables of these binders fill in the remainder of T's kind?--Alright, we're getting closer. Next, we need to clarify what the injective-variables of a tycon binder are. This the role that the-`injective_vars_of_binder` function serves. Here is what this function does for-each form of tycon binder:--* Anonymous binders are injective positions. For example, in the promoted data-  constructor '(:):--    '(:) :: forall a. a -> [a] -> [a]--  The second and third tyvar binders (of kinds `a` and `[a]`) are both-  anonymous, so if we had '(:) 'True '[], then the kinds of 'True and-  '[] would contribute to the kind of '(:) 'True '[]. Therefore,-  injective_vars_of_binder(_ :: a) = injectiveVarsOfType(a) = {a}.-  (Similarly, injective_vars_of_binder(_ :: [a]) = {a}.)-* Named binders:-  - Inferred binders are never injective positions. For example, in this data-    type:--      data Proxy a-      Proxy :: forall {k}. k -> Type--    If we had Proxy 'True, then the kind of 'True would not contribute to the-    kind of Proxy 'True. Therefore,-    injective_vars_of_binder(forall {k}. ...) = {}.-  - Required binders are injective positions. For example, in this data type:--      data Wurble k (a :: k) :: k-      Wurble :: forall k -> k -> k--  The first tyvar binder (of kind `forall k`) has required visibility, so if-  we had Wurble (Maybe a) Nothing, then the kind of Maybe a would-  contribute to the kind of Wurble (Maybe a) Nothing. Hence,-  injective_vars_of_binder(forall a -> ...) = {a}.-  - Specified binders /might/ be injective positions, depending on how you-    approach things. Continuing the '(:) example:--      '(:) :: forall a. a -> [a] -> [a]--    Normally, the (forall a. ...) tyvar binder wouldn't contribute to the kind-    of '(:) 'True '[], since it's not explicitly instantiated by the user. But-    if visible kind application is enabled, then this is possible, since the-    user can write '(:) @Bool 'True '[]. (In that case,-    injective_vars_of_binder(forall a. ...) = {a}.)--    There are some situations where using visible kind application is appropriate-    (e.g., HsUtils.typeToLHsType) and others where it is not (e.g., TH-    reification), so the `injective_vars_of_binder` function is parametrized by-    a Bool which decides if specified binders should be counted towards-    injective positions or not.--Now that we've defined injective_vars_of_binder, we can refine the Question We-Must Answer once more:--* Given the first n arguments of T (ty_1 ... ty_n), consider the binders-  of T that are instantiated by non-omitted arguments. For each such binder-  b_i, take the union of all injective_vars_of_binder(b_i). Is this set a-  superset of the free variables of the remainder of T's kind?--If the answer to this question is "no", then (T ty_1 ... ty_n) needs an-explicit kind signature, since T's kind has kind variables leftover that-aren't fixed by the non-omitted arguments.--One last sticking point: what does "the remainder of T's kind" mean? You might-be tempted to think that it corresponds to all of the arguments in the kind of-T that would normally be instantiated by omitted arguments. But this isn't-quite right, strictly speaking. Consider the following (silly) example:--  S :: forall {k}. Type -> Type--And suppose we have this application of S:--  S Int Bool--The Int argument would be omitted, and-injective_vars_of_binder(_ :: Type) = {}. This is not a superset of {k}, which-might suggest that (S Bool) needs an explicit kind signature. But-(S Bool :: Type) doesn't actually fix `k`! This is because the kind signature-only affects the /result/ of the application, not all of the individual-arguments. So adding a kind signature here won't make a difference. Therefore,-the fourth (and final) iteration of the Question We Must Answer is:--* Given the first n arguments of T (ty_1 ... ty_n), consider the binders-  of T that are instantiated by non-omitted arguments. For each such binder-  b_i, take the union of all injective_vars_of_binder(b_i). Is this set a-  superset of the free variables of the kind of (T ty_1 ... ty_n)?--Phew, that was a lot of work!--How can be sure that this is correct? That is, how can we be sure that in the-event that we leave off a kind annotation, that one could infer the kind of the-tycon application from its arguments? It's essentially a proof by induction: if-we can infer the kinds of every subtree of a type, then the whole tycon-application will have an inferrable kind--unless, of course, the remainder of-the tycon application's kind has uninstantiated kind variables.--What happens if T is oversaturated? That is, if T's kind has fewer than n-arguments, in the case that the concrete application instantiates a result-kind variable with an arrow kind? If we run out of arguments, we do not attach-a kind annotation. This should be a rare case, indeed. Here is an example:--   data T1 :: k1 -> k2 -> *-   data T2 :: k1 -> k2 -> *--   type family G (a :: k) :: k-   type instance G T1 = T2--   type instance F Char = (G T1 Bool :: (* -> *) -> *)   -- F from above--Here G's kind is (forall k. k -> k), and the desugared RHS of that last-instance of F is (G (* -> (* -> *) -> *) (T1 * (* -> *)) Bool). According to-the algorithm above, there are 3 arguments to G so we should peel off 3-arguments in G's kind. But G's kind has only two arguments. This is the-rare special case, and we choose not to annotate the application of G with-a kind signature. After all, we needn't do this, since that instance would-be reified as:--   type instance F Char = G (T1 :: * -> (* -> *) -> *) Bool--So the kind of G isn't ambiguous anymore due to the explicit kind annotation-on its argument. See #8953 and test th/T8953.--}--------------- No free vars --------------------- | Returns True if this type has no free variables. Should be the same as--- isEmptyVarSet . tyCoVarsOfType, but faster in the non-forall case.-noFreeVarsOfType :: Type -> Bool-noFreeVarsOfType (TyVarTy _)      = False-noFreeVarsOfType (AppTy t1 t2)    = noFreeVarsOfType t1 && noFreeVarsOfType t2-noFreeVarsOfType (TyConApp _ tys) = all noFreeVarsOfType tys-noFreeVarsOfType ty@(ForAllTy {}) = isEmptyVarSet (tyCoVarsOfType ty)-noFreeVarsOfType (FunTy _ t1 t2)  = noFreeVarsOfType t1 && noFreeVarsOfType t2-noFreeVarsOfType (LitTy _)        = True-noFreeVarsOfType (CastTy ty co)   = noFreeVarsOfType ty && noFreeVarsOfCo co-noFreeVarsOfType (CoercionTy co)  = noFreeVarsOfCo co--noFreeVarsOfMCo :: MCoercion -> Bool-noFreeVarsOfMCo MRefl    = True-noFreeVarsOfMCo (MCo co) = noFreeVarsOfCo co--noFreeVarsOfTypes :: [Type] -> Bool-noFreeVarsOfTypes = all noFreeVarsOfType---- | Returns True if this coercion has no free variables. Should be the same as--- isEmptyVarSet . tyCoVarsOfCo, but faster in the non-forall case.-noFreeVarsOfCo :: Coercion -> Bool-noFreeVarsOfCo (Refl ty)              = noFreeVarsOfType ty-noFreeVarsOfCo (GRefl _ ty co)        = noFreeVarsOfType ty && noFreeVarsOfMCo co-noFreeVarsOfCo (TyConAppCo _ _ args)  = all noFreeVarsOfCo args-noFreeVarsOfCo (AppCo c1 c2)          = noFreeVarsOfCo c1 && noFreeVarsOfCo c2-noFreeVarsOfCo co@(ForAllCo {})       = isEmptyVarSet (tyCoVarsOfCo co)-noFreeVarsOfCo (FunCo _ c1 c2)        = noFreeVarsOfCo c1 && noFreeVarsOfCo c2-noFreeVarsOfCo (CoVarCo _)            = False-noFreeVarsOfCo (HoleCo {})            = True    -- I'm unsure; probably never happens-noFreeVarsOfCo (AxiomInstCo _ _ args) = all noFreeVarsOfCo args-noFreeVarsOfCo (UnivCo p _ t1 t2)     = noFreeVarsOfProv p &&-                                        noFreeVarsOfType t1 &&-                                        noFreeVarsOfType t2-noFreeVarsOfCo (SymCo co)             = noFreeVarsOfCo co-noFreeVarsOfCo (TransCo co1 co2)      = noFreeVarsOfCo co1 && noFreeVarsOfCo co2-noFreeVarsOfCo (NthCo _ _ co)         = noFreeVarsOfCo co-noFreeVarsOfCo (LRCo _ co)            = noFreeVarsOfCo co-noFreeVarsOfCo (InstCo co1 co2)       = noFreeVarsOfCo co1 && noFreeVarsOfCo co2-noFreeVarsOfCo (KindCo co)            = noFreeVarsOfCo co-noFreeVarsOfCo (SubCo co)             = noFreeVarsOfCo co-noFreeVarsOfCo (AxiomRuleCo _ cs)     = all noFreeVarsOfCo cs---- | Returns True if this UnivCoProv has no free variables. Should be the same as--- isEmptyVarSet . tyCoVarsOfProv, but faster in the non-forall case.-noFreeVarsOfProv :: UnivCoProvenance -> Bool-noFreeVarsOfProv UnsafeCoerceProv    = True-noFreeVarsOfProv (PhantomProv co)    = noFreeVarsOfCo co-noFreeVarsOfProv (ProofIrrelProv co) = noFreeVarsOfCo co-noFreeVarsOfProv (PluginProv {})     = True--{--%************************************************************************-%*                                                                      *-                        Substitutions-      Data type defined here to avoid unnecessary mutual recursion-%*                                                                      *-%************************************************************************--}---- | Type & coercion substitution------ #tcvsubst_invariant#--- The following invariants must hold of a 'TCvSubst':------ 1. The in-scope set is needed /only/ to--- guide the generation of fresh uniques------ 2. In particular, the /kind/ of the type variables in--- the in-scope set is not relevant------ 3. The substitution is only applied ONCE! This is because--- in general such application will not reach a fixed point.-data TCvSubst-  = TCvSubst InScopeSet -- The in-scope type and kind variables-             TvSubstEnv -- Substitutes both type and kind variables-             CvSubstEnv -- Substitutes coercion variables-        -- See Note [Substitutions apply only once]-        -- and Note [Extending the TvSubstEnv]-        -- and Note [Substituting types and coercions]-        -- and Note [The substitution invariant]---- | A substitution of 'Type's for 'TyVar's---                 and 'Kind's for 'KindVar's-type TvSubstEnv = TyVarEnv Type-  -- NB: A TvSubstEnv is used-  --   both inside a TCvSubst (with the apply-once invariant-  --        discussed in Note [Substitutions apply only once],-  --   and  also independently in the middle of matching,-  --        and unification (see Types.Unify).-  -- So you have to look at the context to know if it's idempotent or-  -- apply-once or whatever---- | A substitution of 'Coercion's for 'CoVar's-type CvSubstEnv = CoVarEnv Coercion--{- Note [The substitution invariant]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-When calling (substTy subst ty) it should be the case that-the in-scope set in the substitution is a superset of both:--  (SIa) The free vars of the range of the substitution-  (SIb) The free vars of ty minus the domain of the substitution--The same rules apply to other substitutions (notably CoreSubst.Subst)--* Reason for (SIa). Consider-      substTy [a :-> Maybe b] (forall b. b->a)-  we must rename the forall b, to get-      forall b2. b2 -> Maybe b-  Making 'b' part of the in-scope set forces this renaming to-  take place.--* Reason for (SIb). Consider-     substTy [a :-> Maybe b] (forall b. (a,b,x))-  Then if we use the in-scope set {b}, satisfying (SIa), there is-  a danger we will rename the forall'd variable to 'x' by mistake,-  getting this:-      forall x. (Maybe b, x, x)-  Breaking (SIb) caused the bug from #11371.--Note: if the free vars of the range of the substitution are freshly created,-then the problems of (SIa) can't happen, and so it would be sound to-ignore (SIa).--Note [Substitutions apply only once]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We use TCvSubsts to instantiate things, and we might instantiate-        forall a b. ty-with the types-        [a, b], or [b, a].-So the substitution might go [a->b, b->a].  A similar situation arises in Core-when we find a beta redex like-        (/\ a /\ b -> e) b a-Then we also end up with a substitution that permutes type variables. Other-variations happen to; for example [a -> (a, b)].--        ********************************************************-        *** So a substitution must be applied precisely once ***-        ********************************************************--A TCvSubst is not idempotent, but, unlike the non-idempotent substitution-we use during unifications, it must not be repeatedly applied.--Note [Extending the TvSubstEnv]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-See #tcvsubst_invariant# for the invariants that must hold.--This invariant allows a short-cut when the subst envs are empty:-if the TvSubstEnv and CvSubstEnv are empty --- i.e. (isEmptyTCvSubst subst)-holds --- then (substTy subst ty) does nothing.--For example, consider:-        (/\a. /\b:(a~Int). ...b..) Int-We substitute Int for 'a'.  The Unique of 'b' does not change, but-nevertheless we add 'b' to the TvSubstEnv, because b's kind does change--This invariant has several crucial consequences:--* In substVarBndr, we need extend the TvSubstEnv-        - if the unique has changed-        - or if the kind has changed--* In substTyVar, we do not need to consult the in-scope set;-  the TvSubstEnv is enough--* In substTy, substTheta, we can short-circuit when the TvSubstEnv is empty--Note [Substituting types and coercions]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Types and coercions are mutually recursive, and either may have variables-"belonging" to the other. Thus, every time we wish to substitute in a-type, we may also need to substitute in a coercion, and vice versa.-However, the constructor used to create type variables is distinct from-that of coercion variables, so we carry two VarEnvs in a TCvSubst. Note-that it would be possible to use the CoercionTy constructor to combine-these environments, but that seems like a false economy.--Note that the TvSubstEnv should *never* map a CoVar (built with the Id-constructor) and the CvSubstEnv should *never* map a TyVar. Furthermore,-the range of the TvSubstEnv should *never* include a type headed with-CoercionTy.--}--emptyTvSubstEnv :: TvSubstEnv-emptyTvSubstEnv = emptyVarEnv--emptyCvSubstEnv :: CvSubstEnv-emptyCvSubstEnv = emptyVarEnv--composeTCvSubstEnv :: InScopeSet-                   -> (TvSubstEnv, CvSubstEnv)-                   -> (TvSubstEnv, CvSubstEnv)-                   -> (TvSubstEnv, CvSubstEnv)--- ^ @(compose env1 env2)(x)@ is @env1(env2(x))@; i.e. apply @env2@ then @env1@.--- It assumes that both are idempotent.--- Typically, @env1@ is the refinement to a base substitution @env2@-composeTCvSubstEnv in_scope (tenv1, cenv1) (tenv2, cenv2)-  = ( tenv1 `plusVarEnv` mapVarEnv (substTy subst1) tenv2-    , cenv1 `plusVarEnv` mapVarEnv (substCo subst1) cenv2 )-        -- First apply env1 to the range of env2-        -- Then combine the two, making sure that env1 loses if-        -- both bind the same variable; that's why env1 is the-        --  *left* argument to plusVarEnv, because the right arg wins-  where-    subst1 = TCvSubst in_scope tenv1 cenv1---- | Composes two substitutions, applying the second one provided first,--- like in function composition.-composeTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst-composeTCvSubst (TCvSubst is1 tenv1 cenv1) (TCvSubst is2 tenv2 cenv2)-  = TCvSubst is3 tenv3 cenv3-  where-    is3 = is1 `unionInScope` is2-    (tenv3, cenv3) = composeTCvSubstEnv is3 (tenv1, cenv1) (tenv2, cenv2)--emptyTCvSubst :: TCvSubst-emptyTCvSubst = TCvSubst emptyInScopeSet emptyTvSubstEnv emptyCvSubstEnv--mkEmptyTCvSubst :: InScopeSet -> TCvSubst-mkEmptyTCvSubst is = TCvSubst is emptyTvSubstEnv emptyCvSubstEnv--isEmptyTCvSubst :: TCvSubst -> Bool-         -- See Note [Extending the TvSubstEnv]-isEmptyTCvSubst (TCvSubst _ tenv cenv) = isEmptyVarEnv tenv && isEmptyVarEnv cenv--mkTCvSubst :: InScopeSet -> (TvSubstEnv, CvSubstEnv) -> TCvSubst-mkTCvSubst in_scope (tenv, cenv) = TCvSubst in_scope tenv cenv--mkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst--- ^ Make a TCvSubst with specified tyvar subst and empty covar subst-mkTvSubst in_scope tenv = TCvSubst in_scope tenv emptyCvSubstEnv--mkCvSubst :: InScopeSet -> CvSubstEnv -> TCvSubst--- ^ Make a TCvSubst with specified covar subst and empty tyvar subst-mkCvSubst in_scope cenv = TCvSubst in_scope emptyTvSubstEnv cenv--getTvSubstEnv :: TCvSubst -> TvSubstEnv-getTvSubstEnv (TCvSubst _ env _) = env--getCvSubstEnv :: TCvSubst -> CvSubstEnv-getCvSubstEnv (TCvSubst _ _ env) = env--getTCvInScope :: TCvSubst -> InScopeSet-getTCvInScope (TCvSubst in_scope _ _) = in_scope---- | Returns the free variables of the types in the range of a substitution as--- a non-deterministic set.-getTCvSubstRangeFVs :: TCvSubst -> VarSet-getTCvSubstRangeFVs (TCvSubst _ tenv cenv)-    = unionVarSet tenvFVs cenvFVs-  where-    tenvFVs = tyCoVarsOfTypesSet tenv-    cenvFVs = tyCoVarsOfCosSet cenv--isInScope :: Var -> TCvSubst -> Bool-isInScope v (TCvSubst in_scope _ _) = v `elemInScopeSet` in_scope--notElemTCvSubst :: Var -> TCvSubst -> Bool-notElemTCvSubst v (TCvSubst _ tenv cenv)-  | isTyVar v-  = not (v `elemVarEnv` tenv)-  | otherwise-  = not (v `elemVarEnv` cenv)--setTvSubstEnv :: TCvSubst -> TvSubstEnv -> TCvSubst-setTvSubstEnv (TCvSubst in_scope _ cenv) tenv = TCvSubst in_scope tenv cenv--setCvSubstEnv :: TCvSubst -> CvSubstEnv -> TCvSubst-setCvSubstEnv (TCvSubst in_scope tenv _) cenv = TCvSubst in_scope tenv cenv--zapTCvSubst :: TCvSubst -> TCvSubst-zapTCvSubst (TCvSubst in_scope _ _) = TCvSubst in_scope emptyVarEnv emptyVarEnv--extendTCvInScope :: TCvSubst -> Var -> TCvSubst-extendTCvInScope (TCvSubst in_scope tenv cenv) var-  = TCvSubst (extendInScopeSet in_scope var) tenv cenv--extendTCvInScopeList :: TCvSubst -> [Var] -> TCvSubst-extendTCvInScopeList (TCvSubst in_scope tenv cenv) vars-  = TCvSubst (extendInScopeSetList in_scope vars) tenv cenv--extendTCvInScopeSet :: TCvSubst -> VarSet -> TCvSubst-extendTCvInScopeSet (TCvSubst in_scope tenv cenv) vars-  = TCvSubst (extendInScopeSetSet in_scope vars) tenv cenv--extendTCvSubst :: TCvSubst -> TyCoVar -> Type -> TCvSubst-extendTCvSubst subst v ty-  | isTyVar v-  = extendTvSubst subst v ty-  | CoercionTy co <- ty-  = extendCvSubst subst v co-  | otherwise-  = pprPanic "extendTCvSubst" (ppr v <+> text "|->" <+> ppr ty)--extendTCvSubstWithClone :: TCvSubst -> TyCoVar -> TyCoVar -> TCvSubst-extendTCvSubstWithClone subst tcv-  | isTyVar tcv = extendTvSubstWithClone subst tcv-  | otherwise   = extendCvSubstWithClone subst tcv--extendTvSubst :: TCvSubst -> TyVar -> Type -> TCvSubst-extendTvSubst (TCvSubst in_scope tenv cenv) tv ty-  = TCvSubst in_scope (extendVarEnv tenv tv ty) cenv--extendTvSubstBinderAndInScope :: TCvSubst -> TyCoBinder -> Type -> TCvSubst-extendTvSubstBinderAndInScope subst (Named (Bndr v _)) ty-  = ASSERT( isTyVar v )-    extendTvSubstAndInScope subst v ty-extendTvSubstBinderAndInScope subst (Anon {}) _-  = subst--extendTvSubstWithClone :: TCvSubst -> TyVar -> TyVar -> TCvSubst--- Adds a new tv -> tv mapping, /and/ extends the in-scope set-extendTvSubstWithClone (TCvSubst in_scope tenv cenv) tv tv'-  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)-             (extendVarEnv tenv tv (mkTyVarTy tv'))-             cenv-  where-    new_in_scope = tyCoVarsOfType (tyVarKind tv') `extendVarSet` tv'--extendCvSubst :: TCvSubst -> CoVar -> Coercion -> TCvSubst-extendCvSubst (TCvSubst in_scope tenv cenv) v co-  = TCvSubst in_scope tenv (extendVarEnv cenv v co)--extendCvSubstWithClone :: TCvSubst -> CoVar -> CoVar -> TCvSubst-extendCvSubstWithClone (TCvSubst in_scope tenv cenv) cv cv'-  = TCvSubst (extendInScopeSetSet in_scope new_in_scope)-             tenv-             (extendVarEnv cenv cv (mkCoVarCo cv'))-  where-    new_in_scope = tyCoVarsOfType (varType cv') `extendVarSet` cv'--extendTvSubstAndInScope :: TCvSubst -> TyVar -> Type -> TCvSubst--- Also extends the in-scope set-extendTvSubstAndInScope (TCvSubst in_scope tenv cenv) tv ty-  = TCvSubst (in_scope `extendInScopeSetSet` tyCoVarsOfType ty)-             (extendVarEnv tenv tv ty)-             cenv--extendTvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst-extendTvSubstList subst tvs tys-  = foldl2 extendTvSubst subst tvs tys--extendTCvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst-extendTCvSubstList subst tvs tys-  = foldl2 extendTCvSubst subst tvs tys--unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst--- Works when the ranges are disjoint-unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2)-  = ASSERT( not (tenv1 `intersectsVarEnv` tenv2)-         && not (cenv1 `intersectsVarEnv` cenv2) )-    TCvSubst (in_scope1 `unionInScope` in_scope2)-             (tenv1     `plusVarEnv`   tenv2)-             (cenv1     `plusVarEnv`   cenv2)---- mkTvSubstPrs and zipTvSubst generate the in-scope set from--- the types given; but it's just a thunk so with a bit of luck--- it'll never be evaluated---- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming--- environment. No CoVars, please!-zipTvSubst :: HasDebugCallStack => [TyVar] -> [Type] -> TCvSubst-zipTvSubst tvs tys-  = mkTvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) tenv-  where-    tenv = zipTyEnv tvs tys---- | Generates the in-scope set for the 'TCvSubst' from the types in the incoming--- environment.  No TyVars, please!-zipCvSubst :: HasDebugCallStack => [CoVar] -> [Coercion] -> TCvSubst-zipCvSubst cvs cos-  = TCvSubst (mkInScopeSet (tyCoVarsOfCos cos)) emptyTvSubstEnv cenv-  where-    cenv = zipCoEnv cvs cos--zipTCvSubst :: HasDebugCallStack => [TyCoVar] -> [Type] -> TCvSubst-zipTCvSubst tcvs tys-  = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys))-  where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst-        zip_tcvsubst (tv:tvs) (ty:tys) subst-          = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty)-        zip_tcvsubst [] [] subst = subst -- empty case-        zip_tcvsubst _  _  _     = pprPanic "zipTCvSubst: length mismatch"-                                            (ppr tcvs <+> ppr tys)---- | Generates the in-scope set for the 'TCvSubst' from the types in the--- incoming environment. No CoVars, please!-mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst-mkTvSubstPrs prs =-    ASSERT2( onlyTyVarsAndNoCoercionTy, text "prs" <+> ppr prs )-    mkTvSubst in_scope tenv-  where tenv = mkVarEnv prs-        in_scope = mkInScopeSet $ tyCoVarsOfTypes $ map snd prs-        onlyTyVarsAndNoCoercionTy =-          and [ isTyVar tv && not (isCoercionTy ty)-              | (tv, ty) <- prs ]--zipTyEnv :: HasDebugCallStack => [TyVar] -> [Type] -> TvSubstEnv-zipTyEnv tyvars tys-  | debugIsOn-  , not (all isTyVar tyvars)-  = pprPanic "zipTyEnv" (ppr tyvars <+> ppr tys)-  | otherwise-  = ASSERT( all (not . isCoercionTy) tys )-    mkVarEnv (zipEqual "zipTyEnv" tyvars tys)-        -- There used to be a special case for when-        --      ty == TyVarTy tv-        -- (a not-uncommon case) in which case the substitution was dropped.-        -- But the type-tidier changes the print-name of a type variable without-        -- changing the unique, and that led to a bug.   Why?  Pre-tidying, we had-        -- a type {Foo t}, where Foo is a one-method class.  So Foo is really a newtype.-        -- And it happened that t was the type variable of the class.  Post-tiding,-        -- it got turned into {Foo t2}.  The ext-core printer expanded this using-        -- sourceTypeRep, but that said "Oh, t == t2" because they have the same unique,-        -- and so generated a rep type mentioning t not t2.-        ---        -- Simplest fix is to nuke the "optimisation"--zipCoEnv :: HasDebugCallStack => [CoVar] -> [Coercion] -> CvSubstEnv-zipCoEnv cvs cos-  | debugIsOn-  , not (all isCoVar cvs)-  = pprPanic "zipCoEnv" (ppr cvs <+> ppr cos)-  | otherwise-  = mkVarEnv (zipEqual "zipCoEnv" cvs cos)--instance Outputable TCvSubst where-  ppr (TCvSubst ins tenv cenv)-    = brackets $ sep[ text "TCvSubst",-                      nest 2 (text "In scope:" <+> ppr ins),-                      nest 2 (text "Type env:" <+> ppr tenv),-                      nest 2 (text "Co env:" <+> ppr cenv) ]--{--%************************************************************************-%*                                                                      *-                Performing type or kind substitutions-%*                                                                      *-%************************************************************************--Note [Sym and ForAllCo]-~~~~~~~~~~~~~~~~~~~~~~~-In OptCoercion, we try to push "sym" out to the leaves of a coercion. But,-how do we push sym into a ForAllCo? It's a little ugly.--Here is the typing rule:--h : k1 ~# k2-(tv : k1) |- g : ty1 ~# ty2------------------------------ForAllCo tv h g : (ForAllTy (tv : k1) ty1) ~#-                  (ForAllTy (tv : k2) (ty2[tv |-> tv |> sym h]))--Here is what we want:--ForAllCo tv h' g' : (ForAllTy (tv : k2) (ty2[tv |-> tv |> sym h])) ~#-                    (ForAllTy (tv : k1) ty1)---Because the kinds of the type variables to the right of the colon are the kinds-coerced by h', we know (h' : k2 ~# k1). Thus, (h' = sym h).--Now, we can rewrite ty1 to be (ty1[tv |-> tv |> sym h' |> h']). We thus want--ForAllCo tv h' g' :-  (ForAllTy (tv : k2) (ty2[tv |-> tv |> h'])) ~#-  (ForAllTy (tv : k1) (ty1[tv |-> tv |> h'][tv |-> tv |> sym h']))--We thus see that we want--g' : ty2[tv |-> tv |> h'] ~# ty1[tv |-> tv |> h']--and thus g' = sym (g[tv |-> tv |> h']).--Putting it all together, we get this:--sym (ForAllCo tv h g)-==>-ForAllCo tv (sym h) (sym g[tv |-> tv |> sym h])--Note [Substituting in a coercion hole]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-It seems highly suspicious to be substituting in a coercion that still-has coercion holes. Yet, this can happen in a situation like this:--  f :: forall k. k :~: Type -> ()-  f Refl = let x :: forall (a :: k). [a] -> ...-               x = ...--When we check x's type signature, we require that k ~ Type. We indeed-know this due to the Refl pattern match, but the eager unifier can't-make use of givens. So, when we're done looking at x's type, a coercion-hole will remain. Then, when we're checking x's definition, we skolemise-x's type (in order to, e.g., bring the scoped type variable `a` into scope).-This requires performing a substitution for the fresh skolem variables.--This subsitution needs to affect the kind of the coercion hole, too ---otherwise, the kind will have an out-of-scope variable in it. More problematically-in practice (we won't actually notice the out-of-scope variable ever), skolems-in the kind might have too high a level, triggering a failure to uphold the-invariant that no free variables in a type have a higher level than the-ambient level in the type checker. In the event of having free variables in the-hole's kind, I'm pretty sure we'll always have an erroneous program, so we-don't need to worry what will happen when the hole gets filled in. After all,-a hole relating a locally-bound type variable will be unable to be solved. This-is why it's OK not to look through the IORef of a coercion hole during-substitution.---}---- | Type substitution, see 'zipTvSubst'-substTyWith :: HasCallStack => [TyVar] -> [Type] -> Type -> Type--- Works only if the domain of the substitution is a--- superset of the type being substituted into-substTyWith tvs tys = {-#SCC "substTyWith" #-}-                      ASSERT( tvs `equalLength` tys )-                      substTy (zipTvSubst tvs tys)---- | Type substitution, see 'zipTvSubst'. Disables sanity checks.--- The problems that the sanity checks in substTy catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substTyUnchecked to--- substTy and remove this function. Please don't use in new code.-substTyWithUnchecked :: [TyVar] -> [Type] -> Type -> Type-substTyWithUnchecked tvs tys-  = ASSERT( tvs `equalLength` tys )-    substTyUnchecked (zipTvSubst tvs tys)---- | Substitute tyvars within a type using a known 'InScopeSet'.--- Pre-condition: the 'in_scope' set should satisfy Note [The substitution--- invariant]; specifically it should include the free vars of 'tys',--- and of 'ty' minus the domain of the subst.-substTyWithInScope :: InScopeSet -> [TyVar] -> [Type] -> Type -> Type-substTyWithInScope in_scope tvs tys ty =-  ASSERT( tvs `equalLength` tys )-  substTy (mkTvSubst in_scope tenv) ty-  where tenv = zipTyEnv tvs tys---- | Coercion substitution, see 'zipTvSubst'-substCoWith :: HasCallStack => [TyVar] -> [Type] -> Coercion -> Coercion-substCoWith tvs tys = ASSERT( tvs `equalLength` tys )-                      substCo (zipTvSubst tvs tys)---- | Coercion substitution, see 'zipTvSubst'. Disables sanity checks.--- The problems that the sanity checks in substCo catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substCoUnchecked to--- substCo and remove this function. Please don't use in new code.-substCoWithUnchecked :: [TyVar] -> [Type] -> Coercion -> Coercion-substCoWithUnchecked tvs tys-  = ASSERT( tvs `equalLength` tys )-    substCoUnchecked (zipTvSubst tvs tys)------ | Substitute covars within a type-substTyWithCoVars :: [CoVar] -> [Coercion] -> Type -> Type-substTyWithCoVars cvs cos = substTy (zipCvSubst cvs cos)---- | Type substitution, see 'zipTvSubst'-substTysWith :: [TyVar] -> [Type] -> [Type] -> [Type]-substTysWith tvs tys = ASSERT( tvs `equalLength` tys )-                       substTys (zipTvSubst tvs tys)---- | Type substitution, see 'zipTvSubst'-substTysWithCoVars :: [CoVar] -> [Coercion] -> [Type] -> [Type]-substTysWithCoVars cvs cos = ASSERT( cvs `equalLength` cos )-                             substTys (zipCvSubst cvs cos)---- | Substitute within a 'Type' after adding the free variables of the type--- to the in-scope set. This is useful for the case when the free variables--- aren't already in the in-scope set or easily available.--- See also Note [The substitution invariant].-substTyAddInScope :: TCvSubst -> Type -> Type-substTyAddInScope subst ty =-  substTy (extendTCvInScopeSet subst $ tyCoVarsOfType ty) ty---- | When calling `substTy` it should be the case that the in-scope set in--- the substitution is a superset of the free vars of the range of the--- substitution.--- See also Note [The substitution invariant].-isValidTCvSubst :: TCvSubst -> Bool-isValidTCvSubst (TCvSubst in_scope tenv cenv) =-  (tenvFVs `varSetInScope` in_scope) &&-  (cenvFVs `varSetInScope` in_scope)-  where-  tenvFVs = tyCoVarsOfTypesSet tenv-  cenvFVs = tyCoVarsOfCosSet cenv---- | This checks if the substitution satisfies the invariant from--- Note [The substitution invariant].-checkValidSubst :: HasCallStack => TCvSubst -> [Type] -> [Coercion] -> a -> a-checkValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a-  = ASSERT2( isValidTCvSubst subst,-             text "in_scope" <+> ppr in_scope $$-             text "tenv" <+> ppr tenv $$-             text "tenvFVs" <+> ppr (tyCoVarsOfTypesSet tenv) $$-             text "cenv" <+> ppr cenv $$-             text "cenvFVs" <+> ppr (tyCoVarsOfCosSet cenv) $$-             text "tys" <+> ppr tys $$-             text "cos" <+> ppr cos )-    ASSERT2( tysCosFVsInScope,-             text "in_scope" <+> ppr in_scope $$-             text "tenv" <+> ppr tenv $$-             text "cenv" <+> ppr cenv $$-             text "tys" <+> ppr tys $$-             text "cos" <+> ppr cos $$-             text "needInScope" <+> ppr needInScope )-    a-  where-  substDomain = nonDetKeysUFM tenv ++ nonDetKeysUFM cenv-    -- It's OK to use nonDetKeysUFM here, because we only use this list to-    -- remove some elements from a set-  needInScope = (tyCoVarsOfTypes tys `unionVarSet` tyCoVarsOfCos cos)-                  `delListFromUniqSet_Directly` substDomain-  tysCosFVsInScope = needInScope `varSetInScope` in_scope----- | Substitute within a 'Type'--- The substitution has to satisfy the invariants described in--- Note [The substitution invariant].-substTy :: HasCallStack => TCvSubst -> Type  -> Type-substTy subst ty-  | isEmptyTCvSubst subst = ty-  | otherwise             = checkValidSubst subst [ty] [] $-                            subst_ty subst ty---- | Substitute within a 'Type' disabling the sanity checks.--- The problems that the sanity checks in substTy catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substTyUnchecked to--- substTy and remove this function. Please don't use in new code.-substTyUnchecked :: TCvSubst -> Type -> Type-substTyUnchecked subst ty-                 | isEmptyTCvSubst subst = ty-                 | otherwise             = subst_ty subst ty---- | Substitute within several 'Type's--- The substitution has to satisfy the invariants described in--- Note [The substitution invariant].-substTys :: HasCallStack => TCvSubst -> [Type] -> [Type]-substTys subst tys-  | isEmptyTCvSubst subst = tys-  | otherwise = checkValidSubst subst tys [] $ map (subst_ty subst) tys---- | Substitute within several 'Type's disabling the sanity checks.--- The problems that the sanity checks in substTys catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substTysUnchecked to--- substTys and remove this function. Please don't use in new code.-substTysUnchecked :: TCvSubst -> [Type] -> [Type]-substTysUnchecked subst tys-                 | isEmptyTCvSubst subst = tys-                 | otherwise             = map (subst_ty subst) tys---- | Substitute within a 'ThetaType'--- The substitution has to satisfy the invariants described in--- Note [The substitution invariant].-substTheta :: HasCallStack => TCvSubst -> ThetaType -> ThetaType-substTheta = substTys---- | Substitute within a 'ThetaType' disabling the sanity checks.--- The problems that the sanity checks in substTys catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substThetaUnchecked to--- substTheta and remove this function. Please don't use in new code.-substThetaUnchecked :: TCvSubst -> ThetaType -> ThetaType-substThetaUnchecked = substTysUnchecked---subst_ty :: TCvSubst -> Type -> Type--- subst_ty is the main workhorse for type substitution------ Note that the in_scope set is poked only if we hit a forall--- so it may often never be fully computed-subst_ty subst ty-   = go ty-  where-    go (TyVarTy tv)      = substTyVar subst tv-    go (AppTy fun arg)   = mkAppTy (go fun) $! (go arg)-                -- The mkAppTy smart constructor is important-                -- we might be replacing (a Int), represented with App-                -- by [Int], represented with TyConApp-    go (TyConApp tc tys) = let args = map go tys-                           in  args `seqList` TyConApp tc args-    go ty@(FunTy { ft_arg = arg, ft_res = res })-      = let !arg' = go arg-            !res' = go res-        in ty { ft_arg = arg', ft_res = res' }-    go (ForAllTy (Bndr tv vis) ty)-                         = case substVarBndrUnchecked subst tv of-                             (subst', tv') ->-                               (ForAllTy $! ((Bndr $! tv') vis)) $!-                                            (subst_ty subst' ty)-    go (LitTy n)         = LitTy $! n-    go (CastTy ty co)    = (mkCastTy $! (go ty)) $! (subst_co subst co)-    go (CoercionTy co)   = CoercionTy $! (subst_co subst co)--substTyVar :: TCvSubst -> TyVar -> Type-substTyVar (TCvSubst _ tenv _) tv-  = ASSERT( isTyVar tv )-    case lookupVarEnv tenv tv of-      Just ty -> ty-      Nothing -> TyVarTy tv--substTyVars :: TCvSubst -> [TyVar] -> [Type]-substTyVars subst = map $ substTyVar subst--substTyCoVars :: TCvSubst -> [TyCoVar] -> [Type]-substTyCoVars subst = map $ substTyCoVar subst--substTyCoVar :: TCvSubst -> TyCoVar -> Type-substTyCoVar subst tv-  | isTyVar tv = substTyVar subst tv-  | otherwise = CoercionTy $ substCoVar subst tv--lookupTyVar :: TCvSubst -> TyVar  -> Maybe Type-        -- See Note [Extending the TCvSubst]-lookupTyVar (TCvSubst _ tenv _) tv-  = ASSERT( isTyVar tv )-    lookupVarEnv tenv tv---- | Substitute within a 'Coercion'--- The substitution has to satisfy the invariants described in--- Note [The substitution invariant].-substCo :: HasCallStack => TCvSubst -> Coercion -> Coercion-substCo subst co-  | isEmptyTCvSubst subst = co-  | otherwise = checkValidSubst subst [] [co] $ subst_co subst co---- | Substitute within a 'Coercion' disabling sanity checks.--- The problems that the sanity checks in substCo catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substCoUnchecked to--- substCo and remove this function. Please don't use in new code.-substCoUnchecked :: TCvSubst -> Coercion -> Coercion-substCoUnchecked subst co-  | isEmptyTCvSubst subst = co-  | otherwise = subst_co subst co---- | Substitute within several 'Coercion's--- The substitution has to satisfy the invariants described in--- Note [The substitution invariant].-substCos :: HasCallStack => TCvSubst -> [Coercion] -> [Coercion]-substCos subst cos-  | isEmptyTCvSubst subst = cos-  | otherwise = checkValidSubst subst [] cos $ map (subst_co subst) cos--subst_co :: TCvSubst -> Coercion -> Coercion-subst_co subst co-  = go co-  where-    go_ty :: Type -> Type-    go_ty = subst_ty subst--    go_mco :: MCoercion -> MCoercion-    go_mco MRefl    = MRefl-    go_mco (MCo co) = MCo (go co)--    go :: Coercion -> Coercion-    go (Refl ty)             = mkNomReflCo $! (go_ty ty)-    go (GRefl r ty mco)      = (mkGReflCo r $! (go_ty ty)) $! (go_mco mco)-    go (TyConAppCo r tc args)= let args' = map go args-                               in  args' `seqList` mkTyConAppCo r tc args'-    go (AppCo co arg)        = (mkAppCo $! go co) $! go arg-    go (ForAllCo tv kind_co co)-      = case substForAllCoBndrUnchecked subst tv kind_co of-         (subst', tv', kind_co') ->-          ((mkForAllCo $! tv') $! kind_co') $! subst_co subst' co-    go (FunCo r co1 co2)     = (mkFunCo r $! go co1) $! go co2-    go (CoVarCo cv)          = substCoVar subst cv-    go (AxiomInstCo con ind cos) = mkAxiomInstCo con ind $! map go cos-    go (UnivCo p r t1 t2)    = (((mkUnivCo $! go_prov p) $! r) $!-                                (go_ty t1)) $! (go_ty t2)-    go (SymCo co)            = mkSymCo $! (go co)-    go (TransCo co1 co2)     = (mkTransCo $! (go co1)) $! (go co2)-    go (NthCo r d co)        = mkNthCo r d $! (go co)-    go (LRCo lr co)          = mkLRCo lr $! (go co)-    go (InstCo co arg)       = (mkInstCo $! (go co)) $! go arg-    go (KindCo co)           = mkKindCo $! (go co)-    go (SubCo co)            = mkSubCo $! (go co)-    go (AxiomRuleCo c cs)    = let cs1 = map go cs-                                in cs1 `seqList` AxiomRuleCo c cs1-    go (HoleCo h)            = HoleCo $! go_hole h--    go_prov UnsafeCoerceProv     = UnsafeCoerceProv-    go_prov (PhantomProv kco)    = PhantomProv (go kco)-    go_prov (ProofIrrelProv kco) = ProofIrrelProv (go kco)-    go_prov p@(PluginProv _)     = p--    -- See Note [Substituting in a coercion hole]-    go_hole h@(CoercionHole { ch_co_var = cv })-      = h { ch_co_var = updateVarType go_ty cv }--substForAllCoBndr :: TCvSubst -> TyCoVar -> KindCoercion-                  -> (TCvSubst, TyCoVar, Coercion)-substForAllCoBndr subst-  = substForAllCoBndrUsing False (substCo subst) subst---- | Like 'substForAllCoBndr', but disables sanity checks.--- The problems that the sanity checks in substCo catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substCoUnchecked to--- substCo and remove this function. Please don't use in new code.-substForAllCoBndrUnchecked :: TCvSubst -> TyCoVar -> KindCoercion-                           -> (TCvSubst, TyCoVar, Coercion)-substForAllCoBndrUnchecked subst-  = substForAllCoBndrUsing False (substCoUnchecked subst) subst---- See Note [Sym and ForAllCo]-substForAllCoBndrUsing :: Bool  -- apply sym to binder?-                       -> (Coercion -> Coercion)  -- transformation to kind co-                       -> TCvSubst -> TyCoVar -> KindCoercion-                       -> (TCvSubst, TyCoVar, KindCoercion)-substForAllCoBndrUsing sym sco subst old_var-  | isTyVar old_var = substForAllCoTyVarBndrUsing sym sco subst old_var-  | otherwise       = substForAllCoCoVarBndrUsing sym sco subst old_var--substForAllCoTyVarBndrUsing :: Bool  -- apply sym to binder?-                            -> (Coercion -> Coercion)  -- transformation to kind co-                            -> TCvSubst -> TyVar -> KindCoercion-                            -> (TCvSubst, TyVar, KindCoercion)-substForAllCoTyVarBndrUsing sym sco (TCvSubst in_scope tenv cenv) old_var old_kind_co-  = ASSERT( isTyVar old_var )-    ( TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv-    , new_var, new_kind_co )-  where-    new_env | no_change && not sym = delVarEnv tenv old_var-            | sym       = extendVarEnv tenv old_var $-                          TyVarTy new_var `CastTy` new_kind_co-            | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)--    no_kind_change = noFreeVarsOfCo old_kind_co-    no_change = no_kind_change && (new_var == old_var)--    new_kind_co | no_kind_change = old_kind_co-                | otherwise      = sco old_kind_co--    Pair new_ki1 _ = coercionKind new_kind_co-    -- We could do substitution to (tyVarKind old_var). We don't do so because-    -- we already substituted new_kind_co, which contains the kind information-    -- we want. We don't want to do substitution once more. Also, in most cases,-    -- new_kind_co is a Refl, in which case coercionKind is really fast.--    new_var  = uniqAway in_scope (setTyVarKind old_var new_ki1)--substForAllCoCoVarBndrUsing :: Bool  -- apply sym to binder?-                            -> (Coercion -> Coercion)  -- transformation to kind co-                            -> TCvSubst -> CoVar -> KindCoercion-                            -> (TCvSubst, CoVar, KindCoercion)-substForAllCoCoVarBndrUsing sym sco (TCvSubst in_scope tenv cenv)-                            old_var old_kind_co-  = ASSERT( isCoVar old_var )-    ( TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv-    , new_var, new_kind_co )-  where-    new_cenv | no_change && not sym = delVarEnv cenv old_var-             | otherwise = extendVarEnv cenv old_var (mkCoVarCo new_var)--    no_kind_change = noFreeVarsOfCo old_kind_co-    no_change = no_kind_change && (new_var == old_var)--    new_kind_co | no_kind_change = old_kind_co-                | otherwise      = sco old_kind_co--    Pair h1 h2 = coercionKind new_kind_co--    new_var       = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type-    new_var_type  | sym       = h2-                  | otherwise = h1--substCoVar :: TCvSubst -> CoVar -> Coercion-substCoVar (TCvSubst _ _ cenv) cv-  = case lookupVarEnv cenv cv of-      Just co -> co-      Nothing -> CoVarCo cv--substCoVars :: TCvSubst -> [CoVar] -> [Coercion]-substCoVars subst cvs = map (substCoVar subst) cvs--lookupCoVar :: TCvSubst -> Var -> Maybe Coercion-lookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v--substTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar)-substTyVarBndr = substTyVarBndrUsing substTy--substTyVarBndrs :: HasCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])-substTyVarBndrs = mapAccumL substTyVarBndr--substVarBndr :: HasCallStack => TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)-substVarBndr = substVarBndrUsing substTy--substVarBndrs :: HasCallStack => TCvSubst -> [TyCoVar] -> (TCvSubst, [TyCoVar])-substVarBndrs = mapAccumL substVarBndr--substCoVarBndr :: HasCallStack => TCvSubst -> CoVar -> (TCvSubst, CoVar)-substCoVarBndr = substCoVarBndrUsing substTy---- | Like 'substVarBndr', but disables sanity checks.--- The problems that the sanity checks in substTy catch are described in--- Note [The substitution invariant].--- The goal of #11371 is to migrate all the calls of substTyUnchecked to--- substTy and remove this function. Please don't use in new code.-substVarBndrUnchecked :: TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)-substVarBndrUnchecked = substVarBndrUsing substTyUnchecked--substVarBndrUsing :: (TCvSubst -> Type -> Type)-                  -> TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)-substVarBndrUsing subst_fn subst v-  | isTyVar v = substTyVarBndrUsing subst_fn subst v-  | otherwise = substCoVarBndrUsing subst_fn subst v---- | Substitute a tyvar in a binding position, returning an--- extended subst and a new tyvar.--- Use the supplied function to substitute in the kind-substTyVarBndrUsing-  :: (TCvSubst -> Type -> Type)  -- ^ Use this to substitute in the kind-  -> TCvSubst -> TyVar -> (TCvSubst, TyVar)-substTyVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var-  = 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-    new_env | no_change = delVarEnv tenv old_var-            | otherwise = extendVarEnv tenv old_var (TyVarTy new_var)--    _no_capture = not (new_var `elemVarSet` tyCoVarsOfTypesSet tenv)-    -- Assertion check that we are not capturing something in the substitution--    old_ki = tyVarKind old_var-    no_kind_change = noFreeVarsOfType old_ki -- verify that kind is closed-    no_change = no_kind_change && (new_var == old_var)-        -- no_change means that the new_var is identical in-        -- all respects to the old_var (same unique, same kind)-        -- See Note [Extending the TCvSubst]-        ---        -- In that case we don't need to extend the substitution-        -- to map old to new.  But instead we must zap any-        -- current substitution for the variable. For example:-        --      (\x.e) with id_subst = [x |-> e']-        -- Here we must simply zap the substitution for x--    new_var | no_kind_change = uniqAway in_scope old_var-            | otherwise = uniqAway in_scope $-                          setTyVarKind old_var (subst_fn subst old_ki)-        -- The uniqAway part makes sure the new variable is not already in scope---- | Substitute a covar in a binding position, returning an--- extended subst and a new covar.--- Use the supplied function to substitute in the kind-substCoVarBndrUsing-  :: (TCvSubst -> Type -> Type)-  -> TCvSubst -> CoVar -> (TCvSubst, CoVar)-substCoVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var-  = ASSERT( isCoVar old_var )-    (TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv, new_var)-  where-    new_co         = mkCoVarCo new_var-    no_kind_change = noFreeVarsOfTypes [t1, t2]-    no_change      = new_var == old_var && no_kind_change--    new_cenv | no_change = delVarEnv cenv old_var-             | otherwise = extendVarEnv cenv old_var new_co--    new_var = uniqAway in_scope subst_old_var-    subst_old_var = mkCoVar (varName old_var) new_var_type--    (_, _, t1, t2, role) = coVarKindsTypesRole old_var-    t1' = subst_fn subst t1-    t2' = subst_fn subst t2-    new_var_type = mkCoercionType role t1' t2'-                  -- It's important to do the substitution for coercions,-                  -- because they can have free type variables--cloneTyVarBndr :: TCvSubst -> TyVar -> Unique -> (TCvSubst, TyVar)-cloneTyVarBndr subst@(TCvSubst in_scope tv_env cv_env) tv uniq-  = ASSERT2( isTyVar tv, ppr tv )   -- I think it's only called on TyVars-    (TCvSubst (extendInScopeSet in_scope tv')-              (extendVarEnv tv_env tv (mkTyVarTy tv')) cv_env, tv')-  where-    old_ki = tyVarKind tv-    no_kind_change = noFreeVarsOfType old_ki -- verify that kind is closed--    tv1 | no_kind_change = tv-        | otherwise      = setTyVarKind tv (substTy subst old_ki)--    tv' = setVarUnique tv1 uniq--cloneTyVarBndrs :: TCvSubst -> [TyVar] -> UniqSupply -> (TCvSubst, [TyVar])-cloneTyVarBndrs subst []     _usupply = (subst, [])-cloneTyVarBndrs subst (t:ts)  usupply = (subst'', tv:tvs)-  where-    (uniq, usupply') = takeUniqFromSupply usupply-    (subst' , tv )   = cloneTyVarBndr subst t uniq-    (subst'', tvs)   = cloneTyVarBndrs subst' ts usupply'--{--%************************************************************************-%*                                                                      *-                   Pretty-printing types--       Defined very early because of debug printing in assertions-%*                                                                      *-%************************************************************************--@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is-defined to use this.  @pprParendType@ is the same, except it puts-parens around the type, except for the atomic cases.  @pprParendType@-works just by setting the initial context precedence very high.--Note that any function which pretty-prints a @Type@ first converts the @Type@-to an @IfaceType@. See Note [IfaceType and pretty-printing] in IfaceType.--See Note [Precedence in types] in BasicTypes.--}------------------------------------------------------------- When pretty-printing types, we convert to IfaceType,---   and pretty-print that.--- See Note [Pretty printing via IfaceSyn] in PprTyThing-----------------------------------------------------------pprType, pprParendType :: Type -> SDoc-pprType       = pprPrecType topPrec-pprParendType = pprPrecType appPrec--pprPrecType :: PprPrec -> Type -> SDoc-pprPrecType = pprPrecTypeX emptyTidyEnv--pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc-pprPrecTypeX env prec ty-  = getPprStyle $ \sty ->-    if debugStyle sty           -- Use debugPprType when in-    then debug_ppr_ty prec ty   -- when in debug-style-    else pprPrecIfaceType prec (tidyToIfaceTypeStyX env ty sty)-    -- NB: debug-style is used for -dppr-debug-    --     dump-style  is used for -ddump-tc-trace etc--pprTyLit :: TyLit -> SDoc-pprTyLit = pprIfaceTyLit . toIfaceTyLit--pprKind, pprParendKind :: Kind -> SDoc-pprKind       = pprType-pprParendKind = pprParendType--tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType-tidyToIfaceTypeStyX env ty sty-  | userStyle sty = tidyToIfaceTypeX env ty-  | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty-     -- in latter case, don't tidy, as we'll be printing uniques.--tidyToIfaceType :: Type -> IfaceType-tidyToIfaceType = tidyToIfaceTypeX emptyTidyEnv--tidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType--- It's vital to tidy before converting to an IfaceType--- or nested binders will become indistinguishable!------ Also for the free type variables, tell toIfaceTypeX to--- leave them as IfaceFreeTyVar.  This is super-important--- for debug printing.-tidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty)-  where-    env'      = tidyFreeTyCoVars env free_tcvs-    free_tcvs = tyCoVarsOfTypeWellScoped ty---------------pprCo, pprParendCo :: Coercion -> SDoc-pprCo       co = getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty)-pprParendCo co = getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty)--tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion-tidyToIfaceCoSty co sty-  | userStyle sty = tidyToIfaceCo co-  | otherwise     = toIfaceCoercionX (tyCoVarsOfCo co) co-     -- in latter case, don't tidy, as we'll be printing uniques.--tidyToIfaceCo :: Coercion -> IfaceCoercion--- It's vital to tidy before converting to an IfaceType--- or nested binders will become indistinguishable!------ Also for the free type variables, tell toIfaceCoercionX to--- leave them as IfaceFreeCoVar.  This is super-important--- for debug printing.-tidyToIfaceCo co = toIfaceCoercionX (mkVarSet free_tcvs) (tidyCo env co)-  where-    env       = tidyFreeTyCoVars emptyTidyEnv free_tcvs-    free_tcvs = scopedSort $ tyCoVarsOfCoList co--------------pprClassPred :: Class -> [Type] -> SDoc-pprClassPred clas tys = pprTypeApp (classTyCon clas) tys---------------pprTheta :: ThetaType -> SDoc-pprTheta = pprIfaceContext topPrec . map tidyToIfaceType--pprParendTheta :: ThetaType -> SDoc-pprParendTheta = pprIfaceContext appPrec . map tidyToIfaceType--pprThetaArrowTy :: ThetaType -> SDoc-pprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType---------------------instance Outputable Type where-    ppr ty = pprType ty--instance Outputable TyLit where-   ppr = pprTyLit---------------------pprSigmaType :: Type -> SDoc-pprSigmaType = pprIfaceSigmaType ShowForAllWhen . tidyToIfaceType--pprForAll :: [TyCoVarBinder] -> SDoc-pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)---- | Print a user-level forall; see Note [When to print foralls]-pprUserForAll :: [TyCoVarBinder] -> SDoc-pprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr--pprTCvBndrs :: [TyCoVarBinder] -> SDoc-pprTCvBndrs tvs = sep (map pprTCvBndr tvs)--pprTCvBndr :: TyCoVarBinder -> SDoc-pprTCvBndr = pprTyVar . binderVar--pprTyVars :: [TyVar] -> SDoc-pprTyVars tvs = sep (map pprTyVar tvs)--pprTyVar :: TyVar -> SDoc--- Print a type variable binder with its kind (but not if *)--- Here we do not go via IfaceType, because the duplication with--- pprIfaceTvBndr is minimal, and the loss of uniques etc in--- debug printing is disastrous-pprTyVar tv-  | isLiftedTypeKind kind = ppr tv-  | otherwise             = parens (ppr tv <+> dcolon <+> ppr kind)-  where-    kind = tyVarKind tv--instance Outputable TyCoBinder where-  ppr (Anon af ty) = ppr af <+> ppr ty-  ppr (Named (Bndr v Required))  = ppr v-  ppr (Named (Bndr v Specified)) = char '@' <> ppr v-  ppr (Named (Bndr v Inferred))  = braces (ppr v)--------------------instance Outputable Coercion where -- defined here to avoid orphans-  ppr = pprCo--debugPprType :: Type -> SDoc--- ^ debugPprType is a simple pretty printer that prints a type--- without going through IfaceType.  It does not format as prettily--- as the normal route, but it's much more direct, and that can--- be useful for debugging.  E.g. with -dppr-debug it prints the--- kind on type-variable /occurrences/ which the normal route--- fundamentally cannot do.-debugPprType ty = debug_ppr_ty topPrec ty--debug_ppr_ty :: PprPrec -> Type -> SDoc-debug_ppr_ty _ (LitTy l)-  = ppr l--debug_ppr_ty _ (TyVarTy tv)-  = ppr tv  -- With -dppr-debug we get (tv :: kind)--debug_ppr_ty prec (FunTy { ft_af = af, ft_arg = arg, ft_res = res })-  = maybeParen prec funPrec $-    sep [debug_ppr_ty funPrec arg, arrow <+> debug_ppr_ty prec res]-  where-    arrow = case af of-              VisArg   -> text "->"-              InvisArg -> text "=>"--debug_ppr_ty prec (TyConApp tc tys)-  | null tys  = ppr tc-  | otherwise = maybeParen prec appPrec $-                hang (ppr tc) 2 (sep (map (debug_ppr_ty appPrec) tys))--debug_ppr_ty _ (AppTy t1 t2)-  = hang (debug_ppr_ty appPrec t1)  -- Print parens so we see ((a b) c)-       2 (debug_ppr_ty appPrec t2)  -- so that we can distinguish-                                    -- TyConApp from AppTy--debug_ppr_ty prec (CastTy ty co)-  = maybeParen prec topPrec $-    hang (debug_ppr_ty topPrec ty)-       2 (text "|>" <+> ppr co)--debug_ppr_ty _ (CoercionTy co)-  = parens (text "CO" <+> ppr co)--debug_ppr_ty prec ty@(ForAllTy {})-  | (tvs, body) <- split ty-  = maybeParen prec funPrec $-    hang (text "forall" <+> fsep (map ppr tvs) <> dot)-         -- The (map ppr tvs) will print kind-annotated-         -- tvs, because we are (usually) in debug-style-       2 (ppr body)-  where-    split ty | ForAllTy tv ty' <- ty-             , (tvs, body) <- split ty'-             = (tv:tvs, body)-             | otherwise-             = ([], ty)--{--Note [When to print foralls]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Mostly we want to print top-level foralls when (and only when) the user specifies--fprint-explicit-foralls.  But when kind polymorphism is at work, that suppresses-too much information; see #9018.--So I'm trying out this rule: print explicit foralls if-  a) User specifies -fprint-explicit-foralls, or-  b) Any of the quantified type variables has a kind-     that mentions a kind variable--This catches common situations, such as a type siguature-     f :: m a-which means-      f :: forall k. forall (m :: k->*) (a :: k). m a-We really want to see both the "forall k" and the kind signatures-on m and a.  The latter comes from pprTCvBndr.--Note [Infix type variables]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-With TypeOperators you can say--   f :: (a ~> b) -> b--and the (~>) is considered a type variable.  However, the type-pretty-printer in this module will just see (a ~> b) as--   App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")--So it'll print the type in prefix form.  To avoid confusion we must-remember to parenthesise the operator, thus--   (~>) a b -> b--See #2766.--}--pprDataCons :: TyCon -> SDoc-pprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons-  where-    sepWithVBars [] = empty-    sepWithVBars docs = sep (punctuate (space <> vbar) docs)--pprDataConWithArgs :: DataCon -> SDoc-pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]-  where-    (_univ_tvs, _ex_tvs, _eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc-    user_bndrs = dataConUserTyVarBinders dc-    forAllDoc  = pprUserForAll user_bndrs-    thetaDoc   = pprThetaArrowTy theta-    argsDoc    = hsep (fmap pprParendType arg_tys)---pprTypeApp :: TyCon -> [Type] -> SDoc-pprTypeApp tc tys-  = pprIfaceTypeApp topPrec (toIfaceTyCon tc)-                            (toIfaceTcArgs tc tys)-    -- TODO: toIfaceTcArgs seems rather wasteful here----------------------- | Display all kind information (with @-fprint-explicit-kinds@) when the--- provided 'Bool' argument is 'True'.--- See @Note [Kind arguments in error messages]@ in "TcErrors".-pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc-pprWithExplicitKindsWhen b-  = updSDocDynFlags $ \dflags ->-      if b then gopt_set dflags Opt_PrintExplicitKinds-           else dflags--{--%************************************************************************-%*                                                                      *-\subsection{TidyType}-%*                                                                      *-%************************************************************************--}---- | This tidies up a type for printing in an error message, or in--- an interface file.------ It doesn't change the uniques at all, just the print names.-tidyVarBndrs :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])-tidyVarBndrs tidy_env tvs-  = mapAccumL tidyVarBndr (avoidNameClashes tvs tidy_env) tvs--tidyVarBndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)-tidyVarBndr tidy_env@(occ_env, subst) var-  = case tidyOccName occ_env (getHelpfulOccName var) of-      (occ_env', occ') -> ((occ_env', subst'), var')-        where-          subst' = extendVarEnv subst var var'-          var'   = setVarType (setVarName var name') type'-          type'  = tidyType tidy_env (varType var)-          name'  = tidyNameOcc name occ'-          name   = varName var--avoidNameClashes :: [TyCoVar] -> TidyEnv -> TidyEnv--- Seed the occ_env with clashes among the names, see--- Note [Tidying multiple names at once] in OccName-avoidNameClashes tvs (occ_env, subst)-  = (avoidClashesOccEnv occ_env occs, subst)-  where-    occs = map getHelpfulOccName tvs--getHelpfulOccName :: TyCoVar -> OccName--- A TcTyVar with a System Name is probably a--- unification variable; when we tidy them we give them a trailing--- "0" (or 1 etc) so that they don't take precedence for the--- un-modified name. Plus, indicating a unification variable in--- this way is a helpful clue for users-getHelpfulOccName tv-  | isSystemName name, isTcTyVar tv-  = mkTyVarOcc (occNameString occ ++ "0")-  | otherwise-  = occ-  where-   name = varName tv-   occ  = getOccName name--tidyTyCoVarBinder :: TidyEnv -> VarBndr TyCoVar vis-                  -> (TidyEnv, VarBndr TyCoVar vis)-tidyTyCoVarBinder tidy_env (Bndr tv vis)-  = (tidy_env', Bndr tv' vis)-  where-    (tidy_env', tv') = tidyVarBndr tidy_env tv--tidyTyCoVarBinders :: TidyEnv -> [VarBndr TyCoVar vis]-                   -> (TidyEnv, [VarBndr TyCoVar vis])-tidyTyCoVarBinders tidy_env tvbs-  = mapAccumL tidyTyCoVarBinder-              (avoidNameClashes (binderVars tvbs) tidy_env) tvbs------------------tidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv--- ^ Add the free 'TyVar's to the env in tidy form,--- so that we can tidy the type they are free in-tidyFreeTyCoVars (full_occ_env, var_env) tyvars-  = fst (tidyOpenTyCoVars (full_occ_env, var_env) tyvars)------------------tidyOpenTyCoVars :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])-tidyOpenTyCoVars env tyvars = mapAccumL tidyOpenTyCoVar env tyvars------------------tidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)--- ^ Treat a new 'TyCoVar' as a binder, and give it a fresh tidy name--- using the environment if one has not already been allocated. See--- also 'tidyVarBndr'-tidyOpenTyCoVar env@(_, subst) tyvar-  = case lookupVarEnv subst tyvar of-        Just tyvar' -> (env, tyvar')              -- Already substituted-        Nothing     ->-          let env' = tidyFreeTyCoVars env (tyCoVarsOfTypeList (tyVarKind tyvar))-          in tidyVarBndr env' tyvar  -- Treat it as a binder------------------tidyTyCoVarOcc :: TidyEnv -> TyCoVar -> TyCoVar-tidyTyCoVarOcc env@(_, subst) tv-  = case lookupVarEnv subst tv of-        Nothing  -> updateVarType (tidyType env) tv-        Just tv' -> tv'------------------tidyTypes :: TidyEnv -> [Type] -> [Type]-tidyTypes env tys = map (tidyType env) tys------------------tidyType :: TidyEnv -> Type -> Type-tidyType _   (LitTy n)             = LitTy n-tidyType env (TyVarTy tv)          = TyVarTy (tidyTyCoVarOcc env tv)-tidyType env (TyConApp tycon tys)  = let args = tidyTypes env tys-                                     in args `seqList` TyConApp tycon args-tidyType env (AppTy fun arg)       = (AppTy $! (tidyType env fun)) $! (tidyType env arg)-tidyType env ty@(FunTy _ arg res)  = let { !arg' = tidyType env arg-                                         ; !res' = tidyType env res }-                                     in ty { ft_arg = arg', ft_res = res' }-tidyType env (ty@(ForAllTy{}))     = mkForAllTys' (zip tvs' vis) $! tidyType env' body_ty-  where-    (tvs, vis, body_ty) = splitForAllTys' ty-    (env', tvs') = tidyVarBndrs env tvs-tidyType env (CastTy ty co)       = (CastTy $! tidyType env ty) $! (tidyCo env co)-tidyType env (CoercionTy co)      = CoercionTy $! (tidyCo env co)----- The following two functions differ from mkForAllTys and splitForAllTys in that--- they expect/preserve the ArgFlag argument. Thes belong to types/Type.hs, but--- how should they be named?-mkForAllTys' :: [(TyCoVar, ArgFlag)] -> Type -> Type-mkForAllTys' tvvs ty = foldr strictMkForAllTy ty tvvs-  where-    strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((Bndr $! tv) $! vis)) $! ty--splitForAllTys' :: Type -> ([TyCoVar], [ArgFlag], Type)-splitForAllTys' ty = go ty [] []-  where-    go (ForAllTy (Bndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss)-    go ty                          tvs viss = (reverse tvs, reverse viss, ty)--------------------- | Grabs the free type variables, tidies them--- and then uses 'tidyType' to work over the type itself-tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])-tidyOpenTypes env tys-  = (env', tidyTypes (trimmed_occ_env, var_env) tys)-  where-    (env'@(_, var_env), tvs') = tidyOpenTyCoVars env $-                                tyCoVarsOfTypesWellScoped tys-    trimmed_occ_env = initTidyOccEnv (map getOccName tvs')-      -- The idea here was that we restrict the new TidyEnv to the-      -- _free_ vars of the types, so that we don't gratuitously rename-      -- the _bound_ variables of the types.------------------tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)-tidyOpenType env ty = let (env', [ty']) = tidyOpenTypes env [ty] in-                      (env', ty')-------------------- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)-tidyTopType :: Type -> Type-tidyTopType ty = tidyType emptyTidyEnv ty------------------tidyOpenKind :: TidyEnv -> Kind -> (TidyEnv, Kind)-tidyOpenKind = tidyOpenType--tidyKind :: TidyEnv -> Kind -> Kind-tidyKind = tidyType-------------------tidyCo :: TidyEnv -> Coercion -> Coercion-tidyCo env@(_, subst) co-  = go co-  where-    go_mco MRefl    = MRefl-    go_mco (MCo co) = MCo (go co)--    go (Refl ty)             = Refl (tidyType env ty)-    go (GRefl r ty mco)      = GRefl r (tidyType env ty) $! go_mco mco-    go (TyConAppCo r tc cos) = let args = map go cos-                               in args `seqList` TyConAppCo r tc args-    go (AppCo co1 co2)       = (AppCo $! go co1) $! go co2-    go (ForAllCo tv h co)    = ((ForAllCo $! tvp) $! (go h)) $! (tidyCo envp co)-                               where (envp, tvp) = tidyVarBndr env tv-            -- the case above duplicates a bit of work in tidying h and the kind-            -- of tv. But the alternative is to use coercionKind, which seems worse.-    go (FunCo r co1 co2)     = (FunCo r $! go co1) $! go co2-    go (CoVarCo cv)          = case lookupVarEnv subst cv of-                                 Nothing  -> CoVarCo cv-                                 Just cv' -> CoVarCo cv'-    go (HoleCo h)            = HoleCo h-    go (AxiomInstCo con ind cos) = let args = map go cos-                               in  args `seqList` AxiomInstCo con ind args-    go (UnivCo p r t1 t2)    = (((UnivCo $! (go_prov p)) $! r) $!-                                tidyType env t1) $! tidyType env t2-    go (SymCo co)            = SymCo $! go co-    go (TransCo co1 co2)     = (TransCo $! go co1) $! go co2-    go (NthCo r d co)        = NthCo r d $! go co-    go (LRCo lr co)          = LRCo lr $! go co-    go (InstCo co ty)        = (InstCo $! go co) $! go ty-    go (KindCo co)           = KindCo $! go co-    go (SubCo co)            = SubCo $! go co-    go (AxiomRuleCo ax cos)  = let cos1 = tidyCos env cos-                               in cos1 `seqList` AxiomRuleCo ax cos1--    go_prov UnsafeCoerceProv    = UnsafeCoerceProv-    go_prov (PhantomProv co)    = PhantomProv (go co)-    go_prov (ProofIrrelProv co) = ProofIrrelProv (go co)-    go_prov p@(PluginProv _)    = p--tidyCos :: TidyEnv -> [Coercion] -> [Coercion]-tidyCos env = map (tidyCo env)+  TyCoPpr  imports TyCoRep+  TyCoFVs  imports TyCoRep+  TyCoSubst imports TyCoRep, TyCoFVs, TyCoPpr+  TyCoTidy imports TyCoRep, TyCoFVs+  TysPrim  imports TyCoRep ( including mkTyConTy )+  Kind     imports TysPrim ( mainly for primitive kinds )+  Type     imports Kind+  Coercion imports Type+-}++-- We expose the relevant stuff from this module via the Type module+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE CPP, DeriveDataTypeable, MultiWayIf, PatternSynonyms, BangPatterns #-}++module TyCoRep (+        TyThing(..), tyThingCategory, pprTyThingCategory, pprShortTyThing,++        -- * Types+        Type( TyVarTy, AppTy, TyConApp, ForAllTy+            , LitTy, CastTy, CoercionTy+            , FunTy, ft_arg, ft_res, ft_af+            ),  -- Export the type synonym FunTy too++        TyLit(..),+        KindOrType, Kind,+        KnotTied,+        PredType, ThetaType,      -- Synonyms+        ArgFlag(..), AnonArgFlag(..), ForallVisFlag(..),++        -- * Coercions+        Coercion(..),+        UnivCoProvenance(..),+        CoercionHole(..), coHoleCoVar, setCoHoleCoVar,+        CoercionN, CoercionR, CoercionP, KindCoercion,+        MCoercion(..), MCoercionR, MCoercionN,++        -- * Functions over types+        mkTyConTy, mkTyVarTy, mkTyVarTys,+        mkTyCoVarTy, mkTyCoVarTys,+        mkFunTy, mkVisFunTy, mkInvisFunTy, mkVisFunTys, mkInvisFunTys,+        mkForAllTy, mkForAllTys,+        mkPiTy, mkPiTys,++        kindRep_maybe, kindRep,+        isLiftedTypeKind, isUnliftedTypeKind,+        isLiftedRuntimeRep, isUnliftedRuntimeRep,+        isRuntimeRepTy, isRuntimeRepVar,+        sameVis,++        -- * Functions over binders+        TyCoBinder(..), TyCoVarBinder, TyBinder,+        binderVar, binderVars, binderType, binderArgFlag,+        delBinderVar,+        isInvisibleArgFlag, isVisibleArgFlag,+        isInvisibleBinder, isVisibleBinder,+        isTyBinder, isNamedBinder,++        -- * Functions over coercions+        pickLR,++        -- * Sizes+        typeSize, coercionSize, provSize+    ) where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} Type( coreView )+import {-# SOURCE #-} TyCoPpr ( pprType, pprCo, pprTyLit )++   -- Transitively pulls in a LOT of stuff, better to break the loop++import {-# SOURCE #-} ConLike ( ConLike(..), conLikeName )++-- friends:+import IfaceType+import Var+import VarSet+import Name hiding ( varName )+import TyCon+import CoAxiom++-- others+import BasicTypes ( LeftOrRight(..), pickLR )+import PrelNames+import Outputable+import FastString+import Util++-- libraries+import qualified Data.Data as Data hiding ( TyCon )+import Data.IORef ( IORef )   -- for CoercionHole++{-+%************************************************************************+%*                                                                      *+                        TyThing+%*                                                                      *+%************************************************************************++Despite the fact that DataCon has to be imported via a hi-boot route,+this module seems the right place for TyThing, because it's needed for+funTyCon and all the types in TysPrim.++It is also SOURCE-imported into Name.hs+++Note [ATyCon for classes]+~~~~~~~~~~~~~~~~~~~~~~~~~+Both classes and type constructors are represented in the type environment+as ATyCon.  You can tell the difference, and get to the class, with+   isClassTyCon :: TyCon -> Bool+   tyConClass_maybe :: TyCon -> Maybe Class+The Class and its associated TyCon have the same Name.+-}++-- | A global typecheckable-thing, essentially anything that has a name.+-- Not to be confused with a 'TcTyThing', which is also a typecheckable+-- thing but in the *local* context.  See 'TcEnv' for how to retrieve+-- a 'TyThing' given a 'Name'.+data TyThing+  = AnId     Id+  | AConLike ConLike+  | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]+  | ACoAxiom (CoAxiom Branched)++instance Outputable TyThing where+  ppr = pprShortTyThing++instance NamedThing TyThing where       -- Can't put this with the type+  getName (AnId id)     = getName id    -- decl, because the DataCon instance+  getName (ATyCon tc)   = getName tc    -- isn't visible there+  getName (ACoAxiom cc) = getName cc+  getName (AConLike cl) = conLikeName cl++pprShortTyThing :: TyThing -> SDoc+-- c.f. PprTyThing.pprTyThing, which prints all the details+pprShortTyThing thing+  = pprTyThingCategory thing <+> quotes (ppr (getName thing))++pprTyThingCategory :: TyThing -> SDoc+pprTyThingCategory = text . capitalise . tyThingCategory++tyThingCategory :: TyThing -> String+tyThingCategory (ATyCon tc)+  | isClassTyCon tc = "class"+  | otherwise       = "type constructor"+tyThingCategory (ACoAxiom _) = "coercion axiom"+tyThingCategory (AnId   _)   = "identifier"+tyThingCategory (AConLike (RealDataCon _)) = "data constructor"+tyThingCategory (AConLike (PatSynCon _))  = "pattern synonym"+++{- **********************************************************************+*                                                                       *+                        Type+*                                                                       *+********************************************************************** -}++-- | The key representation of types within the compiler++type KindOrType = Type -- See Note [Arguments to type constructors]++-- | The key type representing kinds in the compiler.+type Kind = Type++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data Type+  -- See Note [Non-trivial definitional equality]+  = TyVarTy Var -- ^ Vanilla type or kind variable (*never* a coercion variable)++  | AppTy+        Type+        Type            -- ^ Type application to something other than a 'TyCon'. Parameters:+                        --+                        --  1) Function: must /not/ be a 'TyConApp' or 'CastTy',+                        --     must be another 'AppTy', or 'TyVarTy'+                        --     See Note [Respecting definitional equality] (EQ1) about the+                        --     no 'CastTy' requirement+                        --+                        --  2) Argument type++  | TyConApp+        TyCon+        [KindOrType]    -- ^ Application of a 'TyCon', including newtypes /and/ synonyms.+                        -- Invariant: saturated applications of 'FunTyCon' must+                        -- use 'FunTy' and saturated synonyms must use their own+                        -- constructors. However, /unsaturated/ 'FunTyCon's+                        -- do appear as 'TyConApp's.+                        -- Parameters:+                        --+                        -- 1) Type constructor being applied to.+                        --+                        -- 2) Type arguments. Might not have enough type arguments+                        --    here to saturate the constructor.+                        --    Even type synonyms are not necessarily saturated;+                        --    for example unsaturated type synonyms+                        --    can appear as the right hand side of a type synonym.++  | ForAllTy+        {-# UNPACK #-} !TyCoVarBinder+        Type            -- ^ A Π type.++  | FunTy      -- ^ t1 -> t2   Very common, so an important special case+                -- See Note [Function types]+     { ft_af  :: AnonArgFlag  -- Is this (->) or (=>)?+     , ft_arg :: Type           -- Argument type+     , ft_res :: Type }         -- Result type++  | LitTy TyLit     -- ^ Type literals are similar to type constructors.++  | CastTy+        Type+        KindCoercion  -- ^ A kind cast. The coercion is always nominal.+                      -- INVARIANT: The cast is never refl.+                      -- INVARIANT: The Type is not a CastTy (use TransCo instead)+                      -- See Note [Respecting definitional equality] (EQ2) and (EQ3)++  | CoercionTy+        Coercion    -- ^ Injection of a Coercion into a type+                    -- This should only ever be used in the RHS of an AppTy,+                    -- in the list of a TyConApp, when applying a promoted+                    -- GADT data constructor++  deriving Data.Data++instance Outputable Type where+  ppr = pprType++-- NOTE:  Other parts of the code assume that type literals do not contain+-- types or type variables.+data TyLit+  = NumTyLit Integer+  | StrTyLit FastString+  deriving (Eq, Ord, Data.Data)++instance Outputable TyLit where+   ppr = pprTyLit++{- Note [Function types]+~~~~~~~~~~~~~~~~~~~~~~~~+FFunTy is the constructor for a function type.  Lots of things to say+about it!++* FFunTy is the data constructor, meaning "full function type".++* The function type constructor (->) has kind+     (->) :: forall r1 r2. TYPE r1 -> TYPE r2 -> Type LiftedRep+  mkTyConApp ensure that we convert a saturated application+    TyConApp (->) [r1,r2,t1,t2] into FunTy t1 t2+  dropping the 'r1' and 'r2' arguments; they are easily recovered+  from 't1' and 't2'.++* The ft_af field says whether or not this is an invisible argument+     VisArg:   t1 -> t2    Ordinary function type+     InvisArg: t1 => t2    t1 is guaranteed to be a predicate type,+                           i.e. t1 :: Constraint+  See Note [Types for coercions, predicates, and evidence]++  This visibility info makes no difference in Core; it matters+  only when we regard the type as a Haskell source type.++* FunTy is a (unidirectional) pattern synonym that allows+  positional pattern matching (FunTy arg res), ignoring the+  ArgFlag.+-}++{- -----------------------+      Commented out until the pattern match+      checker can handle it; see #16185++      For now we use the CPP macro #define FunTy FFunTy _+      (see HsVersions.h) to allow pattern matching on a+      (positional) FunTy constructor.++{-# COMPLETE FunTy, TyVarTy, AppTy, TyConApp+           , ForAllTy, LitTy, CastTy, CoercionTy :: Type #-}++-- | 'FunTy' is a (uni-directional) pattern synonym for the common+-- case where we want to match on the argument/result type, but+-- ignoring the AnonArgFlag+pattern FunTy :: Type -> Type -> Type+pattern FunTy arg res <- FFunTy { ft_arg = arg, ft_res = res }++       End of commented out block+---------------------------------- -}++{- Note [Types for coercions, predicates, and evidence]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We treat differently:++  (a) Predicate types+        Test: isPredTy+        Binders: DictIds+        Kind: Constraint+        Examples: (Eq a), and (a ~ b)++  (b) Coercion types are primitive, unboxed equalities+        Test: isCoVarTy+        Binders: CoVars (can appear in coercions)+        Kind: TYPE (TupleRep [])+        Examples: (t1 ~# t2) or (t1 ~R# t2)++  (c) Evidence types is the type of evidence manipulated by+      the type constraint solver.+        Test: isEvVarType+        Binders: EvVars+        Kind: Constraint or TYPE (TupleRep [])+        Examples: all coercion types and predicate types++Coercion types and predicate types are mutually exclusive,+but evidence types are a superset of both.++When treated as a user type,++  - Predicates (of kind Constraint) are invisible and are+    implicitly instantiated++  - Coercion types, and non-pred evidence types (i.e. not+    of kind Constrain), are just regular old types, are+    visible, and are not implicitly instantiated.++In a FunTy { ft_af = InvisArg }, the argument type is always+a Predicate type.++Note [Constraints in kinds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Do we allow a type constructor to have a kind like+   S :: Eq a => a -> Type++No, we do not.  Doing so would mean would need a TyConApp like+   S @k @(d :: Eq k) (ty :: k)+ and we have no way to build, or decompose, evidence like+ (d :: Eq k) at the type level.++But we admit one exception: equality.  We /do/ allow, say,+   MkT :: (a ~ b) => a -> b -> Type a b++Why?  Because we can, without much difficulty.  Moreover+we can promote a GADT data constructor (see TyCon+Note [Promoted data constructors]), like+  data GT a b where+    MkGT : a -> a -> GT a a+so programmers might reasonably expect to be able to+promote MkT as well.++How does this work?++* In TcValidity.checkConstraintsOK we reject kinds that+  have constraints other than (a~b) and (a~~b).++* In Inst.tcInstInvisibleTyBinder we instantiate a call+  of MkT by emitting+     [W] co :: alpha ~# beta+  and producing the elaborated term+     MkT @alpha @beta (Eq# alpha beta co)+  We don't generate a boxed "Wanted"; we generate only a+  regular old /unboxed/ primitive-equality Wanted, and build+  the box on the spot.++* How can we get such a MkT?  By promoting a GADT-style data+  constructor+     data T a b where+       MkT :: (a~b) => a -> b -> T a b+  See DataCon.mkPromotedDataCon+  and Note [Promoted data constructors] in TyCon++* We support both homogeneous (~) and heterogeneous (~~)+  equality.  (See Note [The equality types story]+  in TysPrim for a primer on these equality types.)++* How do we prevent a MkT having an illegal constraint like+  Eq a?  We check for this at use-sites; see TcHsType.tcTyVar,+  specifically dc_theta_illegal_constraint.++* Notice that nothing special happens if+    K :: (a ~# b) => blah+  because (a ~# b) is not a predicate type, and is never+  implicitly instantiated. (Mind you, it's not clear how you+  could creates a type constructor with such a kind.) See+  Note [Types for coercions, predicates, and evidence]++* The existence of promoted MkT with an equality-constraint+  argument is the (only) reason that the AnonTCB constructor+  of TyConBndrVis carries an AnonArgFlag (VisArg/InvisArg).+  For example, when we promote the data constructor+     MkT :: forall a b. (a~b) => a -> b -> T a b+  we get a PromotedDataCon with tyConBinders+      Bndr (a :: Type)  (NamedTCB Inferred)+      Bndr (b :: Type)  (NamedTCB Inferred)+      Bndr (_ :: a ~ b) (AnonTCB InvisArg)+      Bndr (_ :: a)     (AnonTCB VisArg))+      Bndr (_ :: b)     (AnonTCB VisArg))++* One might reasonably wonder who *unpacks* these boxes once they are+  made. After all, there is no type-level `case` construct. The+  surprising answer is that no one ever does. Instead, if a GADT+  constructor is used on the left-hand side of a type family equation,+  that occurrence forces GHC to unify the types in question. For+  example:++  data G a where+    MkG :: G Bool++  type family F (x :: G a) :: a where+    F MkG = False++  When checking the LHS `F MkG`, GHC sees the MkG constructor and then must+  unify F's implicit parameter `a` with Bool. This succeeds, making the equation++    F Bool (MkG @Bool <Bool>) = False++  Note that we never need unpack the coercion. This is because type+  family equations are *not* parametric in their kind variables. That+  is, we could have just said++  type family H (x :: G a) :: a where+    H _ = False++  The presence of False on the RHS also forces `a` to become Bool,+  giving us++    H Bool _ = False++  The fact that any of this works stems from the lack of phase+  separation between types and kinds (unlike the very present phase+  separation between terms and types).++  Once we have the ability to pattern-match on types below top-level,+  this will no longer cut it, but it seems fine for now.+++Note [Arguments to type constructors]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Because of kind polymorphism, in addition to type application we now+have kind instantiation. We reuse the same notations to do so.++For example:++  Just (* -> *) Maybe+  Right * Nat Zero++are represented by:++  TyConApp (PromotedDataCon Just) [* -> *, Maybe]+  TyConApp (PromotedDataCon Right) [*, Nat, (PromotedDataCon Zero)]++Important note: Nat is used as a *kind* and not as a type. This can be+confusing, since type-level Nat and kind-level Nat are identical. We+use the kind of (PromotedDataCon Right) to know if its arguments are+kinds or types.++This kind instantiation only happens in TyConApp currently.++Note [Non-trivial definitional equality]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Is Int |> <*> the same as Int? YES! In order to reduce headaches,+we decide that any reflexive casts in types are just ignored.+(Indeed they must be. See Note [Respecting definitional equality].)+More generally, the `eqType` function, which defines Core's type equality+relation, ignores casts and coercion arguments, as long as the+two types have the same kind. This allows us to be a little sloppier+in keeping track of coercions, which is a good thing. It also means+that eqType does not depend on eqCoercion, which is also a good thing.++Why is this sensible? That is, why is something different than α-equivalence+appropriate for the implementation of eqType?++Anything smaller than ~ and homogeneous is an appropriate definition for+equality. The type safety of FC depends only on ~. Let's say η : τ ~ σ. Any+expression of type τ can be transmuted to one of type σ at any point by+casting. The same is true of expressions of type σ. So in some sense, τ and σ+are interchangeable.++But let's be more precise. If we examine the typing rules of FC (say, those in+https://cs.brynmawr.edu/~rae/papers/2015/equalities/equalities.pdf)+there are several places where the same metavariable is used in two different+premises to a rule. (For example, see Ty_App.) There is an implicit equality+check here. What definition of equality should we use? By convention, we use+α-equivalence. Take any rule with one (or more) of these implicit equality+checks. Then there is an admissible rule that uses ~ instead of the implicit+check, adding in casts as appropriate.++The only problem here is that ~ is heterogeneous. To make the kinds work out+in the admissible rule that uses ~, it is necessary to homogenize the+coercions. That is, if we have η : (τ : κ1) ~ (σ : κ2), then we don't use η;+we use η |> kind η, which is homogeneous.++The effect of this all is that eqType, the implementation of the implicit+equality check, can use any homogeneous relation that is smaller than ~, as+those rules must also be admissible.++A more drawn out argument around all of this is presented in Section 7.2 of+Richard E's thesis (http://cs.brynmawr.edu/~rae/papers/2016/thesis/eisenberg-thesis.pdf).++What would go wrong if we insisted on the casts matching? See the beginning of+Section 8 in the unpublished paper above. Theoretically, nothing at all goes+wrong. But in practical terms, getting the coercions right proved to be+nightmarish. And types would explode: during kind-checking, we often produce+reflexive kind coercions. When we try to cast by these, mkCastTy just discards+them. But if we used an eqType that distinguished between Int and Int |> <*>,+then we couldn't discard -- the output of kind-checking would be enormous,+and we would need enormous casts with lots of CoherenceCo's to straighten+them out.++Would anything go wrong if eqType respected type families? No, not at all. But+that makes eqType rather hard to implement.++Thus, the guideline for eqType is that it should be the largest+easy-to-implement relation that is still smaller than ~ and homogeneous. The+precise choice of relation is somewhat incidental, as long as the smart+constructors and destructors in Type respect whatever relation is chosen.++Another helpful principle with eqType is this:++ (EQ) If (t1 `eqType` t2) then I can replace t1 by t2 anywhere.++This principle also tells us that eqType must relate only types with the+same kinds.++Note [Respecting definitional equality]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note [Non-trivial definitional equality] introduces the property (EQ).+How is this upheld?++Any function that pattern matches on all the constructors will have to+consider the possibility of CastTy. Presumably, those functions will handle+CastTy appropriately and we'll be OK.++More dangerous are the splitXXX functions. Let's focus on splitTyConApp.+We don't want it to fail on (T a b c |> co). Happily, if we have+  (T a b c |> co) `eqType` (T d e f)+then co must be reflexive. Why? eqType checks that the kinds are equal, as+well as checking that (a `eqType` d), (b `eqType` e), and (c `eqType` f).+By the kind check, we know that (T a b c |> co) and (T d e f) have the same+kind. So the only way that co could be non-reflexive is for (T a b c) to have+a different kind than (T d e f). But because T's kind is closed (all tycon kinds+are closed), the only way for this to happen is that one of the arguments has+to differ, leading to a contradiction. Thus, co is reflexive.++Accordingly, by eliminating reflexive casts, splitTyConApp need not worry+about outermost casts to uphold (EQ). Eliminating reflexive casts is done+in mkCastTy.++Unforunately, that's not the end of the story. Consider comparing+  (T a b c)      =?       (T a b |> (co -> <Type>)) (c |> co)+These two types have the same kind (Type), but the left type is a TyConApp+while the right type is not. To handle this case, we say that the right-hand+type is ill-formed, requiring an AppTy never to have a casted TyConApp+on its left. It is easy enough to pull around the coercions to maintain+this invariant, as done in Type.mkAppTy. In the example above, trying to+form the right-hand type will instead yield (T a b (c |> co |> sym co) |> <Type>).+Both the casts there are reflexive and will be dropped. Huzzah.++This idea of pulling coercions to the right works for splitAppTy as well.++However, there is one hiccup: it's possible that a coercion doesn't relate two+Pi-types. For example, if we have @type family Fun a b where Fun a b = a -> b@,+then we might have (T :: Fun Type Type) and (T |> axFun) Int. That axFun can't+be pulled to the right. But we don't need to pull it: (T |> axFun) Int is not+`eqType` to any proper TyConApp -- thus, leaving it where it is doesn't violate+our (EQ) property.++Lastly, in order to detect reflexive casts reliably, we must make sure not+to have nested casts: we update (t |> co1 |> co2) to (t |> (co1 `TransCo` co2)).++In sum, in order to uphold (EQ), we need the following three invariants:++  (EQ1) No decomposable CastTy to the left of an AppTy, where a decomposable+        cast is one that relates either a FunTy to a FunTy or a+        ForAllTy to a ForAllTy.+  (EQ2) No reflexive casts in CastTy.+  (EQ3) No nested CastTys.+  (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body).+        See Note [Weird typing rule for ForAllTy] in Type.++These invariants are all documented above, in the declaration for Type.++Note [Unused coercion variable in ForAllTy]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have+  \(co:t1 ~ t2). e++What type should we give to this expression?+  (1) forall (co:t1 ~ t2) -> t+  (2) (t1 ~ t2) -> t++If co is used in t, (1) should be the right choice.+if co is not used in t, we would like to have (1) and (2) equivalent.++However, we want to keep eqType simple and don't want eqType (1) (2) to return+True in any case.++We decide to always construct (2) if co is not used in t.++Thus in mkLamType, we check whether the variable is a coercion+variable (of type (t1 ~# t2), and whether it is un-used in the+body. If so, it returns a FunTy instead of a ForAllTy.++There are cases we want to skip the check. For example, the check is+unnecessary when it is known from the context that the input variable+is a type variable.  In those cases, we use mkForAllTy.++-}++-- | A type labeled 'KnotTied' might have knot-tied tycons in it. See+-- Note [Type checking recursive type and class declarations] in+-- TcTyClsDecls+type KnotTied ty = ty++{- **********************************************************************+*                                                                       *+                  TyCoBinder and ArgFlag+*                                                                       *+********************************************************************** -}++-- | A 'TyCoBinder' represents an argument to a function. TyCoBinders can be+-- dependent ('Named') or nondependent ('Anon'). They may also be visible or+-- not. See Note [TyCoBinders]+data TyCoBinder+  = Named TyCoVarBinder    -- A type-lambda binder+  | Anon AnonArgFlag Type  -- A term-lambda binder. Type here can be CoercionTy.+                           -- Visibility is determined by the AnonArgFlag+  deriving Data.Data++instance Outputable TyCoBinder where+  ppr (Anon af ty) = ppr af <+> ppr ty+  ppr (Named (Bndr v Required))  = ppr v+  ppr (Named (Bndr v Specified)) = char '@' <> ppr v+  ppr (Named (Bndr v Inferred))  = braces (ppr v)+++-- | 'TyBinder' is like 'TyCoBinder', but there can only be 'TyVarBinder'+-- in the 'Named' field.+type TyBinder = TyCoBinder++-- | Remove the binder's variable from the set, if the binder has+-- a variable.+delBinderVar :: VarSet -> TyCoVarBinder -> VarSet+delBinderVar vars (Bndr tv _) = vars `delVarSet` tv++-- | Does this binder bind an invisible argument?+isInvisibleBinder :: TyCoBinder -> Bool+isInvisibleBinder (Named (Bndr _ vis)) = isInvisibleArgFlag vis+isInvisibleBinder (Anon InvisArg _)    = True+isInvisibleBinder (Anon VisArg   _)    = False++-- | Does this binder bind a visible argument?+isVisibleBinder :: TyCoBinder -> Bool+isVisibleBinder = not . isInvisibleBinder++isNamedBinder :: TyCoBinder -> Bool+isNamedBinder (Named {}) = True+isNamedBinder (Anon {})  = False++-- | If its a named binder, is the binder a tyvar?+-- Returns True for nondependent binder.+-- This check that we're really returning a *Ty*Binder (as opposed to a+-- coercion binder). That way, if/when we allow coercion quantification+-- in more places, we'll know we missed updating some function.+isTyBinder :: TyCoBinder -> Bool+isTyBinder (Named bnd) = isTyVarBinder bnd+isTyBinder _ = True++{- Note [TyCoBinders]+~~~~~~~~~~~~~~~~~~~+A ForAllTy contains a TyCoVarBinder.  But a type can be decomposed+to a telescope consisting of a [TyCoBinder]++A TyCoBinder represents the type of binders -- that is, the type of an+argument to a Pi-type. GHC Core currently supports two different+Pi-types:++ * A non-dependent function type,+   written with ->, e.g. ty1 -> ty2+   represented as FunTy ty1 ty2. These are+   lifted to Coercions with the corresponding FunCo.++ * A dependent compile-time-only polytype,+   written with forall, e.g.  forall (a:*). ty+   represented as ForAllTy (Bndr a v) ty++Both Pi-types classify terms/types that take an argument. In other+words, if `x` is either a function or a polytype, `x arg` makes sense+(for an appropriate `arg`).+++Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+* A ForAllTy (used for both types and kinds) contains a TyCoVarBinder.+  Each TyCoVarBinder+      Bndr a tvis+  is equipped with tvis::ArgFlag, which says whether or not arguments+  for this binder should be visible (explicit) in source Haskell.++* A TyCon contains a list of TyConBinders.  Each TyConBinder+      Bndr a cvis+  is equipped with cvis::TyConBndrVis, which says whether or not type+  and kind arguments for this TyCon should be visible (explicit) in+  source Haskell.++This table summarises the visibility rules:+---------------------------------------------------------------------------------------+|                                                      Occurrences look like this+|                             GHC displays type as     in Haskell source code+|--------------------------------------------------------------------------------------+| Bndr a tvis :: TyCoVarBinder, in the binder of ForAllTy for a term+|  tvis :: ArgFlag+|  tvis = Inferred:            f :: forall {a}. type    Arg not allowed:  f+                               f :: forall {co}. type   Arg not allowed:  f+|  tvis = Specified:           f :: forall a. type      Arg optional:     f  or  f @Int+|  tvis = Required:            T :: forall k -> type    Arg required:     T *+|    This last form is illegal in terms: See Note [No Required TyCoBinder in terms]+|+| Bndr k cvis :: TyConBinder, in the TyConBinders of a TyCon+|  cvis :: TyConBndrVis+|  cvis = AnonTCB:             T :: kind -> kind        Required:            T *+|  cvis = NamedTCB Inferred:   T :: forall {k}. kind    Arg not allowed:     T+|                              T :: forall {co}. kind   Arg not allowed:     T+|  cvis = NamedTCB Specified:  T :: forall k. kind      Arg not allowed[1]:  T+|  cvis = NamedTCB Required:   T :: forall k -> kind    Required:            T *+---------------------------------------------------------------------------------------++[1] In types, in the Specified case, it would make sense to allow+    optional kind applications, thus (T @*), but we have not+    yet implemented that++---- In term declarations ----++* Inferred.  Function defn, with no signature:  f1 x = x+  We infer f1 :: forall {a}. a -> a, with 'a' Inferred+  It's Inferred because it doesn't appear in any+  user-written signature for f1++* Specified.  Function defn, with signature (implicit forall):+     f2 :: a -> a; f2 x = x+  So f2 gets the type f2 :: forall a. a -> a, with 'a' Specified+  even though 'a' is not bound in the source code by an explicit forall++* Specified.  Function defn, with signature (explicit forall):+     f3 :: forall a. a -> a; f3 x = x+  So f3 gets the type f3 :: forall a. a -> a, with 'a' Specified++* Inferred/Specified.  Function signature with inferred kind polymorphism.+     f4 :: a b -> Int+  So 'f4' gets the type f4 :: forall {k} (a:k->*) (b:k). a b -> Int+  Here 'k' is Inferred (it's not mentioned in the type),+  but 'a' and 'b' are Specified.++* Specified.  Function signature with explicit kind polymorphism+     f5 :: a (b :: k) -> Int+  This time 'k' is Specified, because it is mentioned explicitly,+  so we get f5 :: forall (k:*) (a:k->*) (b:k). a b -> Int++* Similarly pattern synonyms:+  Inferred - from inferred types (e.g. no pattern type signature)+           - or from inferred kind polymorphism++---- In type declarations ----++* Inferred (k)+     data T1 a b = MkT1 (a b)+  Here T1's kind is  T1 :: forall {k:*}. (k->*) -> k -> *+  The kind variable 'k' is Inferred, since it is not mentioned++  Note that 'a' and 'b' correspond to /Anon/ TyCoBinders in T1's kind,+  and Anon binders don't have a visibility flag. (Or you could think+  of Anon having an implicit Required flag.)++* Specified (k)+     data T2 (a::k->*) b = MkT (a b)+  Here T's kind is  T :: forall (k:*). (k->*) -> k -> *+  The kind variable 'k' is Specified, since it is mentioned in+  the signature.++* Required (k)+     data T k (a::k->*) b = MkT (a b)+  Here T's kind is  T :: forall k:* -> (k->*) -> k -> *+  The kind is Required, since it bound in a positional way in T's declaration+  Every use of T must be explicitly applied to a kind++* Inferred (k1), Specified (k)+     data T a b (c :: k) = MkT (a b) (Proxy c)+  Here T's kind is  T :: forall {k1:*} (k:*). (k1->*) -> k1 -> k -> *+  So 'k' is Specified, because it appears explicitly,+  but 'k1' is Inferred, because it does not++Generally, in the list of TyConBinders for a TyCon,++* Inferred arguments always come first+* Specified, Anon and Required can be mixed++e.g.+  data Foo (a :: Type) :: forall b. (a -> b -> Type) -> Type where ...++Here Foo's TyConBinders are+   [Required 'a', Specified 'b', Anon]+and its kind prints as+   Foo :: forall a -> forall b. (a -> b -> Type) -> Type++See also Note [Required, Specified, and Inferred for types] in TcTyClsDecls++---- Printing -----++ We print forall types with enough syntax to tell you their visibility+ flag.  But this is not source Haskell, and these types may not all+ be parsable.++ Specified: a list of Specified binders is written between `forall` and `.`:+               const :: forall a b. a -> b -> a++ Inferred:  with -fprint-explicit-foralls, Inferred binders are written+            in braces:+               f :: forall {k} (a:k). S k a -> Int+            Otherwise, they are printed like Specified binders.++ Required: binders are put between `forall` and `->`:+              T :: forall k -> *++---- Other points -----++* In classic Haskell, all named binders (that is, the type variables in+  a polymorphic function type f :: forall a. a -> a) have been Inferred.++* Inferred variables correspond to "generalized" variables from the+  Visible Type Applications paper (ESOP'16).++Note [No Required TyCoBinder in terms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We don't allow Required foralls for term variables, including pattern+synonyms and data constructors.  Why?  Because then an application+would need a /compulsory/ type argument (possibly without an "@"?),+thus (f Int); and we don't have concrete syntax for that.++We could change this decision, but Required, Named TyCoBinders are rare+anyway.  (Most are Anons.)++However the type of a term can (just about) have a required quantifier;+see Note [Required quantifiers in the type of a term] in TcExpr.+-}+++{- **********************************************************************+*                                                                       *+                        PredType+*                                                                       *+********************************************************************** -}+++-- | A type of the form @p@ of kind @Constraint@ represents a value whose type is+-- the Haskell predicate @p@, where a predicate is what occurs before+-- the @=>@ in a Haskell type.+--+-- We use 'PredType' as documentation to mark those types that we guarantee to have+-- this kind.+--+-- It can be expanded into its representation, but:+--+-- * The type checker must treat it as opaque+--+-- * The rest of the compiler treats it as transparent+--+-- Consider these examples:+--+-- > f :: (Eq a) => a -> Int+-- > g :: (?x :: Int -> Int) => a -> Int+-- > h :: (r\l) => {r} => {l::Int | r}+--+-- Here the @Eq a@ and @?x :: Int -> Int@ and @r\l@ are all called \"predicates\"+type PredType = Type++-- | A collection of 'PredType's+type ThetaType = [PredType]++{-+(We don't support TREX records yet, but the setup is designed+to expand to allow them.)++A Haskell qualified type, such as that for f,g,h above, is+represented using+        * a FunTy for the double arrow+        * with a type of kind Constraint as the function argument++The predicate really does turn into a real extra argument to the+function.  If the argument has type (p :: Constraint) then the predicate p is+represented by evidence of type p.+++%************************************************************************+%*                                                                      *+            Simple constructors+%*                                                                      *+%************************************************************************++These functions are here so that they can be used by TysPrim,+which in turn is imported by Type+-}++mkTyVarTy  :: TyVar   -> Type+mkTyVarTy v = ASSERT2( isTyVar v, ppr v <+> dcolon <+> ppr (tyVarKind v) )+              TyVarTy v++mkTyVarTys :: [TyVar] -> [Type]+mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy++mkTyCoVarTy :: TyCoVar -> Type+mkTyCoVarTy v+  | isTyVar v+  = TyVarTy v+  | otherwise+  = CoercionTy (CoVarCo v)++mkTyCoVarTys :: [TyCoVar] -> [Type]+mkTyCoVarTys = map mkTyCoVarTy++infixr 3 `mkFunTy`, `mkVisFunTy`, `mkInvisFunTy`      -- Associates to the right++mkFunTy :: AnonArgFlag -> Type -> Type -> Type+mkFunTy af arg res = FunTy { ft_af = af, ft_arg = arg, ft_res = res }++mkVisFunTy, mkInvisFunTy :: Type -> Type -> Type+mkVisFunTy   = mkFunTy VisArg+mkInvisFunTy = mkFunTy InvisArg++-- | Make nested arrow types+mkVisFunTys, mkInvisFunTys :: [Type] -> Type -> Type+mkVisFunTys   tys ty = foldr mkVisFunTy   ty tys+mkInvisFunTys tys ty = foldr mkInvisFunTy ty tys++-- | Like 'mkTyCoForAllTy', but does not check the occurrence of the binder+-- See Note [Unused coercion variable in ForAllTy]+mkForAllTy :: TyCoVar -> ArgFlag -> Type -> Type+mkForAllTy tv vis ty = ForAllTy (Bndr tv vis) ty++-- | Wraps foralls over the type using the provided 'TyCoVar's from left to right+mkForAllTys :: [TyCoVarBinder] -> Type -> Type+mkForAllTys tyvars ty = foldr ForAllTy ty tyvars++mkPiTy:: TyCoBinder -> Type -> Type+mkPiTy (Anon af ty1) ty2        = FunTy { ft_af = af, ft_arg = ty1, ft_res = ty2 }+mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty++mkPiTys :: [TyCoBinder] -> Type -> Type+mkPiTys tbs ty = foldr mkPiTy ty tbs++-- | Create the plain type constructor type which has been applied to no type arguments at all.+mkTyConTy :: TyCon -> Type+mkTyConTy tycon = TyConApp tycon []++{-+Some basic functions, put here to break loops eg with the pretty printer+-}++-- | Extract the RuntimeRep classifier of a type from its kind. For example,+-- @kindRep * = LiftedRep@; Panics if this is not possible.+-- Treats * and Constraint as the same+kindRep :: HasDebugCallStack => Kind -> Type+kindRep k = case kindRep_maybe k of+              Just r  -> r+              Nothing -> pprPanic "kindRep" (ppr k)++-- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr.+-- For example, @kindRep_maybe * = Just LiftedRep@+-- Returns 'Nothing' if the kind is not of form (TYPE rr)+-- Treats * and Constraint as the same+kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type+kindRep_maybe kind+  | Just kind' <- coreView kind = kindRep_maybe kind'+  | TyConApp tc [arg] <- kind+  , tc `hasKey` tYPETyConKey    = Just arg+  | otherwise                   = Nothing++-- | This version considers Constraint to be the same as *. Returns True+-- if the argument is equivalent to Type/Constraint and False otherwise.+-- See Note [Kind Constraint and kind Type]+isLiftedTypeKind :: Kind -> Bool+isLiftedTypeKind kind+  = case kindRep_maybe kind of+      Just rep -> isLiftedRuntimeRep rep+      Nothing  -> False++-- | Returns True if the kind classifies unlifted types and False otherwise.+-- Note that this returns False for levity-polymorphic kinds, which may+-- be specialized to a kind that classifies unlifted types.+isUnliftedTypeKind :: Kind -> Bool+isUnliftedTypeKind kind+  = case kindRep_maybe kind of+      Just rep -> isUnliftedRuntimeRep rep+      Nothing  -> False++isLiftedRuntimeRep :: Type -> Bool+-- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep+-- False of type variables (a :: RuntimeRep)+--   and of other reps e.g. (IntRep :: RuntimeRep)+isLiftedRuntimeRep rep+  | Just rep' <- coreView rep          = isLiftedRuntimeRep rep'+  | TyConApp rr_tc args <- rep+  , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True+  | otherwise                          = False++isUnliftedRuntimeRep :: Type -> Bool+-- True of definitely-unlifted RuntimeReps+-- False of           (LiftedRep :: RuntimeRep)+--   and of variables (a :: RuntimeRep)+isUnliftedRuntimeRep rep+  | Just rep' <- coreView rep = isUnliftedRuntimeRep rep'+  | TyConApp rr_tc _ <- rep   -- NB: args might be non-empty+                              --     e.g. TupleRep [r1, .., rn]+  = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)+        -- Avoid searching all the unlifted RuntimeRep type cons+        -- In the RuntimeRep data type, only LiftedRep is lifted+        -- But be careful of type families (F tys) :: RuntimeRep+  | otherwise {- Variables, applications -}+  = False++-- | Is this the type 'RuntimeRep'?+isRuntimeRepTy :: Type -> Bool+isRuntimeRepTy ty | Just ty' <- coreView ty = isRuntimeRepTy ty'+isRuntimeRepTy (TyConApp tc args)+  | tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True+isRuntimeRepTy _ = False++-- | Is a tyvar of type 'RuntimeRep'?+isRuntimeRepVar :: TyVar -> Bool+isRuntimeRepVar = isRuntimeRepTy . tyVarKind++{-+%************************************************************************+%*                                                                      *+            Coercions+%*                                                                      *+%************************************************************************+-}++-- | A 'Coercion' is concrete evidence of the equality/convertibility+-- of two types.++-- If you edit this type, you may need to update the GHC formalism+-- See Note [GHC Formalism] in coreSyn/CoreLint.hs+data Coercion+  -- Each constructor has a "role signature", indicating the way roles are+  -- propagated through coercions.+  --    -  P, N, and R stand for coercions of the given role+  --    -  e stands for a coercion of a specific unknown role+  --           (think "role polymorphism")+  --    -  "e" stands for an explicit role parameter indicating role e.+  --    -   _ stands for a parameter that is not a Role or Coercion.++  -- These ones mirror the shape of types+  = -- Refl :: _ -> N+    Refl Type  -- See Note [Refl invariant]+          -- Invariant: applications of (Refl T) to a bunch of identity coercions+          --            always show up as Refl.+          -- For example  (Refl T) (Refl a) (Refl b) shows up as (Refl (T a b)).++          -- Applications of (Refl T) to some coercions, at least one of+          -- which is NOT the identity, show up as TyConAppCo.+          -- (They may not be fully saturated however.)+          -- ConAppCo coercions (like all coercions other than Refl)+          -- are NEVER the identity.++          -- Use (GRefl Representational ty MRefl), not (SubCo (Refl ty))++  -- GRefl :: "e" -> _ -> Maybe N -> e+  -- See Note [Generalized reflexive coercion]+  | GRefl Role Type MCoercionN  -- See Note [Refl invariant]+          -- Use (Refl ty), not (GRefl Nominal ty MRefl)+          -- Use (GRefl Representational _ _), not (SubCo (GRefl Nominal _ _))++  -- These ones simply lift the correspondingly-named+  -- Type constructors into Coercions++  -- TyConAppCo :: "e" -> _ -> ?? -> e+  -- See Note [TyConAppCo roles]+  | TyConAppCo Role TyCon [Coercion]    -- lift TyConApp+               -- The TyCon is never a synonym;+               -- we expand synonyms eagerly+               -- But it can be a type function++  | AppCo Coercion CoercionN             -- lift AppTy+          -- AppCo :: e -> N -> e++  -- See Note [Forall coercions]+  | ForAllCo TyCoVar KindCoercion Coercion+         -- ForAllCo :: _ -> N -> e -> e++  | FunCo Role Coercion Coercion         -- lift FunTy+         -- FunCo :: "e" -> e -> e -> e+         -- Note: why doesn't FunCo have a AnonArgFlag, like FunTy?+         -- Because the AnonArgFlag has no impact on Core; it is only+         -- there to guide implicit instantiation of Haskell source+         -- types, and that is irrelevant for coercions, which are+         -- Core-only.++  -- These are special+  | CoVarCo CoVar      -- :: _ -> (N or R)+                       -- result role depends on the tycon of the variable's type++    -- AxiomInstCo :: e -> _ -> ?? -> e+  | AxiomInstCo (CoAxiom Branched) BranchIndex [Coercion]+     -- See also [CoAxiom index]+     -- The coercion arguments always *precisely* saturate+     -- arity of (that branch of) the CoAxiom. If there are+     -- any left over, we use AppCo.+     -- See [Coercion axioms applied to coercions]+     -- The roles of the argument coercions are determined+     -- by the cab_roles field of the relevant branch of the CoAxiom++  | AxiomRuleCo CoAxiomRule [Coercion]+    -- AxiomRuleCo is very like AxiomInstCo, but for a CoAxiomRule+    -- The number coercions should match exactly the expectations+    -- of the CoAxiomRule (i.e., the rule is fully saturated).++  | UnivCo UnivCoProvenance Role Type Type+      -- :: _ -> "e" -> _ -> _ -> e++  | SymCo Coercion             -- :: e -> e+  | TransCo Coercion Coercion  -- :: e -> e -> e++  | NthCo  Role Int Coercion     -- Zero-indexed; decomposes (T t0 ... tn)+    -- :: "e" -> _ -> e0 -> e (inverse of TyConAppCo, see Note [TyConAppCo roles])+    -- Using NthCo on a ForAllCo gives an N coercion always+    -- See Note [NthCo and newtypes]+    --+    -- Invariant:  (NthCo r i co), it is always the case that r = role of (Nth i co)+    -- That is: the role of the entire coercion is redundantly cached here.+    -- See Note [NthCo Cached Roles]++  | LRCo   LeftOrRight CoercionN     -- Decomposes (t_left t_right)+    -- :: _ -> N -> N+  | InstCo Coercion CoercionN+    -- :: e -> N -> e+    -- See Note [InstCo roles]++  -- Extract a kind coercion from a (heterogeneous) type coercion+  -- NB: all kind coercions are Nominal+  | KindCo Coercion+     -- :: e -> N++  | SubCo CoercionN                  -- Turns a ~N into a ~R+    -- :: N -> R++  | HoleCo CoercionHole              -- ^ See Note [Coercion holes]+                                     -- Only present during typechecking+  deriving Data.Data++type CoercionN = Coercion       -- always nominal+type CoercionR = Coercion       -- always representational+type CoercionP = Coercion       -- always phantom+type KindCoercion = CoercionN   -- always nominal++instance Outputable Coercion where+  ppr = pprCo++-- | A semantically more meaningful type to represent what may or may not be a+-- useful 'Coercion'.+data MCoercion+  = MRefl+    -- A trivial Reflexivity coercion+  | MCo Coercion+    -- Other coercions+  deriving Data.Data+type MCoercionR = MCoercion+type MCoercionN = MCoercion++instance Outputable MCoercion where+  ppr MRefl    = text "MRefl"+  ppr (MCo co) = text "MCo" <+> ppr co++{-+Note [Refl invariant]+~~~~~~~~~~~~~~~~~~~~~+Invariant 1:++Coercions have the following invariant+     Refl (similar for GRefl r ty MRefl) is always lifted as far as possible.++You might think that a consequencs is:+     Every identity coercions has Refl at the root++But that's not quite true because of coercion variables.  Consider+     g         where g :: Int~Int+     Left h    where h :: Maybe Int ~ Maybe Int+etc.  So the consequence is only true of coercions that+have no coercion variables.++Note [Generalized reflexive coercion]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++GRefl is a generalized reflexive coercion (see #15192). It wraps a kind+coercion, which might be reflexive (MRefl) or any coercion (MCo co). The typing+rules for GRefl:++  ty : k1+  ------------------------------------+  GRefl r ty MRefl: ty ~r ty++  ty : k1       co :: k1 ~ k2+  ------------------------------------+  GRefl r ty (MCo co) : ty ~r ty |> co++Consider we have++   g1 :: s ~r t+   s  :: k1+   g2 :: k1 ~ k2++and we want to construct a coercions co which has type++   (s |> g2) ~r t++We can define++   co = Sym (GRefl r s g2) ; g1++It is easy to see that++   Refl == GRefl Nominal ty MRefl :: ty ~n ty++A nominal reflexive coercion is quite common, so we keep the special form Refl to+save allocation.++Note [Coercion axioms applied to coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The reason coercion axioms can be applied to coercions and not just+types is to allow for better optimization.  There are some cases where+we need to be able to "push transitivity inside" an axiom in order to+expose further opportunities for optimization.++For example, suppose we have++  C a : t[a] ~ F a+  g   : b ~ c++and we want to optimize++  sym (C b) ; t[g] ; C c++which has the kind++  F b ~ F c++(stopping through t[b] and t[c] along the way).++We'd like to optimize this to just F g -- but how?  The key is+that we need to allow axioms to be instantiated by *coercions*,+not just by types.  Then we can (in certain cases) push+transitivity inside the axiom instantiations, and then react+opposite-polarity instantiations of the same axiom.  In this+case, e.g., we match t[g] against the LHS of (C c)'s kind, to+obtain the substitution  a |-> g  (note this operation is sort+of the dual of lifting!) and hence end up with++  C g : t[b] ~ F c++which indeed has the same kind as  t[g] ; C c.++Now we have++  sym (C b) ; C g++which can be optimized to F g.++Note [CoAxiom index]+~~~~~~~~~~~~~~~~~~~~+A CoAxiom has 1 or more branches. Each branch has contains a list+of the free type variables in that branch, the LHS type patterns,+and the RHS type for that branch. When we apply an axiom to a list+of coercions, we must choose which branch of the axiom we wish to+use, as the different branches may have different numbers of free+type variables. (The number of type patterns is always the same+among branches, but that doesn't quite concern us here.)++The Int in the AxiomInstCo constructor is the 0-indexed number+of the chosen branch.++Note [Forall coercions]+~~~~~~~~~~~~~~~~~~~~~~~+Constructing coercions between forall-types can be a bit tricky,+because the kinds of the bound tyvars can be different.++The typing rule is:+++  kind_co : k1 ~ k2+  tv1:k1 |- co : t1 ~ t2+  -------------------------------------------------------------------+  ForAllCo tv1 kind_co co : all tv1:k1. t1  ~+                            all tv1:k2. (t2[tv1 |-> tv1 |> sym kind_co])++First, the TyCoVar stored in a ForAllCo is really an optimisation: this field+should be a Name, as its kind is redundant. Thinking of the field as a Name+is helpful in understanding what a ForAllCo means.+The kind of TyCoVar always matches the left-hand kind of the coercion.++The idea is that kind_co gives the two kinds of the tyvar. See how, in the+conclusion, tv1 is assigned kind k1 on the left but kind k2 on the right.++Of course, a type variable can't have different kinds at the same time. So,+we arbitrarily prefer the first kind when using tv1 in the inner coercion+co, which shows that t1 equals t2.++The last wrinkle is that we need to fix the kinds in the conclusion. In+t2, tv1 is assumed to have kind k1, but it has kind k2 in the conclusion of+the rule. So we do a kind-fixing substitution, replacing (tv1:k1) with+(tv1:k2) |> sym kind_co. This substitution is slightly bizarre, because it+mentions the same name with different kinds, but it *is* well-kinded, noting+that `(tv1:k2) |> sym kind_co` has kind k1.++This all really would work storing just a Name in the ForAllCo. But we can't+add Names to, e.g., VarSets, and there generally is just an impedance mismatch+in a bunch of places. So we use tv1. When we need tv2, we can use+setTyVarKind.++Note [Predicate coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have+   g :: a~b+How can we coerce between types+   ([c]~a) => [a] -> c+and+   ([c]~b) => [b] -> c+where the equality predicate *itself* differs?++Answer: we simply treat (~) as an ordinary type constructor, so these+types really look like++   ((~) [c] a) -> [a] -> c+   ((~) [c] b) -> [b] -> c++So the coercion between the two is obviously++   ((~) [c] g) -> [g] -> c++Another way to see this to say that we simply collapse predicates to+their representation type (see Type.coreView and Type.predTypeRep).++This collapse is done by mkPredCo; there is no PredCo constructor+in Coercion.  This is important because we need Nth to work on+predicates too:+    Nth 1 ((~) [c] g) = g+See Simplify.simplCoercionF, which generates such selections.++Note [Roles]+~~~~~~~~~~~~+Roles are a solution to the GeneralizedNewtypeDeriving problem, articulated+in #1496. The full story is in docs/core-spec/core-spec.pdf. Also, see+https://gitlab.haskell.org/ghc/ghc/wikis/roles-implementation++Here is one way to phrase the problem:++Given:+newtype Age = MkAge Int+type family F x+type instance F Age = Bool+type instance F Int = Char++This compiles down to:+axAge :: Age ~ Int+axF1 :: F Age ~ Bool+axF2 :: F Int ~ Char++Then, we can make:+(sym (axF1) ; F axAge ; axF2) :: Bool ~ Char++Yikes!++The solution is _roles_, as articulated in "Generative Type Abstraction and+Type-level Computation" (POPL 2010), available at+http://www.seas.upenn.edu/~sweirich/papers/popl163af-weirich.pdf++The specification for roles has evolved somewhat since that paper. For the+current full details, see the documentation in docs/core-spec. Here are some+highlights.++We label every equality with a notion of type equivalence, of which there are+three options: Nominal, Representational, and Phantom. A ground type is+nominally equivalent only with itself. A newtype (which is considered a ground+type in Haskell) is representationally equivalent to its representation.+Anything is "phantomly" equivalent to anything else. We use "N", "R", and "P"+to denote the equivalences.++The axioms above would be:+axAge :: Age ~R Int+axF1 :: F Age ~N Bool+axF2 :: F Age ~N Char++Then, because transitivity applies only to coercions proving the same notion+of equivalence, the above construction is impossible.++However, there is still an escape hatch: we know that any two types that are+nominally equivalent are representationally equivalent as well. This is what+the form SubCo proves -- it "demotes" a nominal equivalence into a+representational equivalence. So, it would seem the following is possible:++sub (sym axF1) ; F axAge ; sub axF2 :: Bool ~R Char   -- WRONG++What saves us here is that the arguments to a type function F, lifted into a+coercion, *must* prove nominal equivalence. So, (F axAge) is ill-formed, and+we are safe.++Roles are attached to parameters to TyCons. When lifting a TyCon into a+coercion (through TyConAppCo), we need to ensure that the arguments to the+TyCon respect their roles. For example:++data T a b = MkT a (F b)++If we know that a1 ~R a2, then we know (T a1 b) ~R (T a2 b). But, if we know+that b1 ~R b2, we know nothing about (T a b1) and (T a b2)! This is because+the type function F branches on b's *name*, not representation. So, we say+that 'a' has role Representational and 'b' has role Nominal. The third role,+Phantom, is for parameters not used in the type's definition. Given the+following definition++data Q a = MkQ Int++the Phantom role allows us to say that (Q Bool) ~R (Q Char), because we+can construct the coercion Bool ~P Char (using UnivCo).++See the paper cited above for more examples and information.++Note [TyConAppCo roles]+~~~~~~~~~~~~~~~~~~~~~~~+The TyConAppCo constructor has a role parameter, indicating the role at+which the coercion proves equality. The choice of this parameter affects+the required roles of the arguments of the TyConAppCo. To help explain+it, assume the following definition:++  type instance F Int = Bool   -- Axiom axF : F Int ~N Bool+  newtype Age = MkAge Int      -- Axiom axAge : Age ~R Int+  data Foo a = MkFoo a         -- Role on Foo's parameter is Representational++TyConAppCo Nominal Foo axF : Foo (F Int) ~N Foo Bool+  For (TyConAppCo Nominal) all arguments must have role Nominal. Why?+  So that Foo Age ~N Foo Int does *not* hold.++TyConAppCo Representational Foo (SubCo axF) : Foo (F Int) ~R Foo Bool+TyConAppCo Representational Foo axAge       : Foo Age     ~R Foo Int+  For (TyConAppCo Representational), all arguments must have the roles+  corresponding to the result of tyConRoles on the TyCon. This is the+  whole point of having roles on the TyCon to begin with. So, we can+  have Foo Age ~R Foo Int, if Foo's parameter has role R.++  If a Representational TyConAppCo is over-saturated (which is otherwise fine),+  the spill-over arguments must all be at Nominal. This corresponds to the+  behavior for AppCo.++TyConAppCo Phantom Foo (UnivCo Phantom Int Bool) : Foo Int ~P Foo Bool+  All arguments must have role Phantom. This one isn't strictly+  necessary for soundness, but this choice removes ambiguity.++The rules here dictate the roles of the parameters to mkTyConAppCo+(should be checked by Lint).++Note [NthCo and newtypes]+~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have++  newtype N a = MkN Int+  type role N representational++This yields axiom++  NTCo:N :: forall a. N a ~R Int++We can then build++  co :: forall a b. N a ~R N b+  co = NTCo:N a ; sym (NTCo:N b)++for any `a` and `b`. Because of the role annotation on N, if we use+NthCo, we'll get out a representational coercion. That is:++  NthCo r 0 co :: forall a b. a ~R b++Yikes! Clearly, this is terrible. The solution is simple: forbid+NthCo to be used on newtypes if the internal coercion is representational.++This is not just some corner case discovered by a segfault somewhere;+it was discovered in the proof of soundness of roles and described+in the "Safe Coercions" paper (ICFP '14).++Note [NthCo Cached Roles]+~~~~~~~~~~~~~~~~~~~~~~~~~+Why do we cache the role of NthCo in the NthCo constructor?+Because computing role(Nth i co) involves figuring out that++  co :: T tys1 ~ T tys2++using coercionKind, and finding (coercionRole co), and then looking+at the tyConRoles of T. Avoiding bad asymptotic behaviour here means+we have to compute the kind and role of a coercion simultaneously,+which makes the code complicated and inefficient.++This only happens for NthCo. Caching the role solves the problem, and+allows coercionKind and coercionRole to be simple.++See #11735++Note [InstCo roles]+~~~~~~~~~~~~~~~~~~~+Here is (essentially) the typing rule for InstCo:++g :: (forall a. t1) ~r (forall a. t2)+w :: s1 ~N s2+------------------------------- InstCo+InstCo g w :: (t1 [a |-> s1]) ~r (t2 [a |-> s2])++Note that the Coercion w *must* be nominal. This is necessary+because the variable a might be used in a "nominal position"+(that is, a place where role inference would require a nominal+role) in t1 or t2. If we allowed w to be representational, we+could get bogus equalities.++A more nuanced treatment might be able to relax this condition+somewhat, by checking if t1 and/or t2 use their bound variables+in nominal ways. If not, having w be representational is OK.+++%************************************************************************+%*                                                                      *+                UnivCoProvenance+%*                                                                      *+%************************************************************************++A UnivCo is a coercion whose proof does not directly express its role+and kind (indeed for some UnivCos, like UnsafeCoerceProv, there /is/+no proof).++The different kinds of UnivCo are described by UnivCoProvenance.  Really+each is entirely separate, but they all share the need to represent their+role and kind, which is done in the UnivCo constructor.++-}++-- | For simplicity, we have just one UnivCo that represents a coercion from+-- some type to some other type, with (in general) no restrictions on the+-- type. The UnivCoProvenance specifies more exactly what the coercion really+-- is and why a program should (or shouldn't!) trust the coercion.+-- It is reasonable to consider each constructor of 'UnivCoProvenance'+-- as a totally independent coercion form; their only commonality is+-- that they don't tell you what types they coercion between. (That info+-- is in the 'UnivCo' constructor of 'Coercion'.+data UnivCoProvenance+  = UnsafeCoerceProv   -- ^ From @unsafeCoerce#@. These are unsound.++  | PhantomProv KindCoercion -- ^ See Note [Phantom coercions]. Only in Phantom+                             -- roled coercions++  | ProofIrrelProv KindCoercion  -- ^ From the fact that any two coercions are+                                 --   considered equivalent. See Note [ProofIrrelProv].+                                 -- Can be used in Nominal or Representational coercions++  | PluginProv String  -- ^ From a plugin, which asserts that this coercion+                       --   is sound. The string is for the use of the plugin.++  deriving Data.Data++instance Outputable UnivCoProvenance where+  ppr UnsafeCoerceProv   = text "(unsafeCoerce#)"+  ppr (PhantomProv _)    = text "(phantom)"+  ppr (ProofIrrelProv _) = text "(proof irrel.)"+  ppr (PluginProv str)   = parens (text "plugin" <+> brackets (text str))++-- | A coercion to be filled in by the type-checker. See Note [Coercion holes]+data CoercionHole+  = CoercionHole { ch_co_var :: CoVar+                       -- See Note [CoercionHoles and coercion free variables]++                 , ch_ref    :: IORef (Maybe Coercion)+                 }++coHoleCoVar :: CoercionHole -> CoVar+coHoleCoVar = ch_co_var++setCoHoleCoVar :: CoercionHole -> CoVar -> CoercionHole+setCoHoleCoVar h cv = h { ch_co_var = cv }++instance Data.Data CoercionHole where+  -- don't traverse?+  toConstr _   = abstractConstr "CoercionHole"+  gunfold _ _  = error "gunfold"+  dataTypeOf _ = mkNoRepType "CoercionHole"++instance Outputable CoercionHole where+  ppr (CoercionHole { ch_co_var = cv }) = braces (ppr cv)+++{- Note [Phantom coercions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+     data T a = T1 | T2+Then we have+     T s ~R T t+for any old s,t. The witness for this is (TyConAppCo T Rep co),+where (co :: s ~P t) is a phantom coercion built with PhantomProv.+The role of the UnivCo is always Phantom.  The Coercion stored is the+(nominal) kind coercion between the types+   kind(s) ~N kind (t)++Note [Coercion holes]+~~~~~~~~~~~~~~~~~~~~~~~~+During typechecking, constraint solving for type classes works by+  - Generate an evidence Id,  d7 :: Num a+  - Wrap it in a Wanted constraint, [W] d7 :: Num a+  - Use the evidence Id where the evidence is needed+  - Solve the constraint later+  - When solved, add an enclosing let-binding  let d7 = .... in ....+    which actually binds d7 to the (Num a) evidence++For equality constraints we use a different strategy.  See Note [The+equality types story] in TysPrim for background on equality constraints.+  - For /boxed/ equality constraints, (t1 ~N t2) and (t1 ~R t2), it's just+    like type classes above. (Indeed, boxed equality constraints *are* classes.)+  - But for /unboxed/ equality constraints (t1 ~R# t2) and (t1 ~N# t2)+    we use a different plan++For unboxed equalities:+  - Generate a CoercionHole, a mutable variable just like a unification+    variable+  - Wrap the CoercionHole in a Wanted constraint; see TcRnTypes.TcEvDest+  - Use the CoercionHole in a Coercion, via HoleCo+  - Solve the constraint later+  - When solved, fill in the CoercionHole by side effect, instead of+    doing the let-binding thing++The main reason for all this is that there may be no good place to let-bind+the evidence for unboxed equalities:++  - We emit constraints for kind coercions, to be used to cast a+    type's kind. These coercions then must be used in types. Because+    they might appear in a top-level type, there is no place to bind+    these (unlifted) coercions in the usual way.++  - A coercion for (forall a. t1) ~ (forall a. t2) will look like+       forall a. (coercion for t1~t2)+    But the coercion for (t1~t2) may mention 'a', and we don't have+    let-bindings within coercions.  We could add them, but coercion+    holes are easier.++  - Moreover, nothing is lost from the lack of let-bindings. For+    dicionaries want to achieve sharing to avoid recomoputing the+    dictionary.  But coercions are entirely erased, so there's little+    benefit to sharing. Indeed, even if we had a let-binding, we+    always inline types and coercions at every use site and drop the+    binding.++Other notes about HoleCo:++ * INVARIANT: CoercionHole and HoleCo are used only during type checking,+   and should never appear in Core. Just like unification variables; a Type+   can contain a TcTyVar, but only during type checking. If, one day, we+   use type-level information to separate out forms that can appear during+   type-checking vs forms that can appear in core proper, holes in Core will+   be ruled out.++ * See Note [CoercionHoles and coercion free variables]++ * Coercion holes can be compared for equality like other coercions:+   by looking at the types coerced.+++Note [CoercionHoles and coercion free variables]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Why does a CoercionHole contain a CoVar, as well as reference to+fill in?  Because we want to treat that CoVar as a free variable of+the coercion.  See #14584, and Note [What prevents a+constraint from floating] in TcSimplify, item (4):++        forall k. [W] co1 :: t1 ~# t2 |> co2+                  [W] co2 :: k ~# *++Here co2 is a CoercionHole. But we /must/ know that it is free in+co1, because that's all that stops it floating outside the+implication.+++Note [ProofIrrelProv]+~~~~~~~~~~~~~~~~~~~~~+A ProofIrrelProv is a coercion between coercions. For example:++  data G a where+    MkG :: G Bool++In core, we get++  G :: * -> *+  MkG :: forall (a :: *). (a ~ Bool) -> G a++Now, consider 'MkG -- that is, MkG used in a type -- and suppose we want+a proof that ('MkG a1 co1) ~ ('MkG a2 co2). This will have to be++  TyConAppCo Nominal MkG [co3, co4]+  where+    co3 :: co1 ~ co2+    co4 :: a1 ~ a2++Note that+  co1 :: a1 ~ Bool+  co2 :: a2 ~ Bool++Here,+  co3 = UnivCo (ProofIrrelProv co5) Nominal (CoercionTy co1) (CoercionTy co2)+  where+    co5 :: (a1 ~ Bool) ~ (a2 ~ Bool)+    co5 = TyConAppCo Nominal (~#) [<*>, <*>, co4, <Bool>]+-}   {- *********************************************************************