ghc-lib-parser 0.20191002 → 0.20191101

raw patch · 84 files changed

+9964/−8413 lines, 84 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• compiler/GHC/Hs/Expr.hs +75/−107
• compiler/GHC/HsToCore/PmCheck/Types.hs +539/−0
• compiler/GHC/HsToCore/PmCheck/Types.hs-boot +7/−0
• compiler/HsVersions.h +3/−9
• compiler/backpack/BkpSyn.hs +2/−3
• compiler/basicTypes/BasicTypes.hs +25/−1
• compiler/basicTypes/DataCon.hs +1/−0
• compiler/basicTypes/Id.hs +1/−18
• compiler/basicTypes/Predicate.hs +228/−0
• compiler/cbits/genSym.c +1/−1
• compiler/coreSyn/CoreArity.hs +2/−4
• compiler/coreSyn/CoreUnfold.hs +3/−3
• compiler/coreSyn/CoreUtils.hs +1/−0
• compiler/coreSyn/MkCore.hs +25/−10
• compiler/deSugar/PmTypes.hs +0/−530
• compiler/deSugar/PmTypes.hs-boot +0/−7
• compiler/iface/IfaceSyn.hs +178/−1
• compiler/iface/IfaceType.hs +75/−1
• compiler/iface/ToIface.hs +27/−0
• compiler/main/DynFlags.hs +36/−29
• compiler/main/ErrUtils.hs +38/−13
• compiler/main/HeaderInfo.hs +7/−3
• compiler/main/HscTypes.hs +175/−84
• compiler/main/Packages.hs +1/−1
• compiler/main/Plugins.hs +8/−0
• compiler/main/SysTools/BaseDir.hs +17/−11
• compiler/parser/RdrHsSyn.hs +1/−1
• compiler/parser/cutils.c +2/−2
• compiler/prelude/PrelRules.hs +0/−1
• compiler/prelude/TysPrim.hs +7/−0
• compiler/prelude/TysWiredIn.hs +28/−8
• compiler/specialise/Rules.hs +38/−64
• compiler/typecheck/Constraint.hs +1824/−0
• compiler/typecheck/TcEvidence.hs +9/−4
• compiler/typecheck/TcHoleFitTypes.hs +1/−0
• compiler/typecheck/TcOrigin.hs +660/−0
• compiler/typecheck/TcRnTypes.hs +1602/−3847
• compiler/typecheck/TcRnTypes.hs-boot +8/−2
• compiler/typecheck/TcType.hs +20/−129
• compiler/types/Coercion.hs +52/−25
• compiler/types/FamInstEnv.hs +196/−128
• compiler/types/TyCoFVs.hs +52/−12
• compiler/types/TyCoPpr.hs +1/−2
• compiler/types/TyCon.hs +18/−3
• compiler/types/Type.hs +87/−347
• compiler/types/Type.hs-boot +2/−0
• compiler/types/Unify.hs +8/−3
• compiler/utils/Binary.hs +0/−3
• compiler/utils/FastString.hs +6/−3
• compiler/utils/OrdList.hs +53/−7
• compiler/utils/Util.hs +1/−1
• ghc-lib-parser.cabal +15/−13
• ghc-lib/generated/DerivedConstants.h +0/−554
• ghc-lib/generated/GHCConstantsHaskellExports.hs +0/−125
• ghc-lib/generated/GHCConstantsHaskellType.hs +0/−133
• ghc-lib/generated/GHCConstantsHaskellWrappers.hs +0/−250
• ghc-lib/generated/ghcautoconf.h +0/−542
• ghc-lib/generated/ghcplatform.h +0/−26
• ghc-lib/generated/ghcversion.h +0/−19
• ghc-lib/stage0/compiler/build/Config.hs +3/−5
• ghc-lib/stage0/compiler/build/Parser.hs +56/−38
• ghc-lib/stage0/compiler/build/ghc_boot_platform.h +0/−25
• ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl +2/−0
• ghc-lib/stage0/compiler/build/primop-has-side-effects.hs-incl +1/−0
• ghc-lib/stage0/compiler/build/primop-list.hs-incl +2/−0
• ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl +1/−0
• ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl +2/−0
• ghc-lib/stage0/compiler/build/primop-tag.hs-incl +1205/−1203
• ghc-lib/stage0/lib/DerivedConstants.h +555/−0
• ghc-lib/stage0/lib/GHCConstantsHaskellExports.hs +125/−0
• ghc-lib/stage0/lib/GHCConstantsHaskellType.hs +133/−0
• ghc-lib/stage0/lib/GHCConstantsHaskellWrappers.hs +250/−0
• ghc-lib/stage0/lib/ghcautoconf.h +542/−0
• ghc-lib/stage0/lib/ghcplatform.h +28/−0
• ghc-lib/stage0/lib/ghcversion.h +19/−0
• ghc-lib/stage0/lib/llvm-targets +16/−2
• ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs +4/−4
• includes/CodeGen.Platform.hs +38/−1
• includes/MachDeps.h +2/−4
• includes/stg/MachRegs.h +774/−0
• libraries/ghc-boot/GHC/Platform.hs +23/−3
• libraries/ghc-boot/GHC/UniqueSubdir.hs +6/−12
• libraries/ghci/GHCi/BreakArray.hs +0/−6
• libraries/template-haskell/Language/Haskell/TH/Syntax.hs +11/−20

@@ -35,7 +35,6 @@ import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) ) import Name import NameSet-import RdrName  ( GlobalRdrEnv ) import BasicTypes import ConLike import SrcLoc@@ -186,104 +185,6 @@     typecheck do-notation with (>>=) :: m1 a -> (a -> m2 b) -> m2 b.) -} --- | An unbound variable; used for treating--- out-of-scope variables as expression holes------ Either "x", "y"     Plain OutOfScope--- or     "_", "_x"    A TrueExprHole------ Both forms indicate an out-of-scope variable,  but the latter--- indicates that the user /expects/ it to be out of scope, and--- just wants GHC to report its type-data UnboundVar-  = OutOfScope OccName GlobalRdrEnv  -- ^ An (unqualified) out-of-scope-                                     -- variable, together with the GlobalRdrEnv-                                     -- with respect to which it is unbound--                                     -- See Note [OutOfScope and GlobalRdrEnv]--  | TrueExprHole OccName             -- ^ A "true" expression hole (_ or _x)--  deriving Data--instance Outputable UnboundVar where-    ppr (OutOfScope occ _) = text "OutOfScope" <> parens (ppr occ)-    ppr (TrueExprHole occ) = text "ExprHole"   <> parens (ppr occ)--unboundVarOcc :: UnboundVar -> OccName-unboundVarOcc (OutOfScope occ _) = occ-unboundVarOcc (TrueExprHole occ) = occ--{--Note [OutOfScope and GlobalRdrEnv]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-To understand why we bundle a GlobalRdrEnv with an out-of-scope variable,-consider the following module:--    module A where--    foo :: ()-    foo = bar--    bat :: [Double]-    bat = [1.2, 3.4]--    $(return [])--    bar = ()-    bad = False--When A is compiled, the renamer determines that `bar` is not in scope in the-declaration of `foo` (since `bar` is declared in the following inter-splice-group).  Once it has finished typechecking the entire module, the typechecker-then generates the associated error message, which specifies both the type of-`bar` and a list of possible in-scope alternatives:--    A.hs:6:7: error:-        • Variable not in scope: bar :: ()-        • ‘bar’ (line 13) is not in scope before the splice on line 11-          Perhaps you meant ‘bat’ (line 9)--When it calls RnEnv.unknownNameSuggestions to identify these alternatives, the-typechecker must provide a GlobalRdrEnv.  If it provided the current one, which-contains top-level declarations for the entire module, the error message would-incorrectly suggest the out-of-scope `bar` and `bad` as possible alternatives-for `bar` (see #11680).  Instead, the typechecker must use the same-GlobalRdrEnv the renamer used when it determined that `bar` is out-of-scope.--To obtain this GlobalRdrEnv, can the typechecker simply use the out-of-scope-`bar`'s location to either reconstruct it (from the current GlobalRdrEnv) or to-look it up in some global store?  Unfortunately, no.  The problem is that-location information is not always sufficient for this task.  This is most-apparent when dealing with the TH function addTopDecls, which adds its-declarations to the FOLLOWING inter-splice group.  Consider these declarations:--    ex9 = cat               -- cat is NOT in scope here--    $(do --------------------------------------------------------------        ds <- [d| f = cab   -- cat and cap are both in scope here-                  cat = ()-                |]-        addTopDecls ds-        [d| g = cab         -- only cap is in scope here-            cap = True-          |])--    ex10 = cat              -- cat is NOT in scope here--    $(return []) -------------------------------------------------------    ex11 = cat              -- cat is in scope--Here, both occurrences of `cab` are out-of-scope, and so the typechecker needs-the GlobalRdrEnvs which were used when they were renamed.  These GlobalRdrEnvs-are different (`cat` is present only in the GlobalRdrEnv for f's `cab'), but the-locations of the two `cab`s are the same (they are both created in the same-splice).  Thus, we must include some additional information with each `cab` to-allow the typechecker to obtain the correct GlobalRdrEnv.  Clearly, the simplest-information to use is the GlobalRdrEnv itself.--}- -- | A Haskell expression. data HsExpr p   = HsVar     (XVar p)@@ -292,7 +193,7 @@                              -- See Note [Located RdrNames]    | HsUnboundVar (XUnboundVar p)-                 UnboundVar  -- ^ Unbound variable; also used for "holes"+                 OccName     -- ^ Unbound variable; also used for "holes"                              --   (_ or _x).                              -- Turned from HsVar to HsUnboundVar by the                              --   renamer, when it finds an out-of-scope@@ -390,6 +291,7 @@   --         'ApiAnnotation.AnnClose'    -- For details on above see note [Api annotations] in ApiAnnotation+  -- Note [ExplicitTuple]   | ExplicitTuple         (XExplicitTuple p)         [LHsTupArg p]@@ -468,6 +370,7 @@   --              'ApiAnnotation.AnnClose' @']'@    -- For details on above see note [Api annotations] in ApiAnnotation+  -- See Note [Empty lists]   | ExplicitList                 (XExplicitList p)  -- Gives type of components of list                 (Maybe (SyntaxExpr p))@@ -841,6 +744,71 @@ There are unfortunately enough differences between the ParsedSource and the RenamedSource that the API Annotations cannot be used directly with RenamedSource, so this allows a simple mapping to be used based on the location.++Note [ExplicitTuple]+~~~~~~~~~~~~~~~~~~~~+An ExplicitTuple is never just a data constructor like (,,,).+That is, the `[LHsTupArg p]` argument of `ExplicitTuple` has at least+one `Present` member (and is thus never empty).++A tuple data constructor like () or (,,,) is parsed as an `HsVar`, not an+`ExplicitTuple`, and stays that way. This is important for two reasons:++  1. We don't need -XTupleSections for (,,,)+  2. The type variables in (,,,) can be instantiated with visible type application.+     That is,++       (,,)     :: forall a b c. a -> b -> c -> (a,b,c)+       (True,,) :: forall {b} {c}. b -> c -> (Bool,b,c)++     Note that the tuple section has *inferred* arguments, while the data+     constructor has *specified* ones.+     (See Note [Required, Specified, and Inferred for types] in TcTyClsDecls+     for background.)++Sadly, the grammar for this is actually ambiguous, and it's only thanks to the+preference of a shift in a shift/reduce conflict that the parser works as this+Note details. Search for a reference to this Note in Parser.y for further+explanation.++Note [Empty lists]+~~~~~~~~~~~~~~~~~~+An empty list could be considered either a data constructor (stored with+HsVar) or an ExplicitList. This Note describes how empty lists flow through the+various phases and why.++Parsing+-------+An empty list is parsed by the sysdcon nonterminal. It thus comes to life via+HsVar nilDataCon (defined in TysWiredIn). A freshly-parsed (HsExpr GhcPs) empty list+is never a ExplicitList.++Renaming+--------+If -XOverloadedLists is enabled, we must type-check the empty list as if it+were a call to fromListN. (This is true regardless of the setting of+-XRebindableSyntax.) This is very easy if the empty list is an ExplicitList,+but an annoying special case if it's an HsVar. So the renamer changes a+HsVar nilDataCon to an ExplicitList [], but only if -XOverloadedLists is on.+(Why not always? Read on, dear friend.) This happens in the HsVar case of rnExpr.++Type-checking+-------------+We want to accept an expression like [] @Int. To do this, we must infer that+[] :: forall a. [a]. This is easy if [] is a HsVar with the right DataCon inside.+However, the type-checking for explicit lists works differently: [x,y,z] is never+polymorphic. Instead, we unify the types of x, y, and z together, and use the+unified type as the argument to the cons and nil constructors. Thus, treating+[] as an empty ExplicitList in the type-checker would prevent [] @Int from working.++However, if -XOverloadedLists is on, then [] @Int really shouldn't be allowed:+it's just like fromListN 0 [] @Int. Since+  fromListN :: forall list. IsList list => Int -> [Item list] -> list+that expression really should be rejected. Thus, the renamer's behaviour is+exactly what we want: treat [] as a datacon when -XNoOverloadedLists, and as+an empty ExplicitList when -XOverloadedLists.++See also #13680, which requested [] @Int to work. -}  instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (HsExpr p) where@@ -878,7 +846,7 @@ ppr_expr :: forall p. (OutputableBndrId (GhcPass p))          => HsExpr (GhcPass p) -> SDoc ppr_expr (HsVar _ (L _ v))  = pprPrefixOcc v-ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc (unboundVarOcc uv)+ppr_expr (HsUnboundVar _ uv)= pprPrefixOcc uv ppr_expr (HsConLikeOut _ c) = pprPrefixOcc c ppr_expr (HsIPVar _ v)      = ppr v ppr_expr (HsOverLabel _ _ l)= char '#' <> ppr l@@ -1062,12 +1030,12 @@ ppr_expr (XExpr x) = ppr x  ppr_infix_expr :: (OutputableBndrId (GhcPass p)) => HsExpr (GhcPass p) -> Maybe SDoc-ppr_infix_expr (HsVar _ (L _ v)) = Just (pprInfixOcc v)-ppr_infix_expr (HsConLikeOut _ c)= Just (pprInfixOcc (conLikeName c))-ppr_infix_expr (HsRecFld _ f)    = Just (pprInfixOcc f)-ppr_infix_expr (HsUnboundVar _ h@TrueExprHole{}) = Just (pprInfixOcc (unboundVarOcc h))-ppr_infix_expr (HsWrap _ _ e)    = ppr_infix_expr e-ppr_infix_expr _                 = Nothing+ppr_infix_expr (HsVar _ (L _ v))    = Just (pprInfixOcc v)+ppr_infix_expr (HsConLikeOut _ c)   = Just (pprInfixOcc (conLikeName c))+ppr_infix_expr (HsRecFld _ f)       = Just (pprInfixOcc f)+ppr_infix_expr (HsUnboundVar _ occ) = Just (pprInfixOcc occ)+ppr_infix_expr (HsWrap _ _ e)       = ppr_infix_expr e+ppr_infix_expr _                    = Nothing  ppr_apps :: (OutputableBndrId (GhcPass p))          => HsExpr (GhcPass p)

@@ -0,0 +1,539 @@+{-+Author: George Karachalias <george.karachalias@cs.kuleuven.be>+        Sebastian Graf <sgraf1337@gmail.com>+-}++{-# LANGUAGE CPP #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TupleSections #-}++-- | Types used through-out pattern match checking. This module is mostly there+-- to be imported from "TcRnTypes". The exposed API is that of+-- "GHC.HsToCore.PmCheck.Oracle" and "GHC.HsToCore.PmCheck".+module GHC.HsToCore.PmCheck.Types (+        -- * Representations for Literals and AltCons+        PmLit(..), PmLitValue(..), PmAltCon(..), pmLitType, pmAltConType,++        -- ** Equality on 'PmAltCon's+        PmEquality(..), eqPmAltCon,++        -- ** Operations on 'PmLit'+        literalToPmLit, negatePmLit, overloadPmLit,+        pmLitAsStringLit, coreExprAsPmLit,++        -- * Caching partially matched COMPLETE sets+        ConLikeSet, PossibleMatches(..),++        -- * A 'DIdEnv' where entries may be shared+        Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE,+        setIndirectSDIE, setEntrySDIE, traverseSDIE,++        -- * The pattern match oracle+        VarInfo(..), TmState(..), TyState(..), Delta(..), initDelta+    ) where++#include "HsVersions.h"++import GhcPrelude++import Util+import Bag+import FastString+import Var (EvVar)+import Id+import VarEnv+import UniqDSet+import UniqDFM+import Name+import DataCon+import ConLike+import Outputable+import Maybes+import Type+import TyCon+import Literal+import CoreSyn+import CoreMap+import CoreUtils (exprType)+import PrelNames+import TysWiredIn+import TysPrim+import TcType (evVarPred)++import Numeric (fromRat)+import Data.Foldable (find)+import qualified Data.List.NonEmpty as NonEmpty+import Data.Ratio++-- | Literals (simple and overloaded ones) for pattern match checking.+--+-- See Note [Undecidable Equality for PmAltCons]+data PmLit = PmLit+           { pm_lit_ty  :: Type+           , pm_lit_val :: PmLitValue }++data PmLitValue+  = PmLitInt Integer+  | PmLitRat Rational+  | PmLitChar Char+  -- We won't actually see PmLitString in the oracle since we desugar strings to+  -- lists+  | PmLitString FastString+  | PmLitOverInt Int {- How often Negated? -} Integer+  | PmLitOverRat Int {- How often Negated? -} Rational+  | PmLitOverString FastString++-- | Undecidable semantic equality result.+-- See Note [Undecidable Equality for PmAltCons]+data PmEquality+  = Equal+  | Disjoint+  | PossiblyOverlap+  deriving (Eq, Show)++-- | When 'PmEquality' can be decided. @True <=> Equal@, @False <=> Disjoint@.+decEquality :: Bool -> PmEquality+decEquality True  = Equal+decEquality False = Disjoint++-- | Undecidable equality for values represented by 'PmLit's.+-- See Note [Undecidable Equality for PmAltCons]+--+-- * @Just True@ ==> Surely equal+-- * @Just False@ ==> Surely different (non-overlapping, even!)+-- * @Nothing@ ==> Equality relation undecidable+eqPmLit :: PmLit -> PmLit -> PmEquality+eqPmLit (PmLit t1 v1) (PmLit t2 v2)+  -- no haddock | pprTrace "eqPmLit" (ppr t1 <+> ppr v1 $$ ppr t2 <+> ppr v2) False = undefined+  | not (t1 `eqType` t2) = Disjoint+  | otherwise            = go v1 v2+  where+    go (PmLitInt i1)        (PmLitInt i2)        = decEquality (i1 == i2)+    go (PmLitRat r1)        (PmLitRat r2)        = decEquality (r1 == r2)+    go (PmLitChar c1)       (PmLitChar c2)       = decEquality (c1 == c2)+    go (PmLitString s1)     (PmLitString s2)     = decEquality (s1 == s2)+    go (PmLitOverInt n1 i1) (PmLitOverInt n2 i2)+      | n1 == n2 && i1 == i2                     = Equal+    go (PmLitOverRat n1 r1) (PmLitOverRat n2 r2)+      | n1 == n2 && r1 == r2                     = Equal+    go (PmLitOverString s1) (PmLitOverString s2)+      | s1 == s2                                 = Equal+    go _                    _                    = PossiblyOverlap++-- | Syntactic equality.+instance Eq PmLit where+  a == b = eqPmLit a b == Equal++-- | Type of a 'PmLit'+pmLitType :: PmLit -> Type+pmLitType (PmLit ty _) = ty++-- | Type of a 'PmAltCon'+pmAltConType :: PmAltCon -> [Type] -> Type+pmAltConType (PmAltLit lit)     _arg_tys = ASSERT( null _arg_tys ) pmLitType lit+pmAltConType (PmAltConLike con) arg_tys  = conLikeResTy con arg_tys++instance Outputable PmLitValue where+  ppr (PmLitInt i)        = ppr i+  ppr (PmLitRat r)        = ppr (double (fromRat r)) -- good enough+  ppr (PmLitChar c)       = pprHsChar c+  ppr (PmLitString s)     = pprHsString s+  ppr (PmLitOverInt n i)  = minuses n (ppr i)+  ppr (PmLitOverRat n r)  = minuses n (ppr (double (fromRat r)))+  ppr (PmLitOverString s) = pprHsString s++-- Take care of negated literals+minuses :: Int -> SDoc -> SDoc+minuses n sdoc = iterate (\sdoc -> parens (char '-' <> sdoc)) sdoc !! n++instance Outputable PmLit where+  ppr (PmLit ty v) = ppr v <> suffix+    where+      -- Some ad-hoc hackery for displaying proper lit suffixes based on type+      tbl = [ (intPrimTy, primIntSuffix)+            , (int64PrimTy, primInt64Suffix)+            , (wordPrimTy, primWordSuffix)+            , (word64PrimTy, primWord64Suffix)+            , (charPrimTy, primCharSuffix)+            , (floatPrimTy, primFloatSuffix)+            , (doublePrimTy, primDoubleSuffix) ]+      suffix = fromMaybe empty (snd <$> find (eqType ty . fst) tbl)++instance Outputable PmAltCon where+  ppr (PmAltConLike cl) = ppr cl+  ppr (PmAltLit l)      = ppr l++instance Outputable PmEquality where+  ppr = text . show++-- | Undecidable equality for values represented by 'ConLike's.+-- See Note [Undecidable Equality for PmAltCons].+-- 'PatSynCon's aren't enforced to be generative, so two syntactically different+-- 'PatSynCon's might match the exact same values. Without looking into and+-- reasoning about the pattern synonym's definition, we can't decide if their+-- sets of matched values is different.+--+-- * @Just True@ ==> Surely equal+-- * @Just False@ ==> Surely different (non-overlapping, even!)+-- * @Nothing@ ==> Equality relation undecidable+eqConLike :: ConLike -> ConLike -> PmEquality+eqConLike (RealDataCon dc1) (RealDataCon dc2) = decEquality (dc1 == dc2)+eqConLike (PatSynCon psc1)  (PatSynCon psc2)+  | psc1 == psc2+  = Equal+eqConLike _                 _                 = PossiblyOverlap++-- | Represents the head of a match against a 'ConLike' or literal.+-- Really similar to 'CoreSyn.AltCon'.+data PmAltCon = PmAltConLike ConLike+              | PmAltLit     PmLit++-- | We can't in general decide whether two 'PmAltCon's match the same set of+-- values. In addition to the reasons in 'eqPmLit' and 'eqConLike', a+-- 'PmAltConLike' might or might not represent the same value as a 'PmAltLit'.+-- See Note [Undecidable Equality for PmAltCons].+--+-- * @Just True@ ==> Surely equal+-- * @Just False@ ==> Surely different (non-overlapping, even!)+-- * @Nothing@ ==> Equality relation undecidable+--+-- Examples (omitting some constructor wrapping):+--+-- * @eqPmAltCon (LitInt 42) (LitInt 1) == Just False@: Lit equality is+--   decidable+-- * @eqPmAltCon (DataCon A) (DataCon B) == Just False@: DataCon equality is+--   decidable+-- * @eqPmAltCon (LitOverInt 42) (LitOverInt 1) == Nothing@: OverLit equality+--   is undecidable+-- * @eqPmAltCon (PatSyn PA) (PatSyn PB) == Nothing@: PatSyn equality is+--   undecidable+-- * @eqPmAltCon (DataCon I#) (LitInt 1) == Nothing@: DataCon to Lit+--   comparisons are undecidable without reasoning about the wrapped @Int#@+-- * @eqPmAltCon (LitOverInt 1) (LitOverInt 1) == Just True@: We assume+--   reflexivity for overloaded literals+-- * @eqPmAltCon (PatSyn PA) (PatSyn PA) == Just True@: We assume reflexivity+--   for Pattern Synonyms+eqPmAltCon :: PmAltCon -> PmAltCon -> PmEquality+eqPmAltCon (PmAltConLike cl1) (PmAltConLike cl2) = eqConLike cl1 cl2+eqPmAltCon (PmAltLit     l1)  (PmAltLit     l2)  = eqPmLit l1 l2+eqPmAltCon _                  _                  = PossiblyOverlap++-- | Syntactic equality.+instance Eq PmAltCon where+  a == b = eqPmAltCon a b == Equal++{- Note [Undecidable Equality for PmAltCons]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Equality on overloaded literals is undecidable in the general case. Consider+the following example:++  instance Num Bool where+    ...+    fromInteger 0 = False -- C-like representation of booleans+    fromInteger _ = True++    f :: Bool -> ()+    f 1 = ()        -- Clause A+    f 2 = ()        -- Clause B++Clause B is redundant but to detect this, we must decide the constraint:+@fromInteger 2 ~ fromInteger 1@ which means that we+have to look through function @fromInteger@, whose implementation could+be anything. This poses difficulties for:++1. The expressive power of the check.+   We cannot expect a reasonable implementation of pattern matching to detect+   that @fromInteger 2 ~ fromInteger 1@ is True, unless we unfold function+   fromInteger. This puts termination at risk and is undecidable in the+   general case.++2. Error messages/Warnings.+   What should our message for @f@ above be? A reasonable approach would be+   to issue:++     Pattern matches are (potentially) redundant:+       f 2 = ...    under the assumption that 1 == 2++   but seems to complex and confusing for the user.++We choose to equate only obviously equal overloaded literals, in all other cases+we signal undecidability by returning Nothing from 'eqPmAltCons'. We do+better for non-overloaded literals, because we know their fromInteger/fromString+implementation is actually injective, allowing us to simplify the constraint+@fromInteger 1 ~ fromInteger 2@ to @1 ~ 2@, which is trivially unsatisfiable.++The impact of this treatment of overloaded literals is the following:++  * Redundancy checking is rather conservative, since it cannot see that clause+    B above is redundant.++  * We have instant equality check for overloaded literals (we do not rely on+    the term oracle which is rather expensive, both in terms of performance and+    memory). This significantly improves the performance of functions `covered`+    `uncovered` and `divergent` in deSugar/Check.hs and effectively addresses+    #11161.++  * The warnings issued are simpler.++Similar reasoning applies to pattern synonyms: In contrast to data constructors,+which are generative, constraints like F a ~ G b for two different pattern+synonyms F and G aren't immediately unsatisfiable. We assume F a ~ F a, though.+-}++literalToPmLit :: Type -> Literal -> Maybe PmLit+literalToPmLit ty l = PmLit ty <$> go l+  where+    go (LitChar c)       = Just (PmLitChar c)+    go (LitFloat r)      = Just (PmLitRat r)+    go (LitDouble r)     = Just (PmLitRat r)+    go (LitString s)     = Just (PmLitString (mkFastStringByteString s))+    go (LitNumber _ i _) = Just (PmLitInt i)+    go _                 = Nothing++negatePmLit :: PmLit -> Maybe PmLit+negatePmLit (PmLit ty v) = PmLit ty <$> go v+  where+    go (PmLitInt i)       = Just (PmLitInt (-i))+    go (PmLitRat r)       = Just (PmLitRat (-r))+    go (PmLitOverInt n i) = Just (PmLitOverInt (n+1) i)+    go (PmLitOverRat n r) = Just (PmLitOverRat (n+1) r)+    go _                  = Nothing++overloadPmLit :: Type -> PmLit -> Maybe PmLit+overloadPmLit ty (PmLit _ v) = PmLit ty <$> go v+  where+    go (PmLitInt i)          = Just (PmLitOverInt 0 i)+    go (PmLitRat r)          = Just (PmLitOverRat 0 r)+    go (PmLitString s)+      | ty `eqType` stringTy = Just v+      | otherwise            = Just (PmLitOverString s)+    go _               = Nothing++pmLitAsStringLit :: PmLit -> Maybe FastString+pmLitAsStringLit (PmLit _ (PmLitString s)) = Just s+pmLitAsStringLit _                         = Nothing++coreExprAsPmLit :: CoreExpr -> Maybe PmLit+-- coreExprAsPmLit e | pprTrace "coreExprAsPmLit" (ppr e) False = undefined+coreExprAsPmLit (Tick _t e) = coreExprAsPmLit e+coreExprAsPmLit (Lit l) = literalToPmLit (literalType l) l+coreExprAsPmLit e = case collectArgs e of+  (Var x, [Lit l])+    | Just dc <- isDataConWorkId_maybe x+    , dc `elem` [intDataCon, wordDataCon, charDataCon, floatDataCon, doubleDataCon]+    -> literalToPmLit (exprType e) l+  (Var x, [_ty, Lit n, Lit d])+    | Just dc <- isDataConWorkId_maybe x+    , dataConName dc == ratioDataConName+    -- HACK: just assume we have a literal double. This case only occurs for+    --       overloaded lits anyway, so we immediately override type information+    -> literalToPmLit (exprType e) (mkLitDouble (litValue n % litValue d))+  (Var x, args)+    -- Take care of -XRebindableSyntax. The last argument should be the (only)+    -- integer literal, otherwise we can't really do much about it.+    | [Lit l] <- dropWhile (not . is_lit) args+    -- getOccFS because of -XRebindableSyntax+    , getOccFS (idName x) == getOccFS fromIntegerName+    -> literalToPmLit (literalType l) l >>= overloadPmLit (exprType e)+  (Var x, args)+    -- Similar to fromInteger case+    | [r] <- dropWhile (not . is_ratio) args+    , getOccFS (idName x) == getOccFS fromRationalName+    -> coreExprAsPmLit r >>= overloadPmLit (exprType e)+  (Var x, [Type _ty, _dict, s])+    | idName x == fromStringName+    -- NB: Calls coreExprAsPmLit and then overloadPmLit, so that we return PmLitOverStrings+    -> coreExprAsPmLit s >>= overloadPmLit (exprType e)+  -- These last two cases handle String literals+  (Var x, [Type ty])+    | Just dc <- isDataConWorkId_maybe x+    , dc == nilDataCon+    , ty `eqType` charTy+    -> literalToPmLit stringTy (mkLitString "")+  (Var x, [Lit l])+    | idName x `elem` [unpackCStringName, unpackCStringUtf8Name]+    -> literalToPmLit stringTy l+  _ -> Nothing+  where+    is_lit Lit{} = True+    is_lit _     = False+    is_ratio (Type _) = False+    is_ratio r+      | Just (tc, _) <- splitTyConApp_maybe (exprType r)+      = tyConName tc == ratioTyConName+      | otherwise+      = False++type ConLikeSet = UniqDSet ConLike++-- | A data type caching the results of 'completeMatchConLikes' with support for+-- deletion of contructors that were already matched on.+data PossibleMatches+  = PM TyCon (NonEmpty.NonEmpty ConLikeSet)+  -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE pragma+  -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE+  -- set at all, for which we have 'NoPM'+  | NoPM+  -- ^ No COMPLETE set for this type (yet). Think of overloaded literals.++instance Outputable PossibleMatches where+  ppr (PM _tc cs) = ppr (NonEmpty.toList cs)+  ppr NoPM = text "<NoPM>"++-- | Either @Indirect x@, meaning the value is represented by that of @x@, or+-- an @Entry@ containing containing the actual value it represents.+data Shared a+  = Indirect Id+  | Entry a++-- | A 'DIdEnv' in which entries can be shared by multiple 'Id's.+-- Merge equivalence classes of two Ids by 'setIndirectSDIE' and set the entry+-- of an Id with 'setEntrySDIE'.+newtype SharedDIdEnv a+  = SDIE { unSDIE :: DIdEnv (Shared a) }++emptySDIE :: SharedDIdEnv a+emptySDIE = SDIE emptyDVarEnv++lookupReprAndEntrySDIE :: SharedDIdEnv a -> Id -> (Id, Maybe a)+lookupReprAndEntrySDIE sdie@(SDIE env) x = case lookupDVarEnv env x of+  Nothing           -> (x, Nothing)+  Just (Indirect y) -> lookupReprAndEntrySDIE sdie y+  Just (Entry a)    -> (x, Just a)++-- | @lookupSDIE env x@ looks up an entry for @x@, looking through all+-- 'Indirect's until it finds a shared 'Entry'.+lookupSDIE :: SharedDIdEnv a -> Id -> Maybe a+lookupSDIE sdie x = snd (lookupReprAndEntrySDIE sdie x)++-- | Check if two variables are part of the same equivalence class.+sameRepresentativeSDIE :: SharedDIdEnv a -> Id -> Id -> Bool+sameRepresentativeSDIE sdie x y =+  fst (lookupReprAndEntrySDIE sdie x) == fst (lookupReprAndEntrySDIE sdie y)++-- | @setIndirectSDIE env x y@ sets @x@'s 'Entry' to @Indirect y@, thereby+-- merging @x@'s equivalence class into @y@'s. This will discard all info on+-- @x@!+setIndirectSDIE :: SharedDIdEnv a -> Id -> Id -> SharedDIdEnv a+setIndirectSDIE sdie@(SDIE env) x y =+  SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Indirect y)++-- | @setEntrySDIE env x a@ sets the 'Entry' @x@ is associated with to @a@,+-- thereby modifying its whole equivalence class.+setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a+setEntrySDIE sdie@(SDIE env) x a =+  SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a)++traverseSDIE :: Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b)+traverseSDIE f = fmap (SDIE . listToUDFM) . traverse g . udfmToList . unSDIE+  where+    g (u, Indirect y) = pure (u,Indirect y)+    g (u, Entry a)    = (u,) . Entry <$> f a++instance Outputable a => Outputable (Shared a) where+  ppr (Indirect x) = ppr x+  ppr (Entry a)    = ppr a++instance Outputable a => Outputable (SharedDIdEnv a) where+  ppr (SDIE env) = ppr env++-- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These+-- entries are possibly shared when we figure out that two variables must be+-- equal, thus represent the same set of values.+--+-- See Note [TmState invariants] in Oracle.+data TmState+  = TmSt+  { ts_facts :: !(SharedDIdEnv VarInfo)+  -- ^ Facts about term variables. Deterministic env, so that we generate+  -- deterministic error messages.+  , ts_reps  :: !(CoreMap Id)+  -- ^ An environment for looking up whether we already encountered semantically+  -- equivalent expressions that we want to represent by the same 'Id'+  -- representative.+  }++-- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@,+-- and negative ('vi_neg') facts, like "x is not (:)".+-- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set+-- ('vi_cache').+--+-- Subject to Note [The Pos/Neg invariant] in PmOracle.+data VarInfo+  = VI+  { vi_ty  :: !Type+  -- ^ The type of the variable. Important for rejecting possible GADT+  -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@).++  , vi_pos :: ![(PmAltCon, [Id])]+  -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all+  -- at the same time (i.e. conjunctive).  We need a list because of nested+  -- pattern matches involving pattern synonym+  --    case x of { Just y -> case x of PatSyn z -> ... }+  -- However, no more than one RealDataCon in the list, otherwise contradiction+  -- because of generativity.++  , vi_neg :: ![PmAltCon]+  -- ^ Negative info: A list of 'PmAltCon's that it cannot match.+  -- Example, assuming+  --+  -- @+  --     data T = Leaf Int | Branch T T | Node Int T+  -- @+  --+  -- then @x /~ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@,+  -- and hence can only match @Branch@. Is orthogonal to anything from 'vi_pos',+  -- in the sense that 'eqPmAltCon' returns @PossiblyOverlap@ for any pairing+  -- between 'vi_pos' and 'vi_neg'.++  -- See Note [Why record both positive and negative info?]++  , vi_cache :: !PossibleMatches+  -- ^ A cache of the associated COMPLETE sets. At any time a superset of+  -- possible constructors of each COMPLETE set. So, if it's not in here, we+  -- can't possibly match on it. Complementary to 'vi_neg'. We still need it+  -- to recognise completion of a COMPLETE set efficiently for large enums.+  }++-- | Not user-facing.+instance Outputable TmState where+  ppr (TmSt state reps) = ppr state $$ ppr reps++-- | Not user-facing.+instance Outputable VarInfo where+  ppr (VI ty pos neg cache)+    = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr cache]))++-- | Initial state of the term oracle.+initTmState :: TmState+initTmState = TmSt emptySDIE emptyCoreMap++-- | The type oracle state. A poor man's 'TcSMonad.InsertSet': The invariant is+-- that all constraints in there are mutually compatible.+newtype TyState = TySt (Bag EvVar)++-- | Not user-facing.+instance Outputable TyState where+  ppr (TySt evs)+    = braces $ hcat $ punctuate comma $ map (ppr . evVarPred) $ bagToList evs++initTyState :: TyState+initTyState = TySt emptyBag++-- | Term and type constraints to accompany each value vector abstraction.+-- For efficiency, we store the term oracle state instead of the term+-- constraints.+data Delta = MkDelta { delta_ty_st :: TyState    -- Type oracle; things like a~Int+                     , delta_tm_st :: TmState }  -- Term oracle; things like x~Nothing++-- | An initial delta that is always satisfiable+initDelta :: Delta+initDelta = MkDelta initTyState initTmState++instance Outputable Delta where+  ppr delta = vcat [+      -- intentionally formatted this way enable the dev to comment in only+      -- the info she needs+      ppr (delta_tm_st delta),+      ppr (delta_ty_st delta)+    ]

@@ -0,0 +1,7 @@+module GHC.HsToCore.PmCheck.Types where++import GhcPrelude ()++data Delta++initDelta :: Delta

@@ -1,5 +1,8 @@ #pragma once +-- For GHC_STAGE+#include "ghcplatform.h"+ #if 0  IMPORTANT!  If you put extra tabs/spaces in these macro definitions,@@ -8,15 +11,6 @@ (This is cpp-dependent, of course)  #endif--/* 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- * ghcconfig.h, because that will include ghcplatform.h which has the- * wrong platform settings for the compiler (it has the platform- * settings for the target plat instead). */-#include "ghcautoconf.h"  #define GLOBAL_VAR(name,value,ty)  \ {-# NOINLINE name #-};             \

@@ -12,13 +12,13 @@     HsComponentId(..),     LHsUnit, HsUnit(..),     LHsUnitDecl, HsUnitDecl(..),-    HsDeclType(..),     IncludeDecl(..),     LRenaming, Renaming(..),     ) where  import GhcPrelude +import DriverPhases import GHC.Hs import SrcLoc import Outputable@@ -60,9 +60,8 @@  -- | A declaration in a package, e.g. a module or signature definition, -- or an include.-data HsDeclType = ModuleD | SignatureD data HsUnitDecl n-    = DeclD   HsDeclType (Located ModuleName) (Maybe (Located (HsModule GhcPs)))+    = DeclD   HscSource (Located ModuleName) (Maybe (Located (HsModule GhcPs)))     | IncludeD   (IncludeDecl n) type LHsUnitDecl n = Located (HsUnitDecl n) 

@@ -106,7 +106,9 @@          IntWithInf, infinity, treatZeroAsInf, mkIntWithInf, intGtLimit, -        SpliceExplicitFlag(..)+        SpliceExplicitFlag(..),++        TypeOrKind(..), isTypeLevel, isKindLevel    ) where  import GhcPrelude@@ -1644,3 +1646,25 @@           = ExplicitSplice | -- ^ <=> $(f x y)             ImplicitSplice   -- ^ <=> f x y,  i.e. a naked top level expression     deriving Data++{- *********************************************************************+*                                                                      *+                        Types vs Kinds+*                                                                      *+********************************************************************* -}++-- | Flag to see whether we're type-checking terms or kind-checking types+data TypeOrKind = TypeLevel | KindLevel+  deriving Eq++instance Outputable TypeOrKind where+  ppr TypeLevel = text "TypeLevel"+  ppr KindLevel = text "KindLevel"++isTypeLevel :: TypeOrKind -> Bool+isTypeLevel TypeLevel = True+isTypeLevel KindLevel = False++isKindLevel :: TypeOrKind -> Bool+isKindLevel TypeLevel = False+isKindLevel KindLevel = True

@@ -73,6 +73,7 @@ import Class import Name import PrelNames+import Predicate import Var import VarSet( emptyVarSet ) import Outputable

@@ -73,9 +73,6 @@         isConLikeId, isBottomingId, idIsFrom,         hasNoBinding, -        -- ** Evidence variables-        DictId, isDictId, isEvVar,-         -- ** Join variables         JoinId, isJoinId, isJoinId_maybe, idJoinArity,         asJoinId, asJoinId_maybe, zapJoinId,@@ -129,7 +126,7 @@ import BasicTypes  -- Imported and re-exported-import Var( Id, CoVar, DictId, JoinId,+import Var( Id, CoVar, JoinId,             InId,  InVar,             OutId, OutVar,             idInfo, idDetails, setIdDetails, globaliseId, varType,@@ -583,20 +580,6 @@ isDeadBinder :: Id -> Bool isDeadBinder bndr | isId bndr = isDeadOcc (idOccInfo bndr)                   | otherwise = False   -- TyVars count as not dead--{--************************************************************************-*                                                                      *-              Evidence variables-*                                                                      *-************************************************************************--}--isEvVar :: Var -> Bool-isEvVar var = isEvVarType (varType var)--isDictId :: Id -> Bool-isDictId id = isDictTy (idType id)  {- ************************************************************************

@@ -0,0 +1,228 @@+{-++Describes predicates as they are considered by the solver.++-}++module Predicate (+  Pred(..), classifyPredType,+  isPredTy, isEvVarType,++  -- Equality predicates+  EqRel(..), eqRelRole,+  isEqPrimPred, isEqPred,+  getEqPredTys, getEqPredTys_maybe, getEqPredRole,+  predTypeEqRel,+  mkPrimEqPred, mkReprPrimEqPred, mkPrimEqPredRole,+  mkHeteroPrimEqPred, mkHeteroReprPrimEqPred,++  -- Class predicates+  mkClassPred, isDictTy,+  isClassPred, isEqPredClass, isCTupleClass,+  getClassPredTys, getClassPredTys_maybe,++  -- Implicit parameters+  isIPPred, isIPPred_maybe, isIPTyCon, isIPClass, hasIPPred,++  -- Evidence variables+  DictId, isEvVar, isDictId+  ) where++import GhcPrelude++import Type+import Class+import TyCon+import Var+import Coercion++import PrelNames++import FastString+import Outputable+import Util++import Control.Monad ( guard )++-- | A predicate in the solver. The solver tries to prove Wanted predicates+-- from Given ones.+data Pred+  = ClassPred Class [Type]+  | EqPred EqRel Type Type+  | IrredPred PredType+  | ForAllPred [TyCoVarBinder] [PredType] PredType+     -- ForAllPred: see Note [Quantified constraints] in TcCanonical+  -- NB: There is no TuplePred case+  --     Tuple predicates like (Eq a, Ord b) are just treated+  --     as ClassPred, as if we had a tuple class with two superclasses+  --        class (c1, c2) => (%,%) c1 c2++classifyPredType :: PredType -> Pred+classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of+    Just (tc, [_, _, ty1, ty2])+      | tc `hasKey` eqReprPrimTyConKey -> EqPred ReprEq ty1 ty2+      | tc `hasKey` eqPrimTyConKey     -> EqPred NomEq ty1 ty2++    Just (tc, tys)+      | Just clas <- tyConClass_maybe tc+      -> ClassPred clas tys++    _ | (tvs, rho) <- splitForAllVarBndrs ev_ty+      , (theta, pred) <- splitFunTys rho+      , not (null tvs && null theta)+      -> ForAllPred tvs theta pred++      | otherwise+      -> IrredPred ev_ty++-- --------------------- Dictionary types ---------------------------------++mkClassPred :: Class -> [Type] -> PredType+mkClassPred clas tys = mkTyConApp (classTyCon clas) tys++isDictTy :: Type -> Bool+isDictTy = isClassPred++getClassPredTys :: HasDebugCallStack => PredType -> (Class, [Type])+getClassPredTys ty = case getClassPredTys_maybe ty of+        Just (clas, tys) -> (clas, tys)+        Nothing          -> pprPanic "getClassPredTys" (ppr ty)++getClassPredTys_maybe :: PredType -> Maybe (Class, [Type])+getClassPredTys_maybe ty = case splitTyConApp_maybe ty of+        Just (tc, tys) | Just clas <- tyConClass_maybe tc -> Just (clas, tys)+        _ -> Nothing++-- --------------------- Equality predicates ---------------------------------++-- | A choice of equality relation. This is separate from the type 'Role'+-- because 'Phantom' does not define a (non-trivial) equality relation.+data EqRel = NomEq | ReprEq+  deriving (Eq, Ord)++instance Outputable EqRel where+  ppr NomEq  = text "nominal equality"+  ppr ReprEq = text "representational equality"++eqRelRole :: EqRel -> Role+eqRelRole NomEq  = Nominal+eqRelRole ReprEq = Representational++getEqPredTys :: PredType -> (Type, Type)+getEqPredTys ty+  = case splitTyConApp_maybe ty of+      Just (tc, [_, _, ty1, ty2])+        |  tc `hasKey` eqPrimTyConKey+        || tc `hasKey` eqReprPrimTyConKey+        -> (ty1, ty2)+      _ -> pprPanic "getEqPredTys" (ppr ty)++getEqPredTys_maybe :: PredType -> Maybe (Role, Type, Type)+getEqPredTys_maybe ty+  = case splitTyConApp_maybe ty of+      Just (tc, [_, _, ty1, ty2])+        | tc `hasKey` eqPrimTyConKey     -> Just (Nominal, ty1, ty2)+        | tc `hasKey` eqReprPrimTyConKey -> Just (Representational, ty1, ty2)+      _ -> Nothing++getEqPredRole :: PredType -> Role+getEqPredRole ty = eqRelRole (predTypeEqRel ty)++-- | Get the equality relation relevant for a pred type.+predTypeEqRel :: PredType -> EqRel+predTypeEqRel ty+  | Just (tc, _) <- splitTyConApp_maybe ty+  , tc `hasKey` eqReprPrimTyConKey+  = ReprEq+  | otherwise+  = NomEq++{-------------------------------------------+Predicates on PredType+--------------------------------------------}++{-+Note [Evidence for quantified constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The superclass mechanism in TcCanonical.makeSuperClasses risks+taking a quantified constraint like+   (forall a. C a => a ~ b)+and generate superclass evidence+   (forall a. C a => a ~# b)++This is a funny thing: neither isPredTy nor isCoVarType are true+of it.  So we are careful not to generate it in the first place:+see Note [Equality superclasses in quantified constraints]+in TcCanonical.+-}++isEvVarType :: Type -> Bool+-- True of (a) predicates, of kind Constraint, such as (Eq a), and (a ~ b)+--         (b) coercion types, such as (t1 ~# t2) or (t1 ~R# t2)+-- See Note [Types for coercions, predicates, and evidence] in TyCoRep+-- See Note [Evidence for quantified constraints]+isEvVarType ty = isCoVarType ty || isPredTy ty++isEqPredClass :: Class -> Bool+-- True of (~) and (~~)+isEqPredClass cls =  cls `hasKey` eqTyConKey+                  || cls `hasKey` heqTyConKey++isClassPred, isEqPred, isEqPrimPred, isIPPred :: PredType -> Bool+isClassPred ty = case tyConAppTyCon_maybe ty of+    Just tyCon | isClassTyCon tyCon -> True+    _                               -> False++isEqPred ty  -- True of (a ~ b) and (a ~~ b)+             -- ToDo: should we check saturation?+  | Just tc <- tyConAppTyCon_maybe ty+  , Just cls <- tyConClass_maybe tc+  = isEqPredClass cls+  | otherwise+  = False++isEqPrimPred ty = isCoVarType ty+  -- True of (a ~# b) (a ~R# b)++isIPPred ty = case tyConAppTyCon_maybe ty of+    Just tc -> isIPTyCon tc+    _       -> False++isIPTyCon :: TyCon -> Bool+isIPTyCon tc = tc `hasKey` ipClassKey+  -- Class and its corresponding TyCon have the same Unique++isIPClass :: Class -> Bool+isIPClass cls = cls `hasKey` ipClassKey++isCTupleClass :: Class -> Bool+isCTupleClass cls = isTupleTyCon (classTyCon cls)++isIPPred_maybe :: Type -> Maybe (FastString, Type)+isIPPred_maybe ty =+  do (tc,[t1,t2]) <- splitTyConApp_maybe ty+     guard (isIPTyCon tc)+     x <- isStrLitTy t1+     return (x,t2)++hasIPPred :: PredType -> Bool+hasIPPred pred+  = case classifyPredType pred of+      ClassPred cls tys+        | isIPClass     cls -> True+        | isCTupleClass cls -> any hasIPPred tys+      _other -> False++{-+************************************************************************+*                                                                      *+              Evidence variables+*                                                                      *+************************************************************************+-}++isEvVar :: Var -> Bool+isEvVar var = isEvVarType (varType var)++isDictId :: Id -> Bool+isDictId id = isDictTy (varType id)

@@ -1,5 +1,5 @@+#include <Rts.h> #include <assert.h>-#include "Rts.h" #include "Unique.h"  static HsInt GenSymCounter = 0;

@@ -30,6 +30,7 @@ import Id import Type import TyCon    ( initRecTc, checkRecTc )+import Predicate ( isDictTy ) import Coercion import BasicTypes import Unique@@ -517,7 +518,7 @@   = \e mb_ty -> exprIsCheapX cheap_app e              || case mb_ty of                   Nothing -> False-                  Just ty -> isDictLikeTy ty+                  Just ty -> isDictTy ty   ----------------------@@ -623,9 +624,6 @@  One could go further and make exprIsCheap reply True to any dictionary-typed expression, but that's more work.--See Note [Dictionary-like types] in TcType.hs for why we use-isDictLikeTy here rather than isDictTy  Note [Eta expanding thunks] ~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -441,10 +441,10 @@     go :: Int -> CoreExpr -> Bool     go credit (Lam x e) | isId x           = go (credit+1) e                         | otherwise        = go credit e-    go credit (App f (Type {}))            = go credit f-    go credit (App f a) | credit > 0+    go credit (App f a) | isTyCoArg a      = go credit f+                        | credit > 0                         , exprIsTrivial a  = go (credit-1) f-    go credit (Tick _ e)                 = go credit e -- dubious+    go credit (Tick _ e)                   = go credit e -- dubious     go credit (Cast e _)                   = go credit e     go _      (Var {})                     = boringCxtOk     go _      _                            = boringCxtNotOk

@@ -77,6 +77,7 @@ import IdInfo import PrelNames( absentErrorIdKey ) import Type+import Predicate import TyCoRep( TyCoBinder(..), TyBinder ) import Coercion import TyCon

@@ -21,7 +21,7 @@         FloatBind(..), wrapFloat, wrapFloats, floatBindings,          -- * Constructing small tuples-        mkCoreVarTup, mkCoreVarTupTy, mkCoreTup, mkCoreUbxTup,+        mkCoreVarTupTy, mkCoreTup, mkCoreUbxTup,         mkCoreTupBoxity, unitExpr,          -- * Constructing big tuples@@ -344,13 +344,23 @@   We use a suffix "1" to indicate this.  Usually we want the former, but occasionally the latter.--} --- | Build a small tuple holding the specified variables--- One-tuples are flattened; see Note [Flattening one-tuples]-mkCoreVarTup :: [Id] -> CoreExpr-mkCoreVarTup ids = mkCoreTup (map Var ids)+NB: The logic in tupleDataCon knows about () and Unit and (,), etc. +Note [Don't flatten tuples from HsSyn]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If we get an explicit 1-tuple from HsSyn somehow (likely: Template Haskell),+we should treat it really as a 1-tuple, without flattening. Note that a+1-tuple and a flattened value have different performance and laziness+characteristics, so should just do what we're asked.++This arose from discussions in #16881.++One-tuples that arise internally depend on the circumstance; often flattening+is a good idea. Decisions are made on a case-by-case basis.++-}+ -- | Build the type of a small tuple that holds the specified variables -- One-tuples are flattened; see Note [Flattening one-tuples] mkCoreVarTupTy :: [Id] -> Type@@ -359,9 +369,14 @@ -- | Build a small tuple holding the specified expressions -- One-tuples are flattened; see Note [Flattening one-tuples] mkCoreTup :: [CoreExpr] -> CoreExpr-mkCoreTup []  = Var unitDataConId mkCoreTup [c] = c-mkCoreTup cs  = mkCoreConApps (tupleDataCon Boxed (length cs))+mkCoreTup cs  = mkCoreTup1 cs   -- non-1-tuples are uniform++-- | Build a small tuple holding the specified expressions+-- One-tuples are *not* flattened; see Note [Flattening one-tuples]+-- See also Note [Don't flatten tuples from HsSyn]+mkCoreTup1 :: [CoreExpr] -> CoreExpr+mkCoreTup1 cs = mkCoreConApps (tupleDataCon Boxed (length cs))                               (map (Type . exprType) cs ++ cs)  -- | Build a small unboxed tuple holding the specified expressions,@@ -375,9 +390,9 @@     mkCoreConApps (tupleDataCon Unboxed (length tys))              (map (Type . getRuntimeRep) tys ++ map Type tys ++ exps) --- | Make a core tuple of the given boxity+-- | Make a core tuple of the given boxity; don't flatten 1-tuples mkCoreTupBoxity :: Boxity -> [CoreExpr] -> CoreExpr-mkCoreTupBoxity Boxed   exps = mkCoreTup exps+mkCoreTupBoxity Boxed   exps = mkCoreTup1 exps mkCoreTupBoxity Unboxed exps = mkCoreUbxTup (map exprType exps) exps  -- | Build a big tuple holding the specified variables

@@ -1,530 +0,0 @@-{--Author: George Karachalias <george.karachalias@cs.kuleuven.be>-        Sebastian Graf <sgraf1337@gmail.com>--}--{-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TupleSections #-}---- | Types used through-out pattern match checking. This module is mostly there--- to be imported from "TcRnTypes". The exposed API is that of "PmOracle" and--- "Check".-module PmTypes (-        -- * Representations for Literals and AltCons-        PmLit(..), PmLitValue(..), PmAltCon(..), pmLitType, pmAltConType,--        -- ** Equality on 'PmAltCon's-        PmEquality(..), eqPmAltCon,--        -- ** Operations on 'PmLit'-        literalToPmLit, negatePmLit, overloadPmLit,-        pmLitAsStringLit, coreExprAsPmLit,--        -- * Caching partially matched COMPLETE sets-        ConLikeSet, PossibleMatches(..),--        -- * A 'DIdEnv' where entries may be shared-        Shared(..), SharedDIdEnv(..), emptySDIE, lookupSDIE, sameRepresentativeSDIE,-        setIndirectSDIE, setEntrySDIE, traverseSDIE,--        -- * The pattern match oracle-        VarInfo(..), TmState(..), TyState(..), Delta(..), initDelta-    ) where--#include "HsVersions.h"--import GhcPrelude--import Util-import Bag-import FastString-import Var (EvVar)-import Id-import VarEnv-import UniqDSet-import UniqDFM-import Name-import DataCon-import ConLike-import Outputable-import Maybes-import Type-import TyCon-import Literal-import CoreSyn-import CoreUtils (exprType)-import PrelNames-import TysWiredIn-import TysPrim-import TcType (evVarPred)--import Numeric (fromRat)-import Data.Foldable (find)-import qualified Data.List.NonEmpty as NonEmpty-import Data.Ratio---- | Literals (simple and overloaded ones) for pattern match checking.------ See Note [Undecidable Equality for PmAltCons]-data PmLit = PmLit-           { pm_lit_ty  :: Type-           , pm_lit_val :: PmLitValue }--data PmLitValue-  = PmLitInt Integer-  | PmLitRat Rational-  | PmLitChar Char-  -- We won't actually see PmLitString in the oracle since we desugar strings to-  -- lists-  | PmLitString FastString-  | PmLitOverInt Int {- How often Negated? -} Integer-  | PmLitOverRat Int {- How often Negated? -} Rational-  | PmLitOverString FastString---- | Undecidable semantic equality result.--- See Note [Undecidable Equality for PmAltCons]-data PmEquality-  = Equal-  | Disjoint-  | PossiblyOverlap-  deriving (Eq, Show)---- | When 'PmEquality' can be decided. @True <=> Equal@, @False <=> Disjoint@.-decEquality :: Bool -> PmEquality-decEquality True  = Equal-decEquality False = Disjoint---- | Undecidable equality for values represented by 'PmLit's.--- See Note [Undecidable Equality for PmAltCons]------ * @Just True@ ==> Surely equal--- * @Just False@ ==> Surely different (non-overlapping, even!)--- * @Nothing@ ==> Equality relation undecidable-eqPmLit :: PmLit -> PmLit -> PmEquality-eqPmLit (PmLit t1 v1) (PmLit t2 v2)-  -- no haddock | pprTrace "eqPmLit" (ppr t1 <+> ppr v1 $$ ppr t2 <+> ppr v2) False = undefined-  | not (t1 `eqType` t2) = Disjoint-  | otherwise            = go v1 v2-  where-    go (PmLitInt i1)        (PmLitInt i2)        = decEquality (i1 == i2)-    go (PmLitRat r1)        (PmLitRat r2)        = decEquality (r1 == r2)-    go (PmLitChar c1)       (PmLitChar c2)       = decEquality (c1 == c2)-    go (PmLitString s1)     (PmLitString s2)     = decEquality (s1 == s2)-    go (PmLitOverInt n1 i1) (PmLitOverInt n2 i2)-      | n1 == n2 && i1 == i2                     = Equal-    go (PmLitOverRat n1 r1) (PmLitOverRat n2 r2)-      | n1 == n2 && r1 == r2                     = Equal-    go (PmLitOverString s1) (PmLitOverString s2)-      | s1 == s2                                 = Equal-    go _                    _                    = PossiblyOverlap---- | Syntactic equality.-instance Eq PmLit where-  a == b = eqPmLit a b == Equal---- | Type of a 'PmLit'-pmLitType :: PmLit -> Type-pmLitType (PmLit ty _) = ty---- | Type of a 'PmAltCon'-pmAltConType :: PmAltCon -> [Type] -> Type-pmAltConType (PmAltLit lit)     _arg_tys = ASSERT( null _arg_tys ) pmLitType lit-pmAltConType (PmAltConLike con) arg_tys  = conLikeResTy con arg_tys--instance Outputable PmLitValue where-  ppr (PmLitInt i)        = ppr i-  ppr (PmLitRat r)        = ppr (double (fromRat r)) -- good enough-  ppr (PmLitChar c)       = pprHsChar c-  ppr (PmLitString s)     = pprHsString s-  ppr (PmLitOverInt n i)  = minuses n (ppr i)-  ppr (PmLitOverRat n r)  = minuses n (ppr (double (fromRat r)))-  ppr (PmLitOverString s) = pprHsString s---- Take care of negated literals-minuses :: Int -> SDoc -> SDoc-minuses n sdoc = iterate (\sdoc -> parens (char '-' <> sdoc)) sdoc !! n--instance Outputable PmLit where-  ppr (PmLit ty v) = ppr v <> suffix-    where-      -- Some ad-hoc hackery for displaying proper lit suffixes based on type-      tbl = [ (intPrimTy, primIntSuffix)-            , (int64PrimTy, primInt64Suffix)-            , (wordPrimTy, primWordSuffix)-            , (word64PrimTy, primWord64Suffix)-            , (charPrimTy, primCharSuffix)-            , (floatPrimTy, primFloatSuffix)-            , (doublePrimTy, primDoubleSuffix) ]-      suffix = fromMaybe empty (snd <$> find (eqType ty . fst) tbl)--instance Outputable PmAltCon where-  ppr (PmAltConLike cl) = ppr cl-  ppr (PmAltLit l)      = ppr l--instance Outputable PmEquality where-  ppr = text . show---- | Undecidable equality for values represented by 'ConLike's.--- See Note [Undecidable Equality for PmAltCons].--- 'PatSynCon's aren't enforced to be generative, so two syntactically different--- 'PatSynCon's might match the exact same values. Without looking into and--- reasoning about the pattern synonym's definition, we can't decide if their--- sets of matched values is different.------ * @Just True@ ==> Surely equal--- * @Just False@ ==> Surely different (non-overlapping, even!)--- * @Nothing@ ==> Equality relation undecidable-eqConLike :: ConLike -> ConLike -> PmEquality-eqConLike (RealDataCon dc1) (RealDataCon dc2) = decEquality (dc1 == dc2)-eqConLike (PatSynCon psc1)  (PatSynCon psc2)-  | psc1 == psc2-  = Equal-eqConLike _                 _                 = PossiblyOverlap---- | Represents the head of a match against a 'ConLike' or literal.--- Really similar to 'CoreSyn.AltCon'.-data PmAltCon = PmAltConLike ConLike-              | PmAltLit     PmLit---- | We can't in general decide whether two 'PmAltCon's match the same set of--- values. In addition to the reasons in 'eqPmLit' and 'eqConLike', a--- 'PmAltConLike' might or might not represent the same value as a 'PmAltLit'.--- See Note [Undecidable Equality for PmAltCons].------ * @Just True@ ==> Surely equal--- * @Just False@ ==> Surely different (non-overlapping, even!)--- * @Nothing@ ==> Equality relation undecidable------ Examples (omitting some constructor wrapping):------ * @eqPmAltCon (LitInt 42) (LitInt 1) == Just False@: Lit equality is---   decidable--- * @eqPmAltCon (DataCon A) (DataCon B) == Just False@: DataCon equality is---   decidable--- * @eqPmAltCon (LitOverInt 42) (LitOverInt 1) == Nothing@: OverLit equality---   is undecidable--- * @eqPmAltCon (PatSyn PA) (PatSyn PB) == Nothing@: PatSyn equality is---   undecidable--- * @eqPmAltCon (DataCon I#) (LitInt 1) == Nothing@: DataCon to Lit---   comparisons are undecidable without reasoning about the wrapped @Int#@--- * @eqPmAltCon (LitOverInt 1) (LitOverInt 1) == Just True@: We assume---   reflexivity for overloaded literals--- * @eqPmAltCon (PatSyn PA) (PatSyn PA) == Just True@: We assume reflexivity---   for Pattern Synonyms-eqPmAltCon :: PmAltCon -> PmAltCon -> PmEquality-eqPmAltCon (PmAltConLike cl1) (PmAltConLike cl2) = eqConLike cl1 cl2-eqPmAltCon (PmAltLit     l1)  (PmAltLit     l2)  = eqPmLit l1 l2-eqPmAltCon _                  _                  = PossiblyOverlap---- | Syntactic equality.-instance Eq PmAltCon where-  a == b = eqPmAltCon a b == Equal--{- Note [Undecidable Equality for PmAltCons]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Equality on overloaded literals is undecidable in the general case. Consider-the following example:--  instance Num Bool where-    ...-    fromInteger 0 = False -- C-like representation of booleans-    fromInteger _ = True--    f :: Bool -> ()-    f 1 = ()        -- Clause A-    f 2 = ()        -- Clause B--Clause B is redundant but to detect this, we must decide the constraint:-@fromInteger 2 ~ fromInteger 1@ which means that we-have to look through function @fromInteger@, whose implementation could-be anything. This poses difficulties for:--1. The expressive power of the check.-   We cannot expect a reasonable implementation of pattern matching to detect-   that @fromInteger 2 ~ fromInteger 1@ is True, unless we unfold function-   fromInteger. This puts termination at risk and is undecidable in the-   general case.--2. Error messages/Warnings.-   What should our message for @f@ above be? A reasonable approach would be-   to issue:--     Pattern matches are (potentially) redundant:-       f 2 = ...    under the assumption that 1 == 2--   but seems to complex and confusing for the user.--We choose to equate only obviously equal overloaded literals, in all other cases-we signal undecidability by returning Nothing from 'eqPmAltCons'. We do-better for non-overloaded literals, because we know their fromInteger/fromString-implementation is actually injective, allowing us to simplify the constraint-@fromInteger 1 ~ fromInteger 2@ to @1 ~ 2@, which is trivially unsatisfiable.--The impact of this treatment of overloaded literals is the following:--  * Redundancy checking is rather conservative, since it cannot see that clause-    B above is redundant.--  * We have instant equality check for overloaded literals (we do not rely on-    the term oracle which is rather expensive, both in terms of performance and-    memory). This significantly improves the performance of functions `covered`-    `uncovered` and `divergent` in deSugar/Check.hs and effectively addresses-    #11161.--  * The warnings issued are simpler.--Similar reasoning applies to pattern synonyms: In contrast to data constructors,-which are generative, constraints like F a ~ G b for two different pattern-synonyms F and G aren't immediately unsatisfiable. We assume F a ~ F a, though.--}--literalToPmLit :: Type -> Literal -> Maybe PmLit-literalToPmLit ty l = PmLit ty <$> go l-  where-    go (LitChar c)       = Just (PmLitChar c)-    go (LitFloat r)      = Just (PmLitRat r)-    go (LitDouble r)     = Just (PmLitRat r)-    go (LitString s)     = Just (PmLitString (mkFastStringByteString s))-    go (LitNumber _ i _) = Just (PmLitInt i)-    go _                 = Nothing--negatePmLit :: PmLit -> Maybe PmLit-negatePmLit (PmLit ty v) = PmLit ty <$> go v-  where-    go (PmLitInt i)       = Just (PmLitInt (-i))-    go (PmLitRat r)       = Just (PmLitRat (-r))-    go (PmLitOverInt n i) = Just (PmLitOverInt (n+1) i)-    go (PmLitOverRat n r) = Just (PmLitOverRat (n+1) r)-    go _                  = Nothing--overloadPmLit :: Type -> PmLit -> Maybe PmLit-overloadPmLit ty (PmLit _ v) = PmLit ty <$> go v-  where-    go (PmLitInt i)          = Just (PmLitOverInt 0 i)-    go (PmLitRat r)          = Just (PmLitOverRat 0 r)-    go (PmLitString s)-      | ty `eqType` stringTy = Just v-      | otherwise            = Just (PmLitOverString s)-    go _               = Nothing--pmLitAsStringLit :: PmLit -> Maybe FastString-pmLitAsStringLit (PmLit _ (PmLitString s)) = Just s-pmLitAsStringLit _                         = Nothing--coreExprAsPmLit :: CoreExpr -> Maybe PmLit--- coreExprAsPmLit e | pprTrace "coreExprAsPmLit" (ppr e) False = undefined-coreExprAsPmLit (Tick _t e) = coreExprAsPmLit e-coreExprAsPmLit (Lit l) = literalToPmLit (literalType l) l-coreExprAsPmLit e = case collectArgs e of-  (Var x, [Lit l])-    | Just dc <- isDataConWorkId_maybe x-    , dc `elem` [intDataCon, wordDataCon, charDataCon, floatDataCon, doubleDataCon]-    -> literalToPmLit (exprType e) l-  (Var x, [_ty, Lit n, Lit d])-    | Just dc <- isDataConWorkId_maybe x-    , dataConName dc == ratioDataConName-    -- HACK: just assume we have a literal double. This case only occurs for-    --       overloaded lits anyway, so we immediately override type information-    -> literalToPmLit (exprType e) (mkLitDouble (litValue n % litValue d))-  (Var x, args)-    -- Take care of -XRebindableSyntax. The last argument should be the (only)-    -- integer literal, otherwise we can't really do much about it.-    | [Lit l] <- dropWhile (not . is_lit) args-    -- getOccFS because of -XRebindableSyntax-    , getOccFS (idName x) == getOccFS fromIntegerName-    -> literalToPmLit (literalType l) l >>= overloadPmLit (exprType e)-  (Var x, args)-    -- Similar to fromInteger case-    | [r] <- dropWhile (not . is_ratio) args-    , getOccFS (idName x) == getOccFS fromRationalName-    -> coreExprAsPmLit r >>= overloadPmLit (exprType e)-  (Var x, [Type _ty, _dict, s])-    | idName x == fromStringName-    -- NB: Calls coreExprAsPmLit and then overloadPmLit, so that we return PmLitOverStrings-    -> coreExprAsPmLit s >>= overloadPmLit (exprType e)-  -- These last two cases handle String literals-  (Var x, [Type ty])-    | Just dc <- isDataConWorkId_maybe x-    , dc == nilDataCon-    , ty `eqType` charTy-    -> literalToPmLit stringTy (mkLitString "")-  (Var x, [Lit l])-    | idName x `elem` [unpackCStringName, unpackCStringUtf8Name]-    -> literalToPmLit stringTy l-  _ -> Nothing-  where-    is_lit Lit{} = True-    is_lit _     = False-    is_ratio (Type _) = False-    is_ratio r-      | Just (tc, _) <- splitTyConApp_maybe (exprType r)-      = tyConName tc == ratioTyConName-      | otherwise-      = False--type ConLikeSet = UniqDSet ConLike---- | A data type caching the results of 'completeMatchConLikes' with support for--- deletion of contructors that were already matched on.-data PossibleMatches-  = PM TyCon (NonEmpty.NonEmpty ConLikeSet)-  -- ^ Each ConLikeSet is a (subset of) the constructors in a COMPLETE pragma-  -- 'NonEmpty' because the empty case would mean that the type has no COMPLETE-  -- set at all, for which we have 'NoPM'-  | NoPM-  -- ^ No COMPLETE set for this type (yet). Think of overloaded literals.--instance Outputable PossibleMatches where-  ppr (PM _tc cs) = ppr (NonEmpty.toList cs)-  ppr NoPM = text "<NoPM>"---- | Either @Indirect x@, meaning the value is represented by that of @x@, or--- an @Entry@ containing containing the actual value it represents.-data Shared a-  = Indirect Id-  | Entry a---- | A 'DIdEnv' in which entries can be shared by multiple 'Id's.--- Merge equivalence classes of two Ids by 'setIndirectSDIE' and set the entry--- of an Id with 'setEntrySDIE'.-newtype SharedDIdEnv a-  = SDIE { unSDIE :: DIdEnv (Shared a) }--emptySDIE :: SharedDIdEnv a-emptySDIE = SDIE emptyDVarEnv--lookupReprAndEntrySDIE :: SharedDIdEnv a -> Id -> (Id, Maybe a)-lookupReprAndEntrySDIE sdie@(SDIE env) x = case lookupDVarEnv env x of-  Nothing           -> (x, Nothing)-  Just (Indirect y) -> lookupReprAndEntrySDIE sdie y-  Just (Entry a)    -> (x, Just a)---- | @lookupSDIE env x@ looks up an entry for @x@, looking through all--- 'Indirect's until it finds a shared 'Entry'.-lookupSDIE :: SharedDIdEnv a -> Id -> Maybe a-lookupSDIE sdie x = snd (lookupReprAndEntrySDIE sdie x)---- | Check if two variables are part of the same equivalence class.-sameRepresentativeSDIE :: SharedDIdEnv a -> Id -> Id -> Bool-sameRepresentativeSDIE sdie x y =-  fst (lookupReprAndEntrySDIE sdie x) == fst (lookupReprAndEntrySDIE sdie y)---- | @setIndirectSDIE env x y@ sets @x@'s 'Entry' to @Indirect y@, thereby--- merging @x@'s equivalence class into @y@'s. This will discard all info on--- @x@!-setIndirectSDIE :: SharedDIdEnv a -> Id -> Id -> SharedDIdEnv a-setIndirectSDIE sdie@(SDIE env) x y =-  SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Indirect y)---- | @setEntrySDIE env x a@ sets the 'Entry' @x@ is associated with to @a@,--- thereby modifying its whole equivalence class.-setEntrySDIE :: SharedDIdEnv a -> Id -> a -> SharedDIdEnv a-setEntrySDIE sdie@(SDIE env) x a =-  SDIE $ extendDVarEnv env (fst (lookupReprAndEntrySDIE sdie x)) (Entry a)--traverseSDIE :: Applicative f => (a -> f b) -> SharedDIdEnv a -> f (SharedDIdEnv b)-traverseSDIE f = fmap (SDIE . listToUDFM) . traverse g . udfmToList . unSDIE-  where-    g (u, Indirect y) = pure (u,Indirect y)-    g (u, Entry a)    = (u,) . Entry <$> f a--instance Outputable a => Outputable (Shared a) where-  ppr (Indirect x) = ppr x-  ppr (Entry a)    = ppr a--instance Outputable a => Outputable (SharedDIdEnv a) where-  ppr (SDIE env) = ppr env---- | The term oracle state. Stores 'VarInfo' for encountered 'Id's. These--- entries are possibly shared when we figure out that two variables must be--- equal, thus represent the same set of values.------ See Note [TmState invariants].-newtype TmState = TmSt (SharedDIdEnv VarInfo)-  -- Deterministic so that we generate deterministic error messages---- | Information about an 'Id'. Stores positive ('vi_pos') facts, like @x ~ Just 42@,--- and negative ('vi_neg') facts, like "x is not (:)".--- Also caches the type ('vi_ty'), the 'PossibleMatches' of a COMPLETE set--- ('vi_cache').------ Subject to Note [The Pos/Neg invariant].-data VarInfo-  = VI-  { vi_ty  :: !Type-  -- ^ The type of the variable. Important for rejecting possible GADT-  -- constructors or incompatible pattern synonyms (@Just42 :: Maybe Int@).--  , vi_pos :: [(PmAltCon, [Id])]-  -- ^ Positive info: 'PmAltCon' apps it is (i.e. @x ~ [Just y, PatSyn z]@), all-  -- at the same time (i.e. conjunctive).  We need a list because of nested-  -- pattern matches involving pattern synonym-  --    case x of { Just y -> case x of PatSyn z -> ... }-  -- However, no more than one RealDataCon in the list, otherwise contradiction-  -- because of generativity.--  , vi_neg :: ![PmAltCon]-  -- ^ Negative info: A list of 'PmAltCon's that it cannot match.-  -- Example, assuming-  ---  -- @-  --     data T = Leaf Int | Branch T T | Node Int T-  -- @-  ---  -- then @x /~ [Leaf, Node]@ means that @x@ cannot match a @Leaf@ or @Node@,-  -- and hence can only match @Branch@. Is orthogonal to anything from 'vi_pos',-  -- in the sense that 'eqPmAltCon' returns @PossiblyOverlap@ for any pairing-  -- between 'vi_pos' and 'vi_neg'.--  -- See Note [Why record both positive and negative info?]--  , vi_cache :: !PossibleMatches-  -- ^ A cache of the associated COMPLETE sets. At any time a superset of-  -- possible constructors of each COMPLETE set. So, if it's not in here, we-  -- can't possibly match on it. Complementary to 'vi_neg'. We still need it-  -- to recognise completion of a COMPLETE set efficiently for large enums.-  }---- | Not user-facing.-instance Outputable TmState where-  ppr (TmSt state) = ppr state---- | Not user-facing.-instance Outputable VarInfo where-  ppr (VI ty pos neg cache)-    = braces (hcat (punctuate comma [ppr ty, ppr pos, ppr neg, ppr cache]))---- | Initial state of the oracle.-initTmState :: TmState-initTmState = TmSt emptySDIE---- | The type oracle state. A poor man's 'TcSMonad.InsertSet': The invariant is--- that all constraints in there are mutually compatible.-newtype TyState = TySt (Bag EvVar)---- | Not user-facing.-instance Outputable TyState where-  ppr (TySt evs)-    = braces $ hcat $ punctuate comma $ map (ppr . evVarPred) $ bagToList evs--initTyState :: TyState-initTyState = TySt emptyBag---- | Term and type constraints to accompany each value vector abstraction.--- For efficiency, we store the term oracle state instead of the term--- constraints.-data Delta = MkDelta { delta_ty_st :: TyState    -- Type oracle; things like a~Int-                     , delta_tm_st :: TmState }  -- Term oracle; things like x~Nothing---- | An initial delta that is always satisfiable-initDelta :: Delta-initDelta = MkDelta initTyState initTmState--instance Outputable Delta where-  ppr delta = vcat [-      -- intentionally formatted this way enable the dev to comment in only-      -- the info she needs-      ppr (delta_tm_st delta),-      ppr (delta_ty_st delta)-    ]

@@ -1,7 +0,0 @@-module PmTypes where--import GhcPrelude ()--data Delta--initDelta :: Delta

@@ -4,6 +4,7 @@ -}  {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}  module IfaceSyn (         module IfaceType,@@ -70,9 +71,11 @@ import DataCon (SrcStrictness(..), SrcUnpackedness(..)) import Lexeme (isLexSym) import TysWiredIn ( constraintKindTyConName )+import Util (seqList)  import Control.Monad import System.IO.Unsafe+import Control.DeepSeq  infixl 3 &&& @@ -1200,7 +1203,7 @@     --    [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.)     ppr_tc_app gadt_subst =       pprPrefixIfDeclBndr how_much (occName tycon)-      <+> pprIfaceAppArgs+      <+> pprParendIfaceAppArgs             (substIfaceAppArgs gadt_subst (mk_tc_app_args tc_binders))      mk_tc_app_args :: [IfaceTyConBinder] -> IfaceAppArgs@@ -2414,3 +2417,177 @@ instance Binary IfaceCompleteMatch where   put_ bh (IfaceCompleteMatch cs ts) = put_ bh cs >> put_ bh ts   get bh = IfaceCompleteMatch <$> get bh <*> get bh+++{-+************************************************************************+*                                                                      *+                NFData instances+   See Note [Avoiding space leaks in toIface*] in ToIface+*                                                                      *+************************************************************************+-}++instance NFData IfaceDecl where+  rnf = \case+    IfaceId f1 f2 f3 f4 ->+      rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4++    IfaceData f1 f2 f3 f4 f5 f6 f7 f8 f9 ->+      f1 `seq` seqList f2 `seq` f3 `seq` f4 `seq` f5 `seq`+      rnf f6 `seq` rnf f7 `seq` rnf f8 `seq` rnf f9++    IfaceSynonym f1 f2 f3 f4 f5 ->+      rnf f1 `seq` f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5++    IfaceFamily f1 f2 f3 f4 f5 f6 ->+      rnf f1 `seq` rnf f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5 `seq` f6 `seq` ()++    IfaceClass f1 f2 f3 f4 f5 ->+      rnf f1 `seq` f2 `seq` seqList f3 `seq` rnf f4 `seq` rnf f5++    IfaceAxiom nm tycon role ax ->+      rnf nm `seq`+      rnf tycon `seq`+      role `seq`+      rnf ax++    IfacePatSyn f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 ->+      rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` f6 `seq`+      rnf f7 `seq` rnf f8 `seq` rnf f9 `seq` rnf f10 `seq` f11 `seq` ()++instance NFData IfaceAxBranch where+  rnf (IfaceAxBranch f1 f2 f3 f4 f5 f6 f7) =+    rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` rnf f6 `seq` rnf f7++instance NFData IfaceClassBody where+  rnf = \case+    IfAbstractClass -> ()+    IfConcreteClass f1 f2 f3 f4 -> rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` ()++instance NFData IfaceAT where+  rnf (IfaceAT f1 f2) = rnf f1 `seq` rnf f2++instance NFData IfaceClassOp where+  rnf (IfaceClassOp f1 f2 f3) = rnf f1 `seq` rnf f2 `seq` f3 `seq` ()++instance NFData IfaceTyConParent where+  rnf = \case+    IfNoParent -> ()+    IfDataInstance f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3++instance NFData IfaceConDecls where+  rnf = \case+    IfAbstractTyCon -> ()+    IfDataTyCon f1 -> rnf f1+    IfNewTyCon f1 -> rnf f1++instance NFData IfaceConDecl where+  rnf (IfCon f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11) =+    rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` f5 `seq` rnf f6 `seq`+    rnf f7 `seq` rnf f8 `seq` f9 `seq` rnf f10 `seq` rnf f11++instance NFData IfaceSrcBang where+  rnf (IfSrcBang f1 f2) = f1 `seq` f2 `seq` ()++instance NFData IfaceBang where+  rnf x = x `seq` ()++instance NFData IfaceIdDetails where+  rnf = \case+    IfVanillaId -> ()+    IfRecSelId (Left tycon) b -> rnf tycon `seq` rnf b+    IfRecSelId (Right decl) b -> rnf decl `seq` rnf b+    IfDFunId -> ()++instance NFData IfaceIdInfo where+  rnf = \case+    NoInfo -> ()+    HasInfo f1 -> rnf f1++instance NFData IfaceInfoItem where+  rnf = \case+    HsArity a -> rnf a+    HsStrictness str -> seqStrictSig str+    HsInline p -> p `seq` () -- TODO: seq further?+    HsUnfold b unf -> rnf b `seq` rnf unf+    HsNoCafRefs -> ()+    HsLevity -> ()++instance NFData IfaceUnfolding where+  rnf = \case+    IfCoreUnfold inlinable expr ->+      rnf inlinable `seq` rnf expr+    IfCompulsory expr ->+      rnf expr+    IfInlineRule arity b1 b2 e ->+      rnf arity `seq` rnf b1 `seq` rnf b2 `seq` rnf e+    IfDFunUnfold bndrs exprs ->+      rnf bndrs `seq` rnf exprs++instance NFData IfaceExpr where+  rnf = \case+    IfaceLcl nm -> rnf nm+    IfaceExt nm -> rnf nm+    IfaceType ty -> rnf ty+    IfaceCo co -> rnf co+    IfaceTuple sort exprs -> sort `seq` rnf exprs+    IfaceLam bndr expr -> rnf bndr `seq` rnf expr+    IfaceApp e1 e2 -> rnf e1 `seq` rnf e2+    IfaceCase e nm alts -> rnf e `seq` nm `seq` rnf alts+    IfaceECase e ty -> rnf e `seq` rnf ty+    IfaceLet bind e -> rnf bind `seq` rnf e+    IfaceCast e co -> rnf e `seq` rnf co+    IfaceLit l -> l `seq` () -- FIXME+    IfaceFCall fc ty -> fc `seq` rnf ty+    IfaceTick tick e -> rnf tick `seq` rnf e++instance NFData IfaceBinding where+  rnf = \case+    IfaceNonRec bndr e -> rnf bndr `seq` rnf e+    IfaceRec binds -> rnf binds++instance NFData IfaceLetBndr where+  rnf (IfLetBndr nm ty id_info join_info) =+    rnf nm `seq` rnf ty `seq` rnf id_info `seq` rnf join_info++instance NFData IfaceFamTyConFlav where+  rnf = \case+    IfaceDataFamilyTyCon -> ()+    IfaceOpenSynFamilyTyCon -> ()+    IfaceClosedSynFamilyTyCon f1 -> rnf f1+    IfaceAbstractClosedSynFamilyTyCon -> ()+    IfaceBuiltInSynFamTyCon -> ()++instance NFData IfaceJoinInfo where+  rnf x = x `seq` ()++instance NFData IfaceTickish where+  rnf = \case+    IfaceHpcTick m i -> rnf m `seq` rnf i+    IfaceSCC cc b1 b2 -> cc `seq` rnf b1 `seq` rnf b2+    IfaceSource src str -> src `seq` rnf str++instance NFData IfaceConAlt where+  rnf = \case+    IfaceDefault -> ()+    IfaceDataAlt nm -> rnf nm+    IfaceLitAlt lit -> lit `seq` ()++instance NFData IfaceCompleteMatch where+  rnf (IfaceCompleteMatch f1 f2) = rnf f1 `seq` rnf f2++instance NFData IfaceRule where+  rnf (IfaceRule f1 f2 f3 f4 f5 f6 f7 f8) =+    rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 `seq` rnf f6 `seq` rnf f7 `seq` f8 `seq` ()++instance NFData IfaceFamInst where+  rnf (IfaceFamInst f1 f2 f3 f4) =+    rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` ()++instance NFData IfaceClsInst where+  rnf (IfaceClsInst f1 f2 f3 f4 f5) =+    f1 `seq` rnf f2 `seq` rnf f3 `seq` f4 `seq` f5 `seq` ()++instance NFData IfaceAnnotation where+  rnf (IfaceAnnotation f1 f2) = f1 `seq` f2 `seq` ()

@@ -9,6 +9,7 @@ {-# LANGUAGE CPP, FlexibleInstances, BangPatterns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE LambdaCase #-}     -- FlexibleInstances for Binary (DefMethSpec IfaceType)  module IfaceType (@@ -79,6 +80,7 @@  import Data.Maybe( isJust ) import qualified Data.Semigroup as Semi+import Control.DeepSeq  {- ************************************************************************@@ -1465,7 +1467,7 @@  pprTuple :: PprPrec -> TupleSort -> PromotionFlag -> IfaceAppArgs -> SDoc pprTuple ctxt_prec ConstraintTuple NotPromoted IA_Nil-  = maybeParen ctxt_prec appPrec $+  = maybeParen ctxt_prec sigPrec $     text "() :: Constraint"  -- All promoted constructors have kind arguments@@ -1959,3 +1961,75 @@             case h of               0 -> return VanillaDM               _ -> do { t <- get bh; return (GenericDM t) }++instance NFData IfaceType where+  rnf = \case+    IfaceFreeTyVar f1 -> f1 `seq` ()+    IfaceTyVar f1 -> rnf f1+    IfaceLitTy f1 -> rnf f1+    IfaceAppTy f1 f2 -> rnf f1 `seq` rnf f2+    IfaceFunTy f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3+    IfaceForAllTy f1 f2 -> f1 `seq` rnf f2+    IfaceTyConApp f1 f2 -> rnf f1 `seq` rnf f2+    IfaceCastTy f1 f2 -> rnf f1 `seq` rnf f2+    IfaceCoercionTy f1 -> rnf f1+    IfaceTupleTy f1 f2 f3 -> f1 `seq` f2 `seq` rnf f3++instance NFData IfaceTyLit where+  rnf = \case+    IfaceNumTyLit f1 -> rnf f1+    IfaceStrTyLit f1 -> rnf f1++instance NFData IfaceCoercion where+  rnf = \case+    IfaceReflCo f1 -> rnf f1+    IfaceGReflCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3+    IfaceFunCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3+    IfaceTyConAppCo f1 f2 f3 -> f1 `seq` rnf f2 `seq` rnf f3+    IfaceAppCo f1 f2 -> rnf f1 `seq` rnf f2+    IfaceForAllCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3+    IfaceCoVarCo f1 -> rnf f1+    IfaceAxiomInstCo f1 f2 f3 -> rnf f1 `seq` rnf f2 `seq` rnf f3+    IfaceAxiomRuleCo f1 f2 -> rnf f1 `seq` rnf f2+    IfaceUnivCo f1 f2 f3 f4 -> rnf f1 `seq` f2 `seq` rnf f3 `seq` rnf f4+    IfaceSymCo f1 -> rnf f1+    IfaceTransCo f1 f2 -> rnf f1 `seq` rnf f2+    IfaceNthCo f1 f2 -> rnf f1 `seq` rnf f2+    IfaceLRCo f1 f2 -> f1 `seq` rnf f2+    IfaceInstCo f1 f2 -> rnf f1 `seq` rnf f2+    IfaceKindCo f1 -> rnf f1+    IfaceSubCo f1 -> rnf f1+    IfaceFreeCoVar f1 -> f1 `seq` ()+    IfaceHoleCo f1 -> f1 `seq` ()++instance NFData IfaceUnivCoProv where+  rnf x = seq x ()++instance NFData IfaceMCoercion where+  rnf x = seq x ()++instance NFData IfaceOneShot where+  rnf x = seq x ()++instance NFData IfaceTyConSort where+  rnf = \case+    IfaceNormalTyCon -> ()+    IfaceTupleTyCon arity sort -> rnf arity `seq` sort `seq` ()+    IfaceSumTyCon arity -> rnf arity+    IfaceEqualityTyCon -> ()++instance NFData IfaceTyConInfo where+  rnf (IfaceTyConInfo f s) = f `seq` rnf s++instance NFData IfaceTyCon where+  rnf (IfaceTyCon nm info) = rnf nm `seq` rnf info++instance NFData IfaceBndr where+  rnf = \case+    IfaceIdBndr id_bndr -> rnf id_bndr+    IfaceTvBndr tv_bndr -> rnf tv_bndr++instance NFData IfaceAppArgs where+  rnf = \case+    IA_Nil -> ()+    IA_Arg f1 f2 f3 -> rnf f1 `seq` f2 `seq` rnf f3

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE Strict #-} -- See Note [Avoiding space leaks in toIface*]  -- | Functions for converting Core things to interface file things. module ToIface@@ -72,6 +73,32 @@ import Demand ( isTopSig )  import Data.Maybe ( catMaybes )++{- Note [Avoiding space leaks in toIface*]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Building a interface file depends on the output of the simplifier.+If we build these lazily this would mean keeping the Core AST alive+much longer than necessary causing a space "leak".++This happens for example when we only write the interface file to disk+after code gen has run, in which case we might carry megabytes of core+AST in the heap which is no longer needed.++We avoid this in two ways.+* First we use -XStrict in ToIface which avoids many thunks to begin with.+* Second we define NFData instance for IFaceSyn and use them to+  force any remaining thunks.++-XStrict is not sufficient as patterns of the form `f (g x)` would still+result in a thunk being allocated for `g x`.++NFData is sufficient for the space leak, but using -XStrict reduces allocation+by ~0.1% when compiling with -O. (nofib/spectral/simple, T10370).+It's essentially free performance hence we use -XStrict on top of NFData.++MR !1633 on gitlab, has more discussion on the topic.+-}  ---------------- toIfaceTvBndr :: TyVar -> IfaceTvBndr

@@ -84,7 +84,7 @@         unsafeFlags, unsafeFlagsForInfer,          -- ** LLVM Targets-        LlvmTarget(..), LlvmTargets, LlvmPasses, LlvmConfig,+        LlvmTarget(..), LlvmConfig(..),          -- ** System tool settings and locations         Settings(..),@@ -321,7 +321,7 @@ import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt -#if 0+#if GHC_STAGE >= 2 -- used by SHARED_GLOBAL_VAR import Foreign (Ptr) #endif@@ -455,8 +455,9 @@    | Opt_D_dump_simpl_iterations    | Opt_D_dump_spec    | Opt_D_dump_prep-   | Opt_D_dump_stg-   | Opt_D_dump_stg_final+   | Opt_D_dump_stg -- CoreToStg output+   | Opt_D_dump_stg_unarised -- STG after unarise+   | Opt_D_dump_stg_final -- STG after stg2stg    | Opt_D_dump_call_arity    | Opt_D_dump_exitify    | Opt_D_dump_stranal@@ -971,8 +972,9 @@   integerLibrary        :: IntegerLibrary,     -- ^ IntegerGMP or IntegerSimple. Set at configure time, but may be overriden     --   by GHC-API users. See Note [The integer library] in PrelNames-  llvmTargets           :: LlvmTargets,-  llvmPasses            :: LlvmPasses,+  llvmConfig            :: LlvmConfig,+    -- ^ N.B. It's important that this field is lazy since we load the LLVM+    -- configuration lazily. See Note [LLVM Configuration] in SysTools.   verbosity             :: Int,         -- ^ Verbosity level: see Note [Verbosity levels]   optLevel              :: Int,         -- ^ Optimisation level   debugLevel            :: Int,         -- ^ How much debug information to produce@@ -1392,9 +1394,10 @@   , lAttributes :: [String]   } -type LlvmTargets = [(String, LlvmTarget)]-type LlvmPasses = [(Int, String)]-type LlvmConfig = (LlvmTargets, LlvmPasses)+-- | See Note [LLVM Configuration] in SysTools.+data LlvmConfig = LlvmConfig { llvmTargets :: [(String, LlvmTarget)]+                             , llvmPasses  :: [(Int, String)]+                             }  ----------------------------------------------------------------------------- -- Accessessors from 'DynFlags'@@ -1513,7 +1516,7 @@   return $ appdir </> versionedFilePath dflags  versionedFilePath :: DynFlags -> FilePath-versionedFilePath dflags = uniqueSubdir $ targetPlatform dflags+versionedFilePath dflags = uniqueSubdir $ platformMini $ targetPlatform dflags  -- | The target code type of the compilation (if any). --@@ -1925,7 +1928,7 @@ -- | The normal 'DynFlags'. Note that they are not suitable for use in this form -- and must be fully initialized by 'GHC.runGhc' first. defaultDynFlags :: Settings -> LlvmConfig -> DynFlags-defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =+defaultDynFlags mySettings llvmConfig = -- See Note [Updating flag description in the User's Guide]      DynFlags {         ghcMode                 = CompManager,@@ -2036,8 +2039,8 @@         platformConstants = sPlatformConstants mySettings,         rawSettings = sRawSettings mySettings, -        llvmTargets             = myLlvmTargets,-        llvmPasses              = myLlvmPasses,+        -- See Note [LLVM configuration].+        llvmConfig              = llvmConfig,          -- ghc -M values         depMakefile       = "Makefile",@@ -2295,6 +2298,9 @@           f (Off f) flags = EnumSet.delete f flags           defaultExtensionFlags = EnumSet.fromList (languageExtensions ml) +-- | The language extensions implied by the various language variants.+-- When updating this be sure to update the flag documentation in+-- @docs/users-guide/glasgow_exts.rst@. languageExtensions :: Maybe Language -> [LangExt.Extension]  languageExtensions Nothing@@ -3109,9 +3115,9 @@   , make_ord_flag defGhcFlag "split-sections"       (noArgM (\dflags -> do         if platformHasSubsectionsViaSymbols (targetPlatform dflags)-          then do addErr $+          then do addWarn $                     "-split-sections is not useful on this platform " ++-                    "since it always uses subsections via symbols."+                    "since it always uses subsections via symbols. Ignoring."                   return dflags           else return (gopt_set dflags Opt_SplitSections))) @@ -3392,6 +3398,8 @@         (setDumpFlag Opt_D_dump_prep)   , make_ord_flag defGhcFlag "ddump-stg"         (setDumpFlag Opt_D_dump_stg)+  , make_ord_flag defGhcFlag "ddump-stg-unarised"+        (setDumpFlag Opt_D_dump_stg_unarised)   , make_ord_flag defGhcFlag "ddump-stg-final"         (setDumpFlag Opt_D_dump_stg_final)   , make_ord_flag defGhcFlag "ddump-call-arity"@@ -4053,7 +4061,8 @@     "it is subsumed by -Wredundant-constraints",   flagSpec "redundant-constraints"       Opt_WarnRedundantConstraints,   flagSpec "duplicate-exports"           Opt_WarnDuplicateExports,-  flagSpec "hi-shadowing"                Opt_WarnHiShadows,+  depFlagSpec "hi-shadowing"                Opt_WarnHiShadows+    "it is not used, and was never implemented",   flagSpec "inaccessible-code"           Opt_WarnInaccessibleCode,   flagSpec "implicit-prelude"            Opt_WarnImplicitPrelude,   depFlagSpec "implicit-kind-vars"       Opt_WarnImplicitKindVars@@ -4360,26 +4369,25 @@ supportedLanguageOverlays :: [String] supportedLanguageOverlays = map (flagSpecName . snd) safeHaskellFlagsDeps -supportedExtensions :: [String]-supportedExtensions = concatMap toFlagSpecNamePair xFlags+supportedExtensions :: PlatformMini -> [String]+supportedExtensions targetPlatformMini = concatMap toFlagSpecNamePair xFlags   where     toFlagSpecNamePair flg-#if !defined(HAVE_INTERPRETER)       -- IMPORTANT! Make sure that `ghc --supported-extensions` omits       -- "TemplateHaskell"/"QuasiQuotes" when it's known not to work out of the       -- box. See also GHC #11102 and #16331 for more details about       -- the rationale-      | flagSpecFlag flg == LangExt.TemplateHaskell  = [noName]-      | flagSpecFlag flg == LangExt.QuasiQuotes      = [noName]-#endif+      | isAIX, flagSpecFlag flg == LangExt.TemplateHaskell  = [noName]+      | isAIX, flagSpecFlag flg == LangExt.QuasiQuotes      = [noName]       | otherwise = [name, noName]       where+        isAIX = platformMini_os targetPlatformMini == OSAIX         noName = "No" ++ name         name = flagSpecName flg -supportedLanguagesAndExtensions :: [String]-supportedLanguagesAndExtensions =-    supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions+supportedLanguagesAndExtensions :: PlatformMini -> [String]+supportedLanguagesAndExtensions targetPlatformMini =+    supportedLanguages ++ supportedLanguageOverlays ++ supportedExtensions targetPlatformMini  -- | These -X<blah> flags cannot be reversed with -XNo<blah> languageFlagsDeps :: [(Deprecation, FlagSpec Language)]@@ -5732,13 +5740,12 @@ -- initialized. defaultGlobalDynFlags :: DynFlags defaultGlobalDynFlags =-    (defaultDynFlags settings (llvmTargets, llvmPasses)) { verbosity = 2 }+    (defaultDynFlags settings llvmConfig) { verbosity = 2 }   where     settings = panic "v_unsafeGlobalDynFlags: settings not initialised"-    llvmTargets = panic "v_unsafeGlobalDynFlags: llvmTargets not initialised"-    llvmPasses = panic "v_unsafeGlobalDynFlags: llvmPasses not initialised"+    llvmConfig = panic "v_unsafeGlobalDynFlags: llvmConfig not initialised" -#if 1+#if GHC_STAGE < 2 GLOBAL_VAR(v_unsafeGlobalDynFlags, defaultGlobalDynFlags, DynFlags) #else SHARED_GLOBAL_VAR( v_unsafeGlobalDynFlags

@@ -50,7 +50,8 @@         errorMsg, warningMsg,         fatalErrorMsg, fatalErrorMsg'',         compilationProgressMsg,-        showPass, withTiming, withTimingSilent,+        showPass,+        withTiming, withTimingSilent, withTimingD, withTimingSilentD,         debugTraceMsg,         ghcExit,         prettyPrintGhcErrors,@@ -647,36 +648,61 @@ -- -- See Note [withTiming] for more. withTiming :: MonadIO m-           => m DynFlags   -- ^ A means of getting a 'DynFlags' (often-                           -- 'getDynFlags' will work here)+           => DynFlags     -- ^ DynFlags            -> SDoc         -- ^ The name of the phase            -> (a -> ())    -- ^ A function to force the result                            -- (often either @const ()@ or 'rnf')            -> m a          -- ^ The body of the phase to be timed            -> m a-withTiming getDFlags what force action =-  withTiming' getDFlags what force PrintTimings action+withTiming dflags what force action =+  withTiming' dflags what force PrintTimings action +-- | Like withTiming but get DynFlags from the Monad.+withTimingD :: (MonadIO m, HasDynFlags m)+           => SDoc         -- ^ The name of the phase+           -> (a -> ())    -- ^ A function to force the result+                           -- (often either @const ()@ or 'rnf')+           -> m a          -- ^ The body of the phase to be timed+           -> m a+withTimingD what force action = do+  dflags <- getDynFlags+  withTiming' dflags what force PrintTimings action + -- | Same as 'withTiming', but doesn't print timings in the --   console (when given @-vN@, @N >= 2@ or @-ddump-timings@). -- --   See Note [withTiming] for more. withTimingSilent   :: MonadIO m-  => m DynFlags -- ^ A means of getting a 'DynFlags' (often-                -- 'getDynFlags' will work here)+  => DynFlags   -- ^ DynFlags   -> SDoc       -- ^ The name of the phase   -> (a -> ())  -- ^ A function to force the result                 -- (often either @const ()@ or 'rnf')   -> m a        -- ^ The body of the phase to be timed   -> m a-withTimingSilent getDFlags what force action =-  withTiming' getDFlags what force DontPrintTimings action+withTimingSilent dflags what force action =+  withTiming' dflags what force DontPrintTimings action +-- | Same as 'withTiming', but doesn't print timings in the+--   console (when given @-vN@, @N >= 2@ or @-ddump-timings@)+--   and gets the DynFlags from the given Monad.+--+--   See Note [withTiming] for more.+withTimingSilentD+  :: (MonadIO m, HasDynFlags m)+  => SDoc       -- ^ The name of the phase+  -> (a -> ())  -- ^ A function to force the result+                -- (often either @const ()@ or 'rnf')+  -> m a        -- ^ The body of the phase to be timed+  -> m a+withTimingSilentD what force action = do+  dflags <- getDynFlags+  withTiming' dflags what force DontPrintTimings action+ -- | Worker for 'withTiming' and 'withTimingSilent'. withTiming' :: MonadIO m-            => m DynFlags   -- ^ A means of getting a 'DynFlags' (often+            => DynFlags   -- ^ A means of getting a 'DynFlags' (often                             -- 'getDynFlags' will work here)             -> SDoc         -- ^ The name of the phase             -> (a -> ())    -- ^ A function to force the result@@ -684,9 +710,8 @@             -> PrintTimings -- ^ Whether to print the timings             -> m a          -- ^ The body of the phase to be timed             -> m a-withTiming' getDFlags what force_result prtimings action-  = do dflags <- getDFlags-       if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags+withTiming' dflags what force_result prtimings action+  = do if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags           then do whenPrintTimings $                     logInfo dflags (defaultUserStyle dflags) $                       text "***" <+> what <> colon

@@ -22,6 +22,7 @@  import GhcPrelude +import GHC.Platform import HscTypes import Parser           ( parseHeader ) import Lexer@@ -306,10 +307,12 @@ checkExtension dflags (dL->L l ext) -- Checks if a given extension is valid, and if so returns -- its corresponding flag. Otherwise it throws an exception.- =  let ext' = unpackFS ext in-    if ext' `elem` supportedLanguagesAndExtensions+  = if ext' `elem` supported     then cL l ("-X"++ext')     else unsupportedExtnError dflags l ext'+  where+    ext' = unpackFS ext+    supported = supportedLanguagesAndExtensions $ platformMini $ targetPlatform dflags  languagePragParseError :: DynFlags -> SrcSpan -> a languagePragParseError dflags loc =@@ -325,7 +328,8 @@         text "Unsupported extension: " <> text unsup $$         if null suggestions then Outputable.empty else text "Perhaps you meant" <+> quotedListWithOr (map text suggestions)   where-     suggestions = fuzzyMatch unsup supportedLanguagesAndExtensions+     supported = supportedLanguagesAndExtensions $ platformMini $ targetPlatform dflags+     suggestions = fuzzyMatch unsup supported   optionsErrorMsgs :: DynFlags -> [String] -> [Located String] -> FilePath -> Messages

@@ -8,6 +8,12 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE DataKinds #-}  -- | Types for the per-module compiler module HscTypes (@@ -53,7 +59,7 @@         -- * State relating to known packages         ExternalPackageState(..), EpsStats(..), addEpsInStats,         PackageTypeEnv, PackageIfaceTable, emptyPackageIfaceTable,-        lookupIfaceByModule, emptyModIface, lookupHptByModule,+        lookupIfaceByModule, emptyPartialModIface, emptyFullModIface, lookupHptByModule,          PackageInstEnv, PackageFamInstEnv, PackageRuleBase,         PackageCompleteMatchMap,@@ -80,7 +86,8 @@         mkQualPackage, mkQualModule, pkgQual,          -- * Interfaces-        ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,+        ModIface, PartialModIface, ModIface_(..), ModIfaceBackend(..),+        mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,         emptyIfaceWarnCache, mi_boot, mi_fix,         mi_semantic_module,         mi_free_holes,@@ -216,6 +223,7 @@ import System.FilePath import Control.Concurrent import System.Process   ( ProcessHandle )+import Control.DeepSeq  -- ----------------------------------------------------------------------------- -- Compilation state@@ -223,11 +231,20 @@  -- | Status of a compilation to hard-code data HscStatus-    = HscNotGeneratingCode-    | HscUpToDate-    | HscUpdateBoot-    | HscUpdateSig-    | HscRecomp CgGuts ModSummary+    = HscNotGeneratingCode  -- ^ Nothing to do.+    | HscUpToDate           -- ^ Nothing to do because code already exists.+    | HscUpdateBoot         -- ^ Update boot file result.+    | HscUpdateSig          -- ^ Generate signature file (backpack)+    | HscRecomp             -- ^ Recompile this module.+        { hscs_guts       :: CgGuts+                            -- ^ Information for the code generator.+        , hscs_summary    :: ModSummary+                            -- ^ Module info+        , hscs_iface_gen  :: IO (ModIface, Bool)+                            -- ^ Action to generate iface after codegen.+        }+-- Should HscStatus contain the HomeModInfo?+-- All places where we return a status we also return a HomeModInfo.  -- ----------------------------------------------------------------------------- -- The Hsc monad: Passing an environment and warning state@@ -856,6 +873,86 @@ ************************************************************************ -} +{- Note [Interface file stages]+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Interface files have two possible stages.++* A partial stage built from the result of the core pipeline.+* A fully instantiated form. Which also includes fingerprints and+  potentially information provided by backends.++We can build a full interface file two ways:+* Directly from a partial one:+  Then we omit backend information and mostly compute fingerprints.+* From a partial one + information produced by a backend.+  Then we store the provided information and fingerprint both.+-}++type PartialModIface = ModIface_ 'ModIfaceCore+type ModIface = ModIface_ 'ModIfaceFinal++-- | Extends a PartialModIface with information which is either:+-- * Computed after codegen+-- * Or computed just before writing the iface to disk. (Hashes)+-- In order to fully instantiate it.+data ModIfaceBackend = ModIfaceBackend+  { mi_iface_hash :: !Fingerprint+    -- ^ Hash of the whole interface+  , mi_mod_hash :: !Fingerprint+    -- ^ Hash of the ABI only+  , mi_flag_hash :: !Fingerprint+    -- ^ Hash of the important flags used when compiling the module, excluding+    -- optimisation flags+  , mi_opt_hash :: !Fingerprint+    -- ^ Hash of optimisation flags+  , mi_hpc_hash :: !Fingerprint+    -- ^ Hash of hpc flags+  , mi_plugin_hash :: !Fingerprint+    -- ^ Hash of plugins+  , mi_orphan :: !WhetherHasOrphans+    -- ^ Whether this module has orphans+  , mi_finsts :: !WhetherHasFamInst+    -- ^ Whether this module has family instances. See Note [The type family+    -- instance consistency story].+  , mi_exp_hash :: !Fingerprint+    -- ^ Hash of export list+  , mi_orphan_hash :: !Fingerprint+    -- ^ Hash for orphan rules, class and family instances combined++    -- Cached environments for easy lookup. These are computed (lazily) from+    -- other fields and are not put into the interface file.+    -- Not really produced by the backend but there is no need to create them+    -- any earlier.+  , mi_warn_fn :: !(OccName -> Maybe WarningTxt)+    -- ^ Cached lookup for 'mi_warns'+  , mi_fix_fn :: !(OccName -> Maybe Fixity)+    -- ^ Cached lookup for 'mi_fixities'+  , mi_hash_fn :: !(OccName -> Maybe (OccName, Fingerprint))+    -- ^ Cached lookup for 'mi_decls'. The @Nothing@ in 'mi_hash_fn' means that+    -- the thing isn't in decls. It's useful to know that when seeing if we are+    -- up to date wrt. the old interface. The 'OccName' is the parent of the+    -- name, if it has one.+  }++data ModIfacePhase+  = ModIfaceCore+  -- ^ Partial interface built based on output of core pipeline.+  | ModIfaceFinal++-- | Selects a IfaceDecl representation.+-- For fully instantiated interfaces we also maintain+-- a fingerprint, which is used for recompilation checks.+type family IfaceDeclExts (phase :: ModIfacePhase) where+  IfaceDeclExts 'ModIfaceCore = IfaceDecl+  IfaceDeclExts 'ModIfaceFinal = (Fingerprint, IfaceDecl)++type family IfaceBackendExts (phase :: ModIfacePhase) where+  IfaceBackendExts 'ModIfaceCore = ()+  IfaceBackendExts 'ModIfaceFinal = ModIfaceBackend+++ -- | A 'ModIface' plus a 'ModDetails' summarises everything we know -- about a compiled module.  The 'ModIface' is the stuff *before* linking, -- and can be written out to an interface file. The 'ModDetails is after@@ -865,23 +962,11 @@ -- except that we explicitly make the 'mi_decls' and a few other fields empty; -- as when reading we consolidate the declarations etc. into a number of indexed -- maps and environments in the 'ExternalPackageState'.-data ModIface+data ModIface_ (phase :: ModIfacePhase)   = ModIface {         mi_module     :: !Module,             -- ^ Name of the module we are for         mi_sig_of     :: !(Maybe Module),     -- ^ Are we a sig of another mod?-        mi_iface_hash :: !Fingerprint,        -- ^ Hash of the whole interface-        mi_mod_hash   :: !Fingerprint,        -- ^ Hash of the ABI only-        mi_flag_hash  :: !Fingerprint,        -- ^ Hash of the important flags-                                              -- used when compiling the module,-                                              -- excluding optimisation flags-        mi_opt_hash   :: !Fingerprint,        -- ^ Hash of optimisation flags-        mi_hpc_hash   :: !Fingerprint,        -- ^ Hash of hpc flags-        mi_plugin_hash :: !Fingerprint,       -- ^ Hash of plugins -        mi_orphan     :: !WhetherHasOrphans,  -- ^ Whether this module has orphans-        mi_finsts     :: !WhetherHasFamInst,-                -- ^ Whether this module has family instances.-                -- See Note [The type family instance consistency story].         mi_hsc_src    :: !HscSource,          -- ^ Boot? Signature?          mi_deps     :: Dependencies,@@ -902,8 +987,6 @@                 -- Records the modules that are the declaration points for things                 -- exported by this module, and the 'OccName's of those things -        mi_exp_hash :: !Fingerprint,-                -- ^ Hash of export list          mi_used_th  :: !Bool,                 -- ^ Module required TH splices when it was compiled.@@ -922,7 +1005,7 @@                 -- NOT STRICT!  we read this field lazily from the interface file  -        mi_decls    :: [(Fingerprint,IfaceDecl)],+        mi_decls    :: [IfaceDeclExts phase],                 -- ^ Type, class and variable declarations                 -- The hash of an Id changes if its fixity or deprecations change                 --      (as well as its type of course)@@ -948,23 +1031,7 @@         mi_insts       :: [IfaceClsInst],     -- ^ Sorted class instance         mi_fam_insts   :: [IfaceFamInst],  -- ^ Sorted family instances         mi_rules       :: [IfaceRule],     -- ^ Sorted rules-        mi_orphan_hash :: !Fingerprint,    -- ^ Hash for orphan rules, class and family-                                           -- instances combined -                -- Cached environments for easy lookup-                -- These are computed (lazily) from other fields-                -- and are not put into the interface file-        mi_warn_fn   :: OccName -> Maybe WarningTxt,-                -- ^ Cached lookup for 'mi_warns'-        mi_fix_fn    :: OccName -> Maybe Fixity,-                -- ^ Cached lookup for 'mi_fixities'-        mi_hash_fn   :: OccName -> Maybe (OccName, Fingerprint),-                -- ^ Cached lookup for 'mi_decls'.-                -- The @Nothing@ in 'mi_hash_fn' means that the thing-                -- isn't in decls. It's useful to know that when-                -- seeing if we are up to date wrt. the old interface.-                -- The 'OccName' is the parent of the name, if it has one.-         mi_hpc       :: !AnyHpcUsage,                 -- ^ True if this program uses Hpc at any point in the program. @@ -986,8 +1053,12 @@         mi_decl_docs :: DeclDocMap,                 -- ^ Docs on declarations. -        mi_arg_docs :: ArgDocMap+        mi_arg_docs :: ArgDocMap,                 -- ^ Docs on arguments.++        mi_final_exts :: !(IfaceBackendExts phase)+                -- ^ Either `()` or `ModIfaceBackend` for+                -- a fully instantiated interface.      }  -- | Old-style accessor for whether or not the ModIface came from an hs-boot@@ -998,12 +1069,12 @@ -- | Lookups up a (possibly cached) fixity from a 'ModIface'. If one cannot be -- found, 'defaultFixity' is returned instead. mi_fix :: ModIface -> OccName -> Fixity-mi_fix iface name = mi_fix_fn iface name `orElse` defaultFixity+mi_fix iface name = mi_fix_fn (mi_final_exts iface) name `orElse` defaultFixity  -- | The semantic module for this interface; e.g., if it's a interface -- for a signature, if 'mi_module' is @p[A=<A>]:A@, 'mi_semantic_module' -- will be @<A>@.-mi_semantic_module :: ModIface -> Module+mi_semantic_module :: ModIface_ a -> Module mi_semantic_module iface = case mi_sig_of iface of                             Nothing -> mi_module iface                             Just mod -> mod@@ -1041,18 +1112,9 @@                  mi_module    = mod,                  mi_sig_of    = sig_of,                  mi_hsc_src   = hsc_src,-                 mi_iface_hash= iface_hash,-                 mi_mod_hash  = mod_hash,-                 mi_flag_hash = flag_hash,-                 mi_opt_hash  = opt_hash,-                 mi_hpc_hash  = hpc_hash,-                 mi_plugin_hash = plugin_hash,-                 mi_orphan    = orphan,-                 mi_finsts    = hasFamInsts,                  mi_deps      = deps,                  mi_usages    = usages,                  mi_exports   = exports,-                 mi_exp_hash  = exp_hash,                  mi_used_th   = used_th,                  mi_fixities  = fixities,                  mi_warns     = warns,@@ -1061,14 +1123,25 @@                  mi_insts     = insts,                  mi_fam_insts = fam_insts,                  mi_rules     = rules,-                 mi_orphan_hash = orphan_hash,                  mi_hpc       = hpc_info,                  mi_trust     = trust,                  mi_trust_pkg = trust_pkg,                  mi_complete_sigs = complete_sigs,                  mi_doc_hdr   = doc_hdr,                  mi_decl_docs = decl_docs,-                 mi_arg_docs  = arg_docs }) = do+                 mi_arg_docs  = arg_docs,+                 mi_final_exts = ModIfaceBackend {+                   mi_iface_hash = iface_hash,+                   mi_mod_hash = mod_hash,+                   mi_flag_hash = flag_hash,+                   mi_opt_hash = opt_hash,+                   mi_hpc_hash = hpc_hash,+                   mi_plugin_hash = plugin_hash,+                   mi_orphan = orphan,+                   mi_finsts = hasFamInsts,+                   mi_exp_hash = exp_hash,+                   mi_orphan_hash = orphan_hash+                 }}) = do         put_ bh mod         put_ bh sig_of         put_ bh hsc_src@@ -1137,18 +1210,9 @@                  mi_module      = mod,                  mi_sig_of      = sig_of,                  mi_hsc_src     = hsc_src,-                 mi_iface_hash  = iface_hash,-                 mi_mod_hash    = mod_hash,-                 mi_flag_hash   = flag_hash,-                 mi_opt_hash    = opt_hash,-                 mi_hpc_hash    = hpc_hash,-                 mi_plugin_hash = plugin_hash,-                 mi_orphan      = orphan,-                 mi_finsts      = hasFamInsts,                  mi_deps        = deps,                  mi_usages      = usages,                  mi_exports     = exports,-                 mi_exp_hash    = exp_hash,                  mi_used_th     = used_th,                  mi_anns        = anns,                  mi_fixities    = fixities,@@ -1158,40 +1222,41 @@                  mi_insts       = insts,                  mi_fam_insts   = fam_insts,                  mi_rules       = rules,-                 mi_orphan_hash = orphan_hash,                  mi_hpc         = hpc_info,                  mi_trust       = trust,                  mi_trust_pkg   = trust_pkg,                         -- And build the cached values-                 mi_warn_fn     = mkIfaceWarnCache warns,-                 mi_fix_fn      = mkIfaceFixCache fixities,-                 mi_hash_fn     = mkIfaceHashCache decls,                  mi_complete_sigs = complete_sigs,                  mi_doc_hdr     = doc_hdr,                  mi_decl_docs   = decl_docs,-                 mi_arg_docs    = arg_docs })+                 mi_arg_docs    = arg_docs,+                 mi_final_exts = ModIfaceBackend {+                   mi_iface_hash = iface_hash,+                   mi_mod_hash = mod_hash,+                   mi_flag_hash = flag_hash,+                   mi_opt_hash = opt_hash,+                   mi_hpc_hash = hpc_hash,+                   mi_plugin_hash = plugin_hash,+                   mi_orphan = orphan,+                   mi_finsts = hasFamInsts,+                   mi_exp_hash = exp_hash,+                   mi_orphan_hash = orphan_hash,+                   mi_warn_fn = mkIfaceWarnCache warns,+                   mi_fix_fn = mkIfaceFixCache fixities,+                   mi_hash_fn = mkIfaceHashCache decls+                 }})  -- | The original names declared of a certain module that are exported type IfaceExport = AvailInfo --- | Constructs an empty ModIface-emptyModIface :: Module -> ModIface-emptyModIface mod+emptyPartialModIface :: Module -> PartialModIface+emptyPartialModIface mod   = ModIface { mi_module      = mod,                mi_sig_of      = Nothing,-               mi_iface_hash  = fingerprint0,-               mi_mod_hash    = fingerprint0,-               mi_flag_hash   = fingerprint0,-               mi_opt_hash    = fingerprint0,-               mi_hpc_hash    = fingerprint0,-               mi_plugin_hash = fingerprint0,-               mi_orphan      = False,-               mi_finsts      = False,                mi_hsc_src     = HsSrcFile,                mi_deps        = noDependencies,                mi_usages      = [],                mi_exports     = [],-               mi_exp_hash    = fingerprint0,                mi_used_th     = False,                mi_fixities    = [],                mi_warns       = NoWarnings,@@ -1201,18 +1266,33 @@                mi_rules       = [],                mi_decls       = [],                mi_globals     = Nothing,-               mi_orphan_hash = fingerprint0,-               mi_warn_fn     = emptyIfaceWarnCache,-               mi_fix_fn      = emptyIfaceFixCache,-               mi_hash_fn     = emptyIfaceHashCache,                mi_hpc         = False,                mi_trust       = noIfaceTrustInfo,                mi_trust_pkg   = False,                mi_complete_sigs = [],                mi_doc_hdr     = Nothing,                mi_decl_docs   = emptyDeclDocMap,-               mi_arg_docs    = emptyArgDocMap }+               mi_arg_docs    = emptyArgDocMap,+               mi_final_exts        = () } +emptyFullModIface :: Module -> ModIface+emptyFullModIface mod =+    (emptyPartialModIface mod)+      { mi_decls = []+      , mi_final_exts = ModIfaceBackend+        { mi_iface_hash = fingerprint0,+          mi_mod_hash = fingerprint0,+          mi_flag_hash = fingerprint0,+          mi_opt_hash = fingerprint0,+          mi_hpc_hash = fingerprint0,+          mi_plugin_hash = fingerprint0,+          mi_orphan = False,+          mi_finsts = False,+          mi_exp_hash = fingerprint0,+          mi_orphan_hash = fingerprint0,+          mi_warn_fn = emptyIfaceWarnCache,+          mi_fix_fn = emptyIfaceFixCache,+          mi_hash_fn = emptyIfaceHashCache } }  -- | Constructs cache for the 'mi_hash_fn' field of a 'ModIface' mkIfaceHashCache :: [(Fingerprint,IfaceDecl)]@@ -3153,3 +3233,14 @@   Phase.As _         -> Just LangAsm   Phase.MergeForeign -> Just RawObject   _                  -> Nothing++-------------------------------------------++-- Take care, this instance only forces to the degree necessary to+-- avoid major space leaks.+instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where+  rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12+                f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23) =+    rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq`+    f9 `seq` rnf f10 `seq` rnf f11 `seq` f12 `seq` rnf f13 `seq` rnf f14 `seq` rnf f15 `seq`+    rnf f16 `seq` f17 `seq` rnf f18 `seq` rnf f19 `seq` f20 `seq` f21 `seq` f22 `seq` rnf f23

@@ -469,7 +469,7 @@ -- 'pkgState' in 'DynFlags' and return a list of packages to -- link in. initPackages :: DynFlags -> IO (DynFlags, [PreloadUnitId])-initPackages dflags0 = withTiming (return dflags0)+initPackages dflags0 = withTiming dflags0                                   (text "initializing package database")                                   forcePkgDb $ do   dflags <- interpretPackageEnv dflags0

@@ -92,6 +92,13 @@   , holeFitPlugin :: HoleFitPlugin     -- ^ An optional plugin to handle hole fits, which may re-order     --   or change the list of valid hole fits and refinement hole fits.+  , dynflagsPlugin :: [CommandLineOption] -> DynFlags -> IO DynFlags+    -- ^ An optional plugin to update 'DynFlags', right after+    --   plugin loading. This can be used to register hooks+    --   or tweak any field of 'DynFlags' before doing+    --   actual work on a module.+    --+    --   @since 8.10.1   , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile     -- ^ Specify how the plugin should affect recompilation.   , parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule@@ -201,6 +208,7 @@         installCoreToDos      = const return       , tcPlugin              = const Nothing       , holeFitPlugin         = const Nothing+      , dynflagsPlugin        = const return       , pluginRecompile       = impurePlugin       , renamedResultAction   = \_ env grp -> return (env, grp)       , parsedResultAction    = \_ _ -> return

@@ -14,6 +14,7 @@ module SysTools.BaseDir   ( expandTopDir, expandToolDir   , findTopDir, findToolDir+  , tryFindTopDir   ) where  #include "HsVersions.h"@@ -88,23 +89,28 @@ -- | Returns a Unix-format path pointing to TopDir. findTopDir :: Maybe String -- Maybe TopDir path (without the '-B' prefix).            -> IO String    -- TopDir (in Unix format '/' separated)-findTopDir (Just minusb) = return (normalise minusb)-findTopDir Nothing+findTopDir m_minusb = do+  maybe_exec_dir <- tryFindTopDir m_minusb+  case maybe_exec_dir of+      -- "Just" on Windows, "Nothing" on unix+      Nothing -> throwGhcExceptionIO $+          InstallationError "missing -B<dir> option"+      Just dir -> return dir++tryFindTopDir+  :: Maybe String -- ^ Maybe TopDir path (without the '-B' prefix).+  -> IO (Maybe String) -- ^ TopDir (in Unix format '/' separated)+tryFindTopDir (Just minusb) = return $ Just $ normalise minusb+tryFindTopDir Nothing     = do -- The _GHC_TOP_DIR environment variable can be used to specify          -- the top dir when the -B argument is not specified. It is not          -- intended for use by users, it was added specifically for the          -- purpose of running GHC within GHCi.          maybe_env_top_dir <- lookupEnv "_GHC_TOP_DIR"          case maybe_env_top_dir of-             Just env_top_dir -> return env_top_dir-             Nothing -> do-                 -- Get directory of executable-                 maybe_exec_dir <- getBaseDir-                 case maybe_exec_dir of-                     -- "Just" on Windows, "Nothing" on unix-                     Nothing -> throwGhcExceptionIO $-                         InstallationError "missing -B<dir> option"-                     Just dir -> return dir+             Just env_top_dir -> return $ Just env_top_dir+             -- Try directory of executable+             Nothing -> getBaseDir   -- See Note [tooldir: How GHC finds mingw and perl on Windows]

@@ -2102,7 +2102,7 @@      ; return (cL l hsHoleExpr) }  hsHoleExpr :: HsExpr (GhcPass id)-hsHoleExpr = HsUnboundVar noExtField (TrueExprHole (mkVarOcc "_"))+hsHoleExpr = HsUnboundVar noExtField (mkVarOcc "_")  -- | See Note [Ambiguous syntactic categories] and Note [PatBuilder] data PatBuilder p

@@ -3,9 +3,9 @@ places in the GHC library. */ -#include "Rts.h"+#include <Rts.h> -#include "HsFFI.h"+#include <HsFFI.h>  void ghc_lib_parser_enableTimingStats( void )       /* called from the driver */

@@ -24,7 +24,6 @@ where  #include "HsVersions.h"-#include "../includes/MachDeps.h"  import GhcPrelude 

@@ -81,6 +81,7 @@         eqPrimTyCon,            -- ty1 ~# ty2         eqReprPrimTyCon,        -- ty1 ~R# ty2  (at role Representational)         eqPhantPrimTyCon,       -- ty1 ~P# ty2  (at role Phantom)+        equalityTyCon,          -- * SIMD #include "primop-vector-tys-exports.hs-incl"@@ -918,6 +919,12 @@     binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] id     res_kind = unboxedTupleKind []     roles    = [Nominal, Nominal, Phantom, Phantom]++-- | Given a Role, what TyCon is the type of equality predicates at that role?+equalityTyCon :: Role -> TyCon+equalityTyCon Nominal          = eqPrimTyCon+equalityTyCon Representational = eqReprPrimTyCon+equalityTyCon Phantom          = eqPhantPrimTyCon  {- ********************************************************************* *                                                                      *

@@ -68,7 +68,7 @@         justDataCon, justDataConName, promotedJustDataCon,          -- * Tuples-        mkTupleTy, mkBoxedTupleTy,+        mkTupleTy, mkTupleTy1, mkBoxedTupleTy,         tupleTyCon, tupleDataCon, tupleTyConName,         promotedTupleDataCon,         unitTyCon, unitDataCon, unitDataConId, unitTy, unitTyConKey,@@ -92,7 +92,8 @@          -- * Kinds         typeNatKindCon, typeNatKind, typeSymbolKindCon, typeSymbolKind,-        isLiftedTypeKindTyConName, liftedTypeKind, constraintKind,+        isLiftedTypeKindTyConName, liftedTypeKind,+        typeToTypeKind, constraintKind,         liftedTypeKindTyCon, constraintKindTyCon,  constraintKindTyConName,         liftedTypeKindTyConName, @@ -127,7 +128,6 @@     ) where  #include "HsVersions.h"-#include "MachDeps.h"  import GhcPrelude @@ -613,8 +613,9 @@ constraintKindTyCon :: TyCon constraintKindTyCon = pcTyCon constraintKindTyConName Nothing [] [] -liftedTypeKind, constraintKind :: Kind+liftedTypeKind, typeToTypeKind, constraintKind :: Kind liftedTypeKind   = tYPE liftedRepTy+typeToTypeKind   = liftedTypeKind `mkVisFunTy` liftedTypeKind constraintKind   = mkTyConApp constraintKindTyCon []  {-@@ -695,9 +696,18 @@   data Unit a = Unit a   data (a,b)  = (a,b) +There is no way to write a boxed one-tuple in Haskell, but it can be+created in Template Haskell or in, e.g., `deriving` code. There is+nothing special about one-tuples in Core; in particular, they have no+custom pretty-printing, just using `Unit`.+ NB (Feb 16): for /constraint/ one-tuples I have 'Unit%' but no class decl in GHC.Classes, so I think this part may not work properly. But it's unused I think.++See also Note [Flattening one-tuples] in MkCore and+Note [Don't flatten tuples from HsSyn] in MkCore.+ -}  -- | Built-in syntax isn't "in scope" so these OccNames map to wired-in Names@@ -1483,6 +1493,7 @@                 False                 (VanillaAlgTyCon $ mkPrelTyConRepName listTyConName) +-- See also Note [Empty lists] in GHC.Hs.Expr. nilDataCon :: DataCon nilDataCon  = pcDataCon nilDataConName alpha_tyvar [] listTyCon @@ -1556,15 +1567,24 @@ -}  -- | Make a tuple type. The list of types should /not/ include any--- RuntimeRep specifications.+-- RuntimeRep specifications. Boxed 1-tuples are flattened.+-- See Note [One-tuples] mkTupleTy :: Boxity -> [Type] -> Type -- Special case for *boxed* 1-tuples, which are represented by the type itself mkTupleTy Boxed   [ty] = ty-mkTupleTy Boxed   tys  = mkTyConApp (tupleTyCon Boxed (length tys)) tys-mkTupleTy Unboxed tys  = mkTyConApp (tupleTyCon Unboxed (length tys))-                                        (map getRuntimeRep tys ++ tys)+mkTupleTy boxity  tys  = mkTupleTy1 boxity tys +-- | Make a tuple type. The list of types should /not/ include any+-- RuntimeRep specifications. Boxed 1-tuples are *not* flattened.+-- See Note [One-tuples] and Note [Don't flatten tuples from HsSyn]+-- in MkCore+mkTupleTy1 :: Boxity -> [Type] -> Type+mkTupleTy1 Boxed   tys  = mkTyConApp (tupleTyCon Boxed (length tys)) tys+mkTupleTy1 Unboxed tys  = mkTyConApp (tupleTyCon Unboxed (length tys))+                                         (map getRuntimeRep tys ++ tys)+ -- | Build the type of a small tuple that holds the specified type of thing+-- Flattens 1-tuples. See Note [One-tuples]. mkBoxedTupleTy :: [Type] -> Type mkBoxedTupleTy tys = mkTupleTy Boxed tys 

@@ -40,7 +40,8 @@                           stripTicksTopT, stripTicksTopE,                           isJoinBind ) import PprCore          ( pprRules )-import Type             ( Type, Kind, substTy, mkTCvSubst )+import Type             ( Type, TCvSubst, extendTvSubst, extendCvSubst+                        , mkEmptyTCvSubst, substTy ) import TcType           ( tcSplitTyConApp_maybe ) import TysWiredIn       ( anyTypeOfKind ) import Coercion@@ -448,8 +449,9 @@ isMoreSpecific (BuiltinRule {}) _                = False isMoreSpecific (Rule {})        (BuiltinRule {}) = True isMoreSpecific (Rule { ru_bndrs = bndrs1, ru_args = args1 })-               (Rule { ru_bndrs = bndrs2, ru_args = args2, ru_name = rule_name2 })-  = isJust (matchN (in_scope, id_unfolding_fun) rule_name2 bndrs2 args2 args1)+               (Rule { ru_bndrs = bndrs2, ru_args = args2+                     , ru_name = rule_name2, ru_rhs = rhs })+  = isJust (matchN (in_scope, id_unfolding_fun) rule_name2 bndrs2 args2 args1 rhs)   where    id_unfolding_fun _ = NoUnfolding     -- Don't expand in templates    in_scope = mkInScopeSet (mkVarSet bndrs1)@@ -516,29 +518,26 @@                 , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs })   | not (is_active act)               = Nothing   | ruleCantMatch tpl_tops rough_args = Nothing-  | otherwise-  = case matchN in_scope rule_name tpl_vars tpl_args args of-        Nothing                       -> Nothing-        Just (bind_wrapper, tpl_vals) -> Just (bind_wrapper $-                                               rule_fn `mkApps` tpl_vals)-  where-    rule_fn = mkLams tpl_vars rhs+  | otherwise = matchN in_scope rule_name tpl_vars tpl_args args rhs  --------------------------------------- matchN  :: InScopeEnv         -> RuleName -> [Var] -> [CoreExpr]-        -> [CoreExpr]           -- ^ Target; can have more elements than the template-        -> Maybe (BindWrapper,  -- Floated bindings; see Note [Matching lets]-                  [CoreExpr])+        -> [CoreExpr] -> CoreExpr           -- ^ Target; can have more elements than the template+        -> Maybe CoreExpr -- For a given match template and context, find bindings to wrap around -- the entire result and what should be substituted for each template variable. -- Fail if there are two few actual arguments from the target to match the template -matchN (in_scope, id_unf) rule_name tmpl_vars tmpl_es target_es-  = do  { subst <- go init_menv emptyRuleSubst tmpl_es target_es-        ; let (_, matched_es) = mapAccumL lookup_tmpl subst $+matchN (in_scope, id_unf) rule_name tmpl_vars tmpl_es target_es rhs+  = do  { rule_subst <- go init_menv emptyRuleSubst tmpl_es target_es+        ; let (_, matched_es) = mapAccumL (lookup_tmpl rule_subst)+                                          (mkEmptyTCvSubst in_scope) $                                 tmpl_vars `zip` tmpl_vars1-        ; return (rs_binds subst, matched_es) }+              bind_wrapper = rs_binds rule_subst+                             -- Floated bindings; see Note [Matching lets]+       ; return (bind_wrapper $+                 mkLams tmpl_vars rhs `mkApps` matched_es) }   where     (init_rn_env, tmpl_vars1) = mapAccumL rnBndrL (mkRnEnv2 in_scope) tmpl_vars                   -- See Note [Cloning the template binders]@@ -553,29 +552,32 @@     go menv subst (t:ts) (e:es) = do { subst1 <- match menv subst t e                                      ; go menv subst1 ts es } -    lookup_tmpl :: RuleSubst -> (InVar,OutVar) -> (RuleSubst, CoreExpr)+    lookup_tmpl :: RuleSubst -> TCvSubst -> (InVar,OutVar) -> (TCvSubst, CoreExpr)                    -- Need to return a RuleSubst solely for the benefit of mk_fake_ty-    lookup_tmpl rs@(RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst })-                (tmpl_var, tmpl_var1)+    lookup_tmpl (RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst })+                tcv_subst (tmpl_var, tmpl_var1)         | isId tmpl_var1         = case lookupVarEnv id_subst tmpl_var1 of-             Just e -> (rs, e)-             Nothing | Just refl_co <- isReflCoVar_maybe tmpl_var1-                     , let co_expr   = Coercion refl_co-                           id_subst' = extendVarEnv id_subst tmpl_var1 co_expr-                           rs'       = rs { rs_id_subst = id_subst' }-                     -> (rs', co_expr) -- See Note [Unbound RULE binders]-                     | otherwise-                     -> unbound tmpl_var+            Just e | Coercion co <- e+                   -> (Type.extendCvSubst tcv_subst tmpl_var1 co, Coercion co)+                   | otherwise+                   -> (tcv_subst, e)+            Nothing | Just refl_co <- isReflCoVar_maybe tmpl_var1+                    , let co = Coercion.substCo tcv_subst refl_co+                    -> -- See Note [Unbound RULE binders]+                       (Type.extendCvSubst tcv_subst tmpl_var1 co, Coercion co)+                    | otherwise+                    -> unbound tmpl_var+         | otherwise-        = case lookupVarEnv tv_subst tmpl_var1 of-             Just ty -> (rs, Type ty)-             Nothing -> (rs', Type fake_ty) -- See Note [Unbound RULE binders]+        = (Type.extendTvSubst tcv_subst tmpl_var1 ty', Type ty')         where-          rs'     = rs { rs_tv_subst = extendVarEnv tv_subst tmpl_var1 fake_ty }-          fake_ty = mk_fake_ty in_scope rs tmpl_var1-                    -- This call is the sole reason we accumulate-                    -- RuleSubst in lookup_tmpl+          ty' = case lookupVarEnv tv_subst tmpl_var1 of+                  Just ty -> ty+                  Nothing -> fake_ty   -- See Note [Unbound RULE binders]+          fake_ty = anyTypeOfKind (Type.substTy tcv_subst (tyVarKind tmpl_var1))+                    -- This substitution is the sole reason we accumulate+                    -- TCvSubst in lookup_tmpl      unbound tmpl_var        = pprPanic "Template variable unbound in rewrite rule" $@@ -586,33 +588,6 @@               , text "Actual args:" <+> ppr target_es ]  -mk_fake_ty :: InScopeSet -> RuleSubst -> TyVar -> Kind--- Roughly:---    mk_fake_ty subst tv = Any @(subst (tyVarKind tv))--- That is: apply the substitution to the kind of the given tyvar,--- and make an 'any' type of that kind.--- Tiresomely, the RuleSubst is not well adapted to substTy, leading to--- horrible impedence matching.------ Happily, this function is seldom called-mk_fake_ty in_scope (RS { rs_tv_subst = tv_subst, rs_id_subst = id_subst }) tmpl_var1-  = anyTypeOfKind kind-  where-    kind = Type.substTy (mkTCvSubst in_scope (tv_subst, cv_subst))-                        (tyVarKind tmpl_var1)--    cv_subst = to_co_env id_subst--    to_co_env :: IdSubstEnv -> CvSubstEnv-    to_co_env env = nonDetFoldUFM_Directly to_co emptyVarEnv env-      -- It's OK to use nonDetFoldUFM_Directly because we forget the-      -- order immediately by creating a new env--    to_co uniq expr env-      = case exprToCoercion_maybe expr of-          Just co -> extendVarEnv_Directly env uniq co-          Nothing -> env- {- Note [Unbound RULE binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It can be the case that the binder in a rule is not actually@@ -643,7 +618,7 @@   Now, if that binding is inlined, so that a=b=Int, we'd get     RULE forall (c :: Int~Int). f (x |> c) = e   and now when we simplify the LHS (Simplify.simplRule) we-  optCoercion will turn that 'c' into Refl:+  optCoercion (look at the CoVarCo case) will turn that 'c' into Refl:     RULE forall (c :: Int~Int). f (x |> <Int>) = e   and then perhaps drop it altogether.  Now 'c' is unbound. @@ -654,7 +629,6 @@    This actually happened (in a RULE for a local function)   in #13410, and also in test T10602.-  Note [Cloning the template binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

@@ -0,0 +1,1824 @@+{-++This module defines types and simple operations over constraints,+as used in the type-checker and constraint solver.++-}++{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}++module Constraint (+        -- QCInst+        QCInst(..), isPendingScInst,++        -- Canonical constraints+        Xi, Ct(..), Cts, emptyCts, andCts, andManyCts, pprCts,+        singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList,+        isEmptyCts, isCTyEqCan, isCFunEqCan,+        isPendingScDict, superClassesMightHelp, getPendingWantedScs,+        isCDictCan_Maybe, isCFunEqCan_maybe,+        isCNonCanonical, isWantedCt, isDerivedCt,+        isGivenCt, isHoleCt, isOutOfScopeCt, isExprHoleCt, isTypeHoleCt,+        isUserTypeErrorCt, getUserTypeErrorMsg,+        ctEvidence, ctLoc, setCtLoc, ctPred, ctFlavour, ctEqRel, ctOrigin,+        ctEvId, mkTcEqPredLikeEv,+        mkNonCanonical, mkNonCanonicalCt, mkGivens,+        mkIrredCt, mkInsolubleCt,+        ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel,+        ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId,+        tyCoVarsOfCt, tyCoVarsOfCts,+        tyCoVarsOfCtList, tyCoVarsOfCtsList,++        WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,+        isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC,+        addInsols, insolublesOnly, addSimples, addImplics,+        tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples,+        tyCoVarsOfWCList, insolubleCt, insolubleEqCt,+        isDroppableCt, insolubleImplic,+        arisesFromGivens,++        Implication(..), implicationPrototype,+        ImplicStatus(..), isInsolubleStatus, isSolvedStatus,+        SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,+        bumpSubGoalDepth, subGoalDepthExceeded,+        CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,+        ctLocTypeOrKind_maybe,+        ctLocDepth, bumpCtLocDepth, isGivenLoc,+        setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,+        pprCtLoc,++        -- CtEvidence+        CtEvidence(..), TcEvDest(..),+        mkKindLoc, toKindLoc, mkGivenLoc,+        isWanted, isGiven, isDerived, isGivenOrWDeriv,+        ctEvRole,++        wrapType, wrapTypeWithImplication,++        CtFlavour(..), ShadowInfo(..), ctEvFlavour,+        CtFlavourRole, ctEvFlavourRole, ctFlavourRole,+        eqCanRewrite, eqCanRewriteFR, eqMayRewriteFR,+        eqCanDischargeFR,+        funEqCanDischarge, funEqCanDischargeF,++        -- Pretty printing+        pprEvVarTheta,+        pprEvVars, pprEvVarWithType,++        -- holes+        HoleSort(..),++  )+  where++#include "HsVersions.h"++import GhcPrelude++import {-# SOURCE #-} TcRnTypes ( TcLclEnv, setLclEnvTcLevel, getLclEnvTcLevel+                                , setLclEnvLoc, getLclEnvLoc )++import Predicate+import Type+import Coercion+import Class+import TyCon+import Var+import Id++import TcType+import TcEvidence+import TcOrigin++import CoreSyn++import OccName+import FV+import VarSet+import DynFlags+import BasicTypes++import Outputable+import SrcLoc+import Bag+import Util++import Control.Monad ( msum )++{-+************************************************************************+*                                                                      *+*                       Canonical constraints                          *+*                                                                      *+*   These are the constraints the low-level simplifier works with      *+*                                                                      *+************************************************************************+-}++-- The syntax of xi (ξ) types:+-- xi ::= a | T xis | xis -> xis | ... | forall a. tau+-- Two important notes:+--      (i) No type families, unless we are under a ForAll+--      (ii) Note that xi types can contain unexpanded type synonyms;+--           however, the (transitive) expansions of those type synonyms+--           will not contain any type functions, unless we are under a ForAll.+-- We enforce the structure of Xi types when we flatten (TcCanonical)++type Xi = Type       -- In many comments, "xi" ranges over Xi++type Cts = Bag Ct++data Ct+  -- Atomic canonical constraints+  = CDictCan {  -- e.g.  Num xi+      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]++      cc_class  :: Class,+      cc_tyargs :: [Xi],   -- cc_tyargs are function-free, hence Xi++      cc_pend_sc :: Bool   -- See Note [The superclass story] in TcCanonical+                           -- True <=> (a) cc_class has superclasses+                           --          (b) we have not (yet) added those+                           --              superclasses as Givens+    }++  | CIrredCan {  -- These stand for yet-unusable predicates+      cc_ev    :: CtEvidence,   -- See Note [Ct/evidence invariant]+      cc_insol :: Bool   -- True  <=> definitely an error, can never be solved+                         -- False <=> might be soluble++        -- For the might-be-soluble case, the ctev_pred of the evidence is+        -- of form   (tv xi1 xi2 ... xin)   with a tyvar at the head+        --      or   (tv1 ~ ty2)   where the CTyEqCan  kind invariant fails+        --      or   (F tys ~ ty)  where the CFunEqCan kind invariant fails+        -- See Note [CIrredCan constraints]++        -- The definitely-insoluble case is for things like+        --    Int ~ Bool      tycons don't match+        --    a ~ [a]         occurs check+    }++  | CTyEqCan {  -- tv ~ rhs+       -- Invariants:+       --   * See Note [inert_eqs: the inert equalities] in TcSMonad+       --   * tv not in tvs(rhs)   (occurs check)+       --   * If tv is a TauTv, then rhs has no foralls+       --       (this avoids substituting a forall for the tyvar in other types)+       --   * tcTypeKind ty `tcEqKind` tcTypeKind tv; Note [Ct kind invariant]+       --   * rhs may have at most one top-level cast+       --   * rhs (perhaps under the one cast) is *almost function-free*,+       --       See Note [Almost function-free]+       --   * If the equality is representational, rhs has no top-level newtype+       --     See Note [No top-level newtypes on RHS of representational+       --     equalities] in TcCanonical+       --   * If rhs (perhaps under the cast) is also a tv, then it is oriented+       --     to give best chance of+       --     unification happening; eg if rhs is touchable then lhs is too+      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]+      cc_tyvar  :: TcTyVar,+      cc_rhs    :: TcType,     -- Not necessarily function-free (hence not Xi)+                               -- See invariants above++      cc_eq_rel :: EqRel       -- INVARIANT: cc_eq_rel = ctEvEqRel cc_ev+    }++  | CFunEqCan {  -- F xis ~ fsk+       -- Invariants:+       --   * isTypeFamilyTyCon cc_fun+       --   * tcTypeKind (F xis) = tyVarKind fsk; Note [Ct kind invariant]+       --   * always Nominal role+      cc_ev     :: CtEvidence,  -- See Note [Ct/evidence invariant]+      cc_fun    :: TyCon,       -- A type function++      cc_tyargs :: [Xi],        -- cc_tyargs are function-free (hence Xi)+        -- Either under-saturated or exactly saturated+        --    *never* over-saturated (because if so+        --    we should have decomposed)++      cc_fsk    :: TcTyVar  -- [G]  always a FlatSkolTv+                            -- [W], [WD], or [D] always a FlatMetaTv+        -- See Note [The flattening story] in TcFlatten+    }++  | CNonCanonical {        -- See Note [NonCanonical Semantics] in TcSMonad+      cc_ev  :: CtEvidence+    }++  | CHoleCan {             -- See Note [Hole constraints]+       -- Treated as an "insoluble" constraint+       -- See Note [Insoluble constraints]+      cc_ev   :: CtEvidence,+      cc_occ  :: OccName,   -- The name of this hole+      cc_hole :: HoleSort   -- The sort of this hole (expr, type, ...)+    }++  | CQuantCan QCInst       -- A quantified constraint+      -- NB: I expect to make more of the cases in Ct+      --     look like this, with the payload in an+      --     auxiliary type++------------+data QCInst  -- A much simplified version of ClsInst+             -- See Note [Quantified constraints] in TcCanonical+  = QCI { qci_ev   :: CtEvidence -- Always of type forall tvs. context => ty+                                 -- Always Given+        , qci_tvs  :: [TcTyVar]  -- The tvs+        , qci_pred :: TcPredType -- The ty+        , qci_pend_sc :: Bool    -- Same as cc_pend_sc flag in CDictCan+                                 -- Invariant: True => qci_pred is a ClassPred+    }++instance Outputable QCInst where+  ppr (QCI { qci_ev = ev }) = ppr ev++------------+-- | Used to indicate which sort of hole we have.+data HoleSort = ExprHole+                 -- ^ Either an out-of-scope variable or a "true" hole in an+                 -- expression (TypedHoles)+              | TypeHole+                 -- ^ A hole in a type (PartialTypeSignatures)++{- Note [Hole constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~+CHoleCan constraints are used for two kinds of holes,+distinguished by cc_hole:++  * For holes in expressions+    e.g.   f x = g _ x++  * For holes in type signatures+    e.g.   f :: _ -> _+           f x = [x,True]++Note [CIrredCan constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+CIrredCan constraints are used for constraints that are "stuck"+   - we can't solve them (yet)+   - we can't use them to solve other constraints+   - but they may become soluble if we substitute for some+     of the type variables in the constraint++Example 1:  (c Int), where c :: * -> Constraint.  We can't do anything+            with this yet, but if later c := Num, *then* we can solve it++Example 2:  a ~ b, where a :: *, b :: k, where k is a kind variable+            We don't want to use this to substitute 'b' for 'a', in case+            'k' is subsequently unifed with (say) *->*, because then+            we'd have ill-kinded types floating about.  Rather we want+            to defer using the equality altogether until 'k' get resolved.++Note [Ct/evidence invariant]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+If  ct :: Ct, then extra fields of 'ct' cache precisely the ctev_pred field+of (cc_ev ct), and is fully rewritten wrt the substitution.   Eg for CDictCan,+   ctev_pred (cc_ev ct) = (cc_class ct) (cc_tyargs ct)+This holds by construction; look at the unique place where CDictCan is+built (in TcCanonical).++In contrast, the type of the evidence *term* (ctev_dest / ctev_evar) in+the evidence may *not* be fully zonked; we are careful not to look at it+during constraint solving. See Note [Evidence field of CtEvidence].++Note [Ct kind invariant]+~~~~~~~~~~~~~~~~~~~~~~~~+CTyEqCan and CFunEqCan both require that the kind of the lhs matches the kind+of the rhs. This is necessary because both constraints are used for substitutions+during solving. If the kinds differed, then the substitution would take a well-kinded+type to an ill-kinded one.++Note [Almost function-free]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+A type is *almost function-free* if it has no type functions (something that+responds True to isTypeFamilyTyCon), except (possibly)+ * under a forall, or+ * in a coercion (either in a CastTy or a CercionTy)++The RHS of a CTyEqCan must be almost function-free. This is for two reasons:++1. There cannot be a top-level function. If there were, the equality should+   really be a CFunEqCan, not a CTyEqCan.++2. Nested functions aren't too bad, on the other hand. However, consider this+   scenario:++     type family F a = r | r -> a++     [D] F ty1 ~ fsk1+     [D] F ty2 ~ fsk2+     [D] fsk1 ~ [G Int]+     [D] fsk2 ~ [G Bool]++     type instance G Int = Char+     type instance G Bool = Char++   If it was the case that fsk1 = fsk2, then we could unifty ty1 and ty2 --+   good! They don't look equal -- but if we aggressively reduce that G Int and+   G Bool they would become equal. The "almost function free" makes sure that+   these redexes are exposed.++   Note that this equality does *not* depend on casts or coercions, and so+   skipping these forms is OK. In addition, the result of a type family cannot+   be a polytype, so skipping foralls is OK, too. We skip foralls because we+   want the output of the flattener to be almost function-free. See Note+   [Flattening under a forall] in TcFlatten.++   As I (Richard E) write this, it is unclear if the scenario pictured above+   can happen -- I would expect the G Int and G Bool to be reduced. But+   perhaps it can arise somehow, and maintaining almost function-free is cheap.++Historical note: CTyEqCans used to require only condition (1) above: that no+type family was at the top of an RHS. But work on #16512 suggested that the+injectivity checks were not complete, and adding the requirement that functions+do not appear even in a nested fashion was easy (it was already true, but+unenforced).++The almost-function-free property is checked by isAlmostFunctionFree in TcType.+The flattener (in TcFlatten) produces types that are almost function-free.++-}++mkNonCanonical :: CtEvidence -> Ct+mkNonCanonical ev = CNonCanonical { cc_ev = ev }++mkNonCanonicalCt :: Ct -> Ct+mkNonCanonicalCt ct = CNonCanonical { cc_ev = cc_ev ct }++mkIrredCt :: CtEvidence -> Ct+mkIrredCt ev = CIrredCan { cc_ev = ev, cc_insol = False }++mkInsolubleCt :: CtEvidence -> Ct+mkInsolubleCt ev = CIrredCan { cc_ev = ev, cc_insol = True }++mkGivens :: CtLoc -> [EvId] -> [Ct]+mkGivens loc ev_ids+  = map mk ev_ids+  where+    mk ev_id = mkNonCanonical (CtGiven { ctev_evar = ev_id+                                       , ctev_pred = evVarPred ev_id+                                       , ctev_loc = loc })++ctEvidence :: Ct -> CtEvidence+ctEvidence (CQuantCan (QCI { qci_ev = ev })) = ev+ctEvidence ct = cc_ev ct++ctLoc :: Ct -> CtLoc+ctLoc = ctEvLoc . ctEvidence++setCtLoc :: Ct -> CtLoc -> Ct+setCtLoc ct loc = ct { cc_ev = (cc_ev ct) { ctev_loc = loc } }++ctOrigin :: Ct -> CtOrigin+ctOrigin = ctLocOrigin . ctLoc++ctPred :: Ct -> PredType+-- See Note [Ct/evidence invariant]+ctPred ct = ctEvPred (ctEvidence ct)++ctEvId :: Ct -> EvVar+-- The evidence Id for this Ct+ctEvId ct = ctEvEvId (ctEvidence ct)++-- | Makes a new equality predicate with the same role as the given+-- evidence.+mkTcEqPredLikeEv :: CtEvidence -> TcType -> TcType -> TcType+mkTcEqPredLikeEv ev+  = case predTypeEqRel pred of+      NomEq  -> mkPrimEqPred+      ReprEq -> mkReprPrimEqPred+  where+    pred = ctEvPred ev++-- | Get the flavour of the given 'Ct'+ctFlavour :: Ct -> CtFlavour+ctFlavour = ctEvFlavour . ctEvidence++-- | Get the equality relation for the given 'Ct'+ctEqRel :: Ct -> EqRel+ctEqRel = ctEvEqRel . ctEvidence++instance Outputable Ct where+  ppr ct = ppr (ctEvidence ct) <+> parens pp_sort+    where+      pp_sort = case ct of+         CTyEqCan {}      -> text "CTyEqCan"+         CFunEqCan {}     -> text "CFunEqCan"+         CNonCanonical {} -> text "CNonCanonical"+         CDictCan { cc_pend_sc = pend_sc }+            | pend_sc   -> text "CDictCan(psc)"+            | otherwise -> text "CDictCan"+         CIrredCan { cc_insol = insol }+            | insol     -> text "CIrredCan(insol)"+            | otherwise -> text "CIrredCan(sol)"+         CHoleCan { cc_occ = occ } -> text "CHoleCan:" <+> ppr occ+         CQuantCan (QCI { qci_pend_sc = pend_sc })+            | pend_sc   -> text "CQuantCan(psc)"+            | otherwise -> text "CQuantCan"++{-+************************************************************************+*                                                                      *+        Simple functions over evidence variables+*                                                                      *+************************************************************************+-}++---------------- Getting free tyvars -------------------------++-- | Returns free variables of constraints as a non-deterministic set+tyCoVarsOfCt :: Ct -> TcTyCoVarSet+tyCoVarsOfCt = fvVarSet . tyCoFVsOfCt++-- | Returns free variables of constraints as a deterministically ordered.+-- list. See Note [Deterministic FV] in FV.+tyCoVarsOfCtList :: Ct -> [TcTyCoVar]+tyCoVarsOfCtList = fvVarList . tyCoFVsOfCt++-- | Returns free variables of constraints as a composable FV computation.+-- See Note [Deterministic FV] in FV.+tyCoFVsOfCt :: Ct -> FV+tyCoFVsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })+  = tyCoFVsOfType xi `unionFV` FV.unitFV tv+                     `unionFV` tyCoFVsOfType (tyVarKind tv)+tyCoFVsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk })+  = tyCoFVsOfTypes tys `unionFV` FV.unitFV fsk+                       `unionFV` tyCoFVsOfType (tyVarKind fsk)+tyCoFVsOfCt (CDictCan { cc_tyargs = tys }) = tyCoFVsOfTypes tys+tyCoFVsOfCt ct = tyCoFVsOfType (ctPred ct)++-- | Returns free variables of a bag of constraints as a non-deterministic+-- set. See Note [Deterministic FV] in FV.+tyCoVarsOfCts :: Cts -> TcTyCoVarSet+tyCoVarsOfCts = fvVarSet . tyCoFVsOfCts++-- | Returns free variables of a bag of constraints as a deterministically+-- odered list. See Note [Deterministic FV] in FV.+tyCoVarsOfCtsList :: Cts -> [TcTyCoVar]+tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts++-- | Returns free variables of a bag of constraints as a composable FV+-- computation. See Note [Deterministic FV] in FV.+tyCoFVsOfCts :: Cts -> FV+tyCoFVsOfCts = foldr (unionFV . tyCoFVsOfCt) emptyFV++-- | Returns free variables of WantedConstraints as a non-deterministic+-- set. See Note [Deterministic FV] in FV.+tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoVarsOfWC = fvVarSet . tyCoFVsOfWC++-- | Returns free variables of WantedConstraints as a deterministically+-- ordered list. See Note [Deterministic FV] in FV.+tyCoVarsOfWCList :: WantedConstraints -> [TyCoVar]+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoVarsOfWCList = fvVarList . tyCoFVsOfWC++-- | Returns free variables of WantedConstraints as a composable FV+-- computation. See Note [Deterministic FV] in FV.+tyCoFVsOfWC :: WantedConstraints -> FV+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoFVsOfWC (WC { wc_simple = simple, wc_impl = implic })+  = tyCoFVsOfCts simple `unionFV`+    tyCoFVsOfBag tyCoFVsOfImplic implic++-- | Returns free variables of Implication as a composable FV computation.+-- See Note [Deterministic FV] in FV.+tyCoFVsOfImplic :: Implication -> FV+-- Only called on *zonked* things, hence no need to worry about flatten-skolems+tyCoFVsOfImplic (Implic { ic_skols = skols+                        , ic_given = givens+                        , ic_wanted = wanted })+  | isEmptyWC wanted+  = emptyFV+  | otherwise+  = tyCoFVsVarBndrs skols  $+    tyCoFVsVarBndrs givens $+    tyCoFVsOfWC wanted++tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV+tyCoFVsOfBag tvs_of = foldr (unionFV . tvs_of) emptyFV++---------------------------+dropDerivedWC :: WantedConstraints -> WantedConstraints+-- See Note [Dropping derived constraints]+dropDerivedWC wc@(WC { wc_simple = simples })+  = wc { wc_simple = dropDerivedSimples simples }+    -- The wc_impl implications are already (recursively) filtered++--------------------------+dropDerivedSimples :: Cts -> Cts+-- Drop all Derived constraints, but make [W] back into [WD],+-- so that if we re-simplify these constraints we will get all+-- the right derived constraints re-generated.  Forgetting this+-- step led to #12936+dropDerivedSimples simples = mapMaybeBag dropDerivedCt simples++dropDerivedCt :: Ct -> Maybe Ct+dropDerivedCt ct+  = case ctEvFlavour ev of+      Wanted WOnly -> Just (ct' { cc_ev = ev_wd })+      Wanted _     -> Just ct'+      _ | isDroppableCt ct -> Nothing+        | otherwise        -> Just ct+  where+    ev    = ctEvidence ct+    ev_wd = ev { ctev_nosh = WDeriv }+    ct'   = setPendingScDict ct -- See Note [Resetting cc_pend_sc]++{- Note [Resetting cc_pend_sc]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+When we discard Derived constraints, in dropDerivedSimples, we must+set the cc_pend_sc flag to True, so that if we re-process this+CDictCan we will re-generate its derived superclasses. Otherwise+we might miss some fundeps.  #13662 showed this up.++See Note [The superclass story] in TcCanonical.+-}++isDroppableCt :: Ct -> Bool+isDroppableCt ct+  = isDerived ev && not keep_deriv+    -- Drop only derived constraints, and then only if they+    -- obey Note [Dropping derived constraints]+  where+    ev   = ctEvidence ct+    loc  = ctEvLoc ev+    orig = ctLocOrigin loc++    keep_deriv+      = case ct of+          CHoleCan {} -> True+          CIrredCan { cc_insol = insoluble }+                      -> keep_eq insoluble+          _           -> keep_eq False++    keep_eq definitely_insoluble+       | isGivenOrigin orig    -- Arising only from givens+       = definitely_insoluble  -- Keep only definitely insoluble+       | otherwise+       = case orig of+           KindEqOrigin {} -> True    -- See Note [Dropping derived constraints]++           -- See Note [Dropping derived constraints]+           -- For fundeps, drop wanted/wanted interactions+           FunDepOrigin2 {} -> True   -- Top-level/Wanted+           FunDepOrigin1 _ orig1 _ _ orig2 _+             | g1 || g2  -> True  -- Given/Wanted errors: keep all+             | otherwise -> False -- Wanted/Wanted errors: discard+             where+               g1 = isGivenOrigin orig1+               g2 = isGivenOrigin orig2++           _ -> False++arisesFromGivens :: Ct -> Bool+arisesFromGivens ct+  = case ctEvidence ct of+      CtGiven {}                   -> True+      CtWanted {}                  -> False+      CtDerived { ctev_loc = loc } -> isGivenLoc loc++isGivenLoc :: CtLoc -> Bool+isGivenLoc loc = isGivenOrigin (ctLocOrigin loc)++{- Note [Dropping derived constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In general we discard derived constraints at the end of constraint solving;+see dropDerivedWC.  For example++ * Superclasses: if we have an unsolved [W] (Ord a), we don't want to+   complain about an unsolved [D] (Eq a) as well.++ * If we have [W] a ~ Int, [W] a ~ Bool, improvement will generate+   [D] Int ~ Bool, and we don't want to report that because it's+   incomprehensible. That is why we don't rewrite wanteds with wanteds!++ * We might float out some Wanteds from an implication, leaving behind+   their insoluble Deriveds. For example:++   forall a[2]. [W] alpha[1] ~ Int+                [W] alpha[1] ~ Bool+                [D] Int ~ Bool++   The Derived is insoluble, but we very much want to drop it when floating+   out.++But (tiresomely) we do keep *some* Derived constraints:++ * Type holes are derived constraints, because they have no evidence+   and we want to keep them, so we get the error report++ * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with+   KindEqOrigin, may arise from a type equality a ~ Int#, say.  See+   Note [Equalities with incompatible kinds] in TcCanonical.+   Keeping these around produces better error messages, in practice.+   E.g., test case dependent/should_fail/T11471++ * We keep most derived equalities arising from functional dependencies+      - Given/Given interactions (subset of FunDepOrigin1):+        The definitely-insoluble ones reflect unreachable code.++        Others not-definitely-insoluble ones like [D] a ~ Int do not+        reflect unreachable code; indeed if fundeps generated proofs, it'd+        be a useful equality.  See #14763.   So we discard them.++      - Given/Wanted interacGiven or Wanted interacting with an+        instance declaration (FunDepOrigin2)++      - Given/Wanted interactions (FunDepOrigin1); see #9612++      - But for Wanted/Wanted interactions we do /not/ want to report an+        error (#13506).  Consider [W] C Int Int, [W] C Int Bool, with+        a fundep on class C.  We don't want to report an insoluble Int~Bool;+        c.f. "wanteds do not rewrite wanteds".++To distinguish these cases we use the CtOrigin.++NB: we keep *all* derived insolubles under some circumstances:++  * They are looked at by simplifyInfer, to decide whether to+    generalise.  Example: [W] a ~ Int, [W] a ~ Bool+    We get [D] Int ~ Bool, and indeed the constraints are insoluble,+    and we want simplifyInfer to see that, even though we don't+    ultimately want to generate an (inexplicable) error message from it+++************************************************************************+*                                                                      *+                    CtEvidence+         The "flavor" of a canonical constraint+*                                                                      *+************************************************************************+-}++isWantedCt :: Ct -> Bool+isWantedCt = isWanted . ctEvidence++isGivenCt :: Ct -> Bool+isGivenCt = isGiven . ctEvidence++isDerivedCt :: Ct -> Bool+isDerivedCt = isDerived . ctEvidence++isCTyEqCan :: Ct -> Bool+isCTyEqCan (CTyEqCan {})  = True+isCTyEqCan (CFunEqCan {}) = False+isCTyEqCan _              = False++isCDictCan_Maybe :: Ct -> Maybe Class+isCDictCan_Maybe (CDictCan {cc_class = cls })  = Just cls+isCDictCan_Maybe _              = Nothing++isCFunEqCan_maybe :: Ct -> Maybe (TyCon, [Type])+isCFunEqCan_maybe (CFunEqCan { cc_fun = tc, cc_tyargs = xis }) = Just (tc, xis)+isCFunEqCan_maybe _ = Nothing++isCFunEqCan :: Ct -> Bool+isCFunEqCan (CFunEqCan {}) = True+isCFunEqCan _ = False++isCNonCanonical :: Ct -> Bool+isCNonCanonical (CNonCanonical {}) = True+isCNonCanonical _ = False++isHoleCt:: Ct -> Bool+isHoleCt (CHoleCan {}) = True+isHoleCt _ = False++isOutOfScopeCt :: Ct -> Bool+-- A Hole that does not have a leading underscore is+-- simply an out-of-scope variable, and we treat that+-- a bit differently when it comes to error reporting+isOutOfScopeCt (CHoleCan { cc_occ = occ }) = not (startsWithUnderscore occ)+isOutOfScopeCt _ = False++isExprHoleCt :: Ct -> Bool+isExprHoleCt (CHoleCan { cc_hole = ExprHole }) = True+isExprHoleCt _ = False++isTypeHoleCt :: Ct -> Bool+isTypeHoleCt (CHoleCan { cc_hole = TypeHole }) = True+isTypeHoleCt _ = False+++{- Note [Custom type errors in constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++When GHC reports a type-error about an unsolved-constraint, we check+to see if the constraint contains any custom-type errors, and if so+we report them.  Here are some examples of constraints containing type+errors:++TypeError msg           -- The actual constraint is a type error++TypError msg ~ Int      -- Some type was supposed to be Int, but ended up+                        -- being a type error instead++Eq (TypeError msg)      -- A class constraint is stuck due to a type error++F (TypeError msg) ~ a   -- A type function failed to evaluate due to a type err++It is also possible to have constraints where the type error is nested deeper,+for example see #11990, and also:++Eq (F (TypeError msg))  -- Here the type error is nested under a type-function+                        -- call, which failed to evaluate because of it,+                        -- and so the `Eq` constraint was unsolved.+                        -- This may happen when one function calls another+                        -- and the called function produced a custom type error.+-}++-- | A constraint is considered to be a custom type error, if it contains+-- custom type errors anywhere in it.+-- See Note [Custom type errors in constraints]+getUserTypeErrorMsg :: Ct -> Maybe Type+getUserTypeErrorMsg ct = findUserTypeError (ctPred ct)+  where+  findUserTypeError t = msum ( userTypeError_maybe t+                             : map findUserTypeError (subTys t)+                             )++  subTys t            = case splitAppTys t of+                          (t,[]) ->+                            case splitTyConApp_maybe t of+                              Nothing     -> []+                              Just (_,ts) -> ts+                          (t,ts) -> t : ts+++++isUserTypeErrorCt :: Ct -> Bool+isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of+                         Just _ -> True+                         _      -> False++isPendingScDict :: Ct -> Maybe Ct+-- Says whether this is a CDictCan with cc_pend_sc is True,+-- AND if so flips the flag+isPendingScDict ct@(CDictCan { cc_pend_sc = True })+                  = Just (ct { cc_pend_sc = False })+isPendingScDict _ = Nothing++isPendingScInst :: QCInst -> Maybe QCInst+-- Same as isPrendinScDict, but for QCInsts+isPendingScInst qci@(QCI { qci_pend_sc = True })+                  = Just (qci { qci_pend_sc = False })+isPendingScInst _ = Nothing++setPendingScDict :: Ct -> Ct+-- Set the cc_pend_sc flag to True+setPendingScDict ct@(CDictCan { cc_pend_sc = False })+                    = ct { cc_pend_sc = True }+setPendingScDict ct = ct++superClassesMightHelp :: WantedConstraints -> Bool+-- ^ True if taking superclasses of givens, or of wanteds (to perhaps+-- expose more equalities or functional dependencies) might help to+-- solve this constraint.  See Note [When superclasses help]+superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics })+  = anyBag might_help_ct simples || anyBag might_help_implic implics+  where+    might_help_implic ic+       | IC_Unsolved <- ic_status ic = superClassesMightHelp (ic_wanted ic)+       | otherwise                   = False++    might_help_ct ct = isWantedCt ct && not (is_ip ct)++    is_ip (CDictCan { cc_class = cls }) = isIPClass cls+    is_ip _                             = False++getPendingWantedScs :: Cts -> ([Ct], Cts)+getPendingWantedScs simples+  = mapAccumBagL get [] simples+  where+    get acc ct | Just ct' <- isPendingScDict ct+               = (ct':acc, ct')+               | otherwise+               = (acc,     ct)++{- Note [When superclasses help]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+First read Note [The superclass story] in TcCanonical.++We expand superclasses and iterate only if there is at unsolved wanted+for which expansion of superclasses (e.g. from given constraints)+might actually help. The function superClassesMightHelp tells if+doing this superclass expansion might help solve this constraint.+Note that++  * We look inside implications; maybe it'll help to expand the Givens+    at level 2 to help solve an unsolved Wanted buried inside an+    implication.  E.g.+        forall a. Ord a => forall b. [W] Eq a++  * Superclasses help only for Wanted constraints.  Derived constraints+    are not really "unsolved" and we certainly don't want them to+    trigger superclass expansion. This was a good part of the loop+    in  #11523++  * Even for Wanted constraints, we say "no" for implicit parameters.+    we have [W] ?x::ty, expanding superclasses won't help:+      - Superclasses can't be implicit parameters+      - If we have a [G] ?x:ty2, then we'll have another unsolved+        [D] ty ~ ty2 (from the functional dependency)+        which will trigger superclass expansion.++    It's a bit of a special case, but it's easy to do.  The runtime cost+    is low because the unsolved set is usually empty anyway (errors+    aside), and the first non-imlicit-parameter will terminate the search.++    The special case is worth it (#11480, comment:2) because it+    applies to CallStack constraints, which aren't type errors. If we have+       f :: (C a) => blah+       f x = ...undefined...+    we'll get a CallStack constraint.  If that's the only unsolved+    constraint it'll eventually be solved by defaulting.  So we don't+    want to emit warnings about hitting the simplifier's iteration+    limit.  A CallStack constraint really isn't an unsolved+    constraint; it can always be solved by defaulting.+-}++singleCt :: Ct -> Cts+singleCt = unitBag++andCts :: Cts -> Cts -> Cts+andCts = unionBags++listToCts :: [Ct] -> Cts+listToCts = listToBag++ctsElts :: Cts -> [Ct]+ctsElts = bagToList++consCts :: Ct -> Cts -> Cts+consCts = consBag++snocCts :: Cts -> Ct -> Cts+snocCts = snocBag++extendCtsList :: Cts -> [Ct] -> Cts+extendCtsList cts xs | null xs   = cts+                     | otherwise = cts `unionBags` listToBag xs++andManyCts :: [Cts] -> Cts+andManyCts = unionManyBags++emptyCts :: Cts+emptyCts = emptyBag++isEmptyCts :: Cts -> Bool+isEmptyCts = isEmptyBag++pprCts :: Cts -> SDoc+pprCts cts = vcat (map ppr (bagToList cts))++{-+************************************************************************+*                                                                      *+                Wanted constraints+     These are forced to be in TcRnTypes because+           TcLclEnv mentions WantedConstraints+           WantedConstraint mentions CtLoc+           CtLoc mentions ErrCtxt+           ErrCtxt mentions TcM+*                                                                      *+v%************************************************************************+-}++data WantedConstraints+  = WC { wc_simple :: Cts              -- Unsolved constraints, all wanted+       , wc_impl   :: Bag Implication+    }++emptyWC :: WantedConstraints+emptyWC = WC { wc_simple = emptyBag, wc_impl = emptyBag }++mkSimpleWC :: [CtEvidence] -> WantedConstraints+mkSimpleWC cts+  = WC { wc_simple = listToBag (map mkNonCanonical cts)+       , wc_impl = emptyBag }++mkImplicWC :: Bag Implication -> WantedConstraints+mkImplicWC implic+  = WC { wc_simple = emptyBag, wc_impl = implic }++isEmptyWC :: WantedConstraints -> Bool+isEmptyWC (WC { wc_simple = f, wc_impl = i })+  = isEmptyBag f && isEmptyBag i+++-- | Checks whether a the given wanted constraints are solved, i.e.+-- that there are no simple constraints left and all the implications+-- are solved.+isSolvedWC :: WantedConstraints -> Bool+isSolvedWC WC {wc_simple = wc_simple, wc_impl = wc_impl} =+  isEmptyBag wc_simple && allBag (isSolvedStatus . ic_status) wc_impl++andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints+andWC (WC { wc_simple = f1, wc_impl = i1 })+      (WC { wc_simple = f2, wc_impl = i2 })+  = WC { wc_simple = f1 `unionBags` f2+       , wc_impl   = i1 `unionBags` i2 }++unionsWC :: [WantedConstraints] -> WantedConstraints+unionsWC = foldr andWC emptyWC++addSimples :: WantedConstraints -> Bag Ct -> WantedConstraints+addSimples wc cts+  = wc { wc_simple = wc_simple wc `unionBags` cts }+    -- Consider: Put the new constraints at the front, so they get solved first++addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints+addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }++addInsols :: WantedConstraints -> Bag Ct -> WantedConstraints+addInsols wc cts+  = wc { wc_simple = wc_simple wc `unionBags` cts }++insolublesOnly :: WantedConstraints -> WantedConstraints+-- Keep only the definitely-insoluble constraints+insolublesOnly (WC { wc_simple = simples, wc_impl = implics })+  = WC { wc_simple = filterBag insolubleCt simples+       , wc_impl   = mapBag implic_insols_only implics }+  where+    implic_insols_only implic+      = implic { ic_wanted = insolublesOnly (ic_wanted implic) }++isSolvedStatus :: ImplicStatus -> Bool+isSolvedStatus (IC_Solved {}) = True+isSolvedStatus _              = False++isInsolubleStatus :: ImplicStatus -> Bool+isInsolubleStatus IC_Insoluble    = True+isInsolubleStatus IC_BadTelescope = True+isInsolubleStatus _               = False++insolubleImplic :: Implication -> Bool+insolubleImplic ic = isInsolubleStatus (ic_status ic)++insolubleWC :: WantedConstraints -> Bool+insolubleWC (WC { wc_impl = implics, wc_simple = simples })+  =  anyBag insolubleCt simples+  || anyBag insolubleImplic implics++insolubleCt :: Ct -> Bool+-- Definitely insoluble, in particular /excluding/ type-hole constraints+-- Namely: a) an equality constraint+--         b) that is insoluble+--         c) and does not arise from a Given+insolubleCt ct+  | isHoleCt ct            = isOutOfScopeCt ct  -- See Note [Insoluble holes]+  | not (insolubleEqCt ct) = False+  | arisesFromGivens ct    = False              -- See Note [Given insolubles]+  | otherwise              = True++insolubleEqCt :: Ct -> Bool+-- Returns True of /equality/ constraints+-- that are /definitely/ insoluble+-- It won't detect some definite errors like+--       F a ~ T (F a)+-- where F is a type family, which actually has an occurs check+--+-- The function is tuned for application /after/ constraint solving+--       i.e. assuming canonicalisation has been done+-- E.g.  It'll reply True  for     a ~ [a]+--               but False for   [a] ~ a+-- and+--                   True for  Int ~ F a Int+--               but False for  Maybe Int ~ F a Int Int+--               (where F is an arity-1 type function)+insolubleEqCt (CIrredCan { cc_insol = insol }) = insol+insolubleEqCt _                                = False++instance Outputable WantedConstraints where+  ppr (WC {wc_simple = s, wc_impl = i})+   = text "WC" <+> braces (vcat+        [ ppr_bag (text "wc_simple") s+        , ppr_bag (text "wc_impl") i ])++ppr_bag :: Outputable a => SDoc -> Bag a -> SDoc+ppr_bag doc bag+ | isEmptyBag bag = empty+ | otherwise      = hang (doc <+> equals)+                       2 (foldr (($$) . ppr) empty bag)++{- Note [Given insolubles]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider (#14325, comment:)+    class (a~b) => C a b++    foo :: C a c => a -> c+    foo x = x++    hm3 :: C (f b) b => b -> f b+    hm3 x = foo x++In the RHS of hm3, from the [G] C (f b) b we get the insoluble+[G] f b ~# b.  Then we also get an unsolved [W] C b (f b).+Residual implication looks like+    forall b. C (f b) b => [G] f b ~# b+                           [W] C f (f b)++We do /not/ want to set the implication status to IC_Insoluble,+because that'll suppress reports of [W] C b (f b).  But we+may not report the insoluble [G] f b ~# b either (see Note [Given errors]+in TcErrors), so we may fail to report anything at all!  Yikes.++The same applies to Derived constraints that /arise from/ Givens.+E.g.   f :: (C Int [a]) => blah+where a fundep means we get+       [D] Int ~ [a]+By the same reasoning we must not suppress other errors (#15767)++Bottom line: insolubleWC (called in TcSimplify.setImplicationStatus)+             should ignore givens even if they are insoluble.++Note [Insoluble holes]+~~~~~~~~~~~~~~~~~~~~~~+Hole constraints that ARE NOT treated as truly insoluble:+  a) type holes, arising from PartialTypeSignatures,+  b) "true" expression holes arising from TypedHoles++An "expression hole" or "type hole" constraint isn't really an error+at all; it's a report saying "_ :: Int" here.  But an out-of-scope+variable masquerading as expression holes IS treated as truly+insoluble, so that it trumps other errors during error reporting.+Yuk!++************************************************************************+*                                                                      *+                Implication constraints+*                                                                      *+************************************************************************+-}++data Implication+  = Implic {   -- Invariants for a tree of implications:+               -- see TcType Note [TcLevel and untouchable type variables]++      ic_tclvl :: TcLevel,       -- TcLevel of unification variables+                                 -- allocated /inside/ this implication++      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+                                   -- See Note [Checking telescopes]++      ic_given  :: [EvVar],      -- Given evidence variables+                                 --   (order does not matter)+                                 -- See Invariant (GivenInv) in TcType++      ic_no_eqs :: Bool,         -- True  <=> ic_givens have no equalities, for sure+                                 -- False <=> ic_givens might have equalities++      ic_warn_inaccessible :: Bool,+                                 -- True  <=> -Winaccessible-code is enabled+                                 -- at construction. See+                                 -- Note [Avoid -Winaccessible-code when deriving]+                                 -- in TcInstDcls++      ic_env   :: TcLclEnv,+                                 -- Records the TcLClEnv at the time of creation.+                                 --+                                 -- The TcLclEnv gives the source location+                                 -- and error context for the implication, and+                                 -- hence for all the given evidence variables.++      ic_wanted :: WantedConstraints,  -- The wanteds+                                       -- See Invariang (WantedInf) in TcType++      ic_binds  :: EvBindsVar,    -- Points to the place to fill in the+                                  -- abstraction and bindings.++      -- The ic_need fields keep track of which Given evidence+      -- is used by this implication or its children+      -- NB: including stuff used by nested implications that have since+      --     been discarded+      -- See Note [Needed evidence variables]+      ic_need_inner :: VarSet,    -- Includes all used Given evidence+      ic_need_outer :: VarSet,    -- Includes only the free Given evidence+                                  --  i.e. ic_need_inner after deleting+                                  --       (a) givens (b) binders of ic_binds++      ic_status   :: ImplicStatus+    }++implicationPrototype :: Implication+implicationPrototype+   = Implic { -- These fields must be initialised+              ic_tclvl      = panic "newImplic:tclvl"+            , ic_binds      = panic "newImplic:binds"+            , ic_info       = panic "newImplic:info"+            , ic_env        = panic "newImplic:env"+            , ic_warn_inaccessible = panic "newImplic:warn_inaccessible"++              -- The rest have sensible default values+            , ic_skols      = []+            , ic_telescope  = Nothing+            , ic_given      = []+            , ic_wanted     = emptyWC+            , ic_no_eqs     = False+            , ic_status     = IC_Unsolved+            , ic_need_inner = emptyVarSet+            , ic_need_outer = emptyVarSet }++data ImplicStatus+  = IC_Solved     -- All wanteds in the tree are solved, all the way down+       { ics_dead :: [EvVar] }  -- Subset of ic_given that are not needed+         -- See Note [Tracking redundant constraints] in TcSimplify++  | IC_Insoluble  -- At least one insoluble constraint in the tree++  | IC_BadTelescope  -- solved, but the skolems in the telescope are out of+                     -- dependency order++  | IC_Unsolved   -- Neither of the above; might go either way++instance Outputable Implication where+  ppr (Implic { ic_tclvl = tclvl, ic_skols = skols+              , ic_given = given, ic_no_eqs = no_eqs+              , ic_wanted = wanted, ic_status = status+              , ic_binds = binds+              , ic_need_inner = need_in, ic_need_outer = need_out+              , ic_info = info })+   = hang (text "Implic" <+> lbrace)+        2 (sep [ text "TcLevel =" <+> ppr tclvl+               , text "Skolems =" <+> pprTyVars skols+               , text "No-eqs =" <+> ppr no_eqs+               , text "Status =" <+> ppr status+               , hang (text "Given =")  2 (pprEvVars given)+               , hang (text "Wanted =") 2 (ppr wanted)+               , text "Binds =" <+> ppr binds+               , whenPprDebug (text "Needed inner =" <+> ppr need_in)+               , whenPprDebug (text "Needed outer =" <+> ppr need_out)+               , pprSkolInfo info ] <+> rbrace)++instance Outputable ImplicStatus where+  ppr IC_Insoluble    = text "Insoluble"+  ppr IC_BadTelescope = text "Bad telescope"+  ppr IC_Unsolved     = text "Unsolved"+  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+ic_binds in nested implications.++  * Main purpose: if one of the ic_givens is not mentioned in here, it+    is redundant.++  * solveImplication may drop an implication altogether if it has no+    remaining 'wanteds'. But we still track the free vars of its+    evidence binds, even though it has now disappeared.++Note [Shadowing in a constraint]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We assume NO SHADOWING in a constraint.  Specifically+ * The unification variables are all implicitly quantified at top+   level, and are all unique+ * The skolem variables bound in ic_skols are all freah when the+   implication is created.+So we can safely substitute. For example, if we have+   forall a.  a~Int => ...(forall b. ...a...)...+we can push the (a~Int) constraint inwards in the "givens" without+worrying that 'b' might clash.++Note [Skolems in an implication]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The skolems in an implication are not there to perform a skolem escape+check.  That happens because all the environment variables are in the+untouchables, and therefore cannot be unified with anything at all,+let alone the skolems.++Instead, ic_skols is used only when considering floating a constraint+outside the implication in TcSimplify.floatEqualities or+TcSimplify.approximateImplications++Note [Insoluble constraints]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Some of the errors that we get during canonicalization are best+reported when all constraints have been simplified as much as+possible. For instance, assume that during simplification the+following constraints arise:++ [Wanted]   F alpha ~  uf1+ [Wanted]   beta ~ uf1 beta++When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail+we will simply see a message:+    'Can't construct the infinite type  beta ~ uf1 beta'+and the user has no idea what the uf1 variable is.++Instead our plan is that we will NOT fail immediately, but:+    (1) Record the "frozen" error in the ic_insols field+    (2) Isolate the offending constraint from the rest of the inerts+    (3) Keep on simplifying/canonicalizing++At the end, we will hopefully have substituted uf1 := F alpha, and we+will be able to report a more informative error:+    'Can't construct the infinite type beta ~ F alpha beta'++Insoluble constraints *do* include Derived constraints. For example,+a functional dependency might give rise to [D] Int ~ Bool, and we must+report that.  If insolubles did not contain Deriveds, reportErrors would+never see it.+++************************************************************************+*                                                                      *+            Pretty printing+*                                                                      *+************************************************************************+-}++pprEvVars :: [EvVar] -> SDoc    -- Print with their types+pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)++pprEvVarTheta :: [EvVar] -> SDoc+pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)++pprEvVarWithType :: EvVar -> SDoc+pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)++++-- | Wraps the given type with the constraints (via ic_given) in the given+-- implication, according to the variables mentioned (via ic_skols)+-- in the implication, but taking care to only wrap those variables+-- that are mentioned in the type or the implication.+wrapTypeWithImplication :: Type -> Implication -> Type+wrapTypeWithImplication ty impl = wrapType ty mentioned_skols givens+    where givens = map idType $ ic_given impl+          skols = ic_skols impl+          freeVars = fvVarSet $ tyCoFVsOfTypes (ty:givens)+          mentioned_skols = filter (`elemVarSet` freeVars) skols++wrapType :: Type -> [TyVar] -> [PredType] -> Type+wrapType ty skols givens = mkSpecForAllTys skols $ mkPhiTy givens ty+++{-+************************************************************************+*                                                                      *+            CtEvidence+*                                                                      *+************************************************************************++Note [Evidence field of CtEvidence]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+During constraint solving we never look at the type of ctev_evar/ctev_dest;+instead we look at the ctev_pred field.  The evtm/evar field+may be un-zonked.++Note [Bind new Givens immediately]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For Givens we make new EvVars and bind them immediately. Two main reasons:+  * Gain sharing.  E.g. suppose we start with g :: C a b, where+       class D a => C a b+       class (E a, F a) => D a+    If we generate all g's superclasses as separate EvTerms we might+    get    selD1 (selC1 g) :: E a+           selD2 (selC1 g) :: F a+           selC1 g :: D a+    which we could do more economically as:+           g1 :: D a = selC1 g+           g2 :: E a = selD1 g1+           g3 :: F a = selD2 g1++  * For *coercion* evidence we *must* bind each given:+      class (a~b) => C a b where ....+      f :: C a b => ....+    Then in f's Givens we have g:(C a b) and the superclass sc(g,0):a~b.+    But that superclass selector can't (yet) appear in a coercion+    (see evTermCoercion), so the easy thing is to bind it to an Id.++So a Given has EvVar inside it rather than (as previously) an EvTerm.++-}++-- | A place for type-checking evidence to go after it is generated.+-- Wanted equalities are always HoleDest; other wanteds are always+-- EvVarDest.+data TcEvDest+  = EvVarDest EvVar         -- ^ bind this var to the evidence+              -- EvVarDest is always used for non-type-equalities+              -- e.g. class constraints++  | HoleDest  CoercionHole  -- ^ fill in this hole with the evidence+              -- HoleDest is always used for type-equalities+              -- See Note [Coercion holes] in TyCoRep++data CtEvidence+  = CtGiven    -- Truly given, not depending on subgoals+      { ctev_pred :: TcPredType      -- See Note [Ct/evidence invariant]+      , ctev_evar :: EvVar           -- See Note [Evidence field of CtEvidence]+      , ctev_loc  :: CtLoc }+++  | CtWanted   -- Wanted goal+      { ctev_pred :: TcPredType     -- See Note [Ct/evidence invariant]+      , ctev_dest :: TcEvDest+      , ctev_nosh :: ShadowInfo     -- See Note [Constraint flavours]+      , ctev_loc  :: CtLoc }++  | CtDerived  -- A goal that we don't really have to solve and can't+               -- immediately rewrite anything other than a derived+               -- (there's no evidence!) but if we do manage to solve+               -- it may help in solving other goals.+      { ctev_pred :: TcPredType+      , ctev_loc  :: CtLoc }++ctEvPred :: CtEvidence -> TcPredType+-- The predicate of a flavor+ctEvPred = ctev_pred++ctEvLoc :: CtEvidence -> CtLoc+ctEvLoc = ctev_loc++ctEvOrigin :: CtEvidence -> CtOrigin+ctEvOrigin = ctLocOrigin . ctEvLoc++-- | Get the equality relation relevant for a 'CtEvidence'+ctEvEqRel :: CtEvidence -> EqRel+ctEvEqRel = predTypeEqRel . ctEvPred++-- | Get the role relevant for a 'CtEvidence'+ctEvRole :: CtEvidence -> Role+ctEvRole = eqRelRole . ctEvEqRel++ctEvTerm :: CtEvidence -> EvTerm+ctEvTerm ev = EvExpr (ctEvExpr ev)++ctEvExpr :: CtEvidence -> EvExpr+ctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ })+            = Coercion $ ctEvCoercion ev+ctEvExpr ev = evId (ctEvEvId ev)++ctEvCoercion :: HasDebugCallStack => CtEvidence -> TcCoercion+ctEvCoercion (CtGiven { ctev_evar = ev_id })+  = mkTcCoVarCo ev_id+ctEvCoercion (CtWanted { ctev_dest = dest })+  | HoleDest hole <- dest+  = -- ctEvCoercion is only called on type equalities+    -- and they always have HoleDests+    mkHoleCo hole+ctEvCoercion ev+  = pprPanic "ctEvCoercion" (ppr ev)++ctEvEvId :: CtEvidence -> EvVar+ctEvEvId (CtWanted { ctev_dest = EvVarDest ev }) = ev+ctEvEvId (CtWanted { ctev_dest = HoleDest h })   = coHoleCoVar h+ctEvEvId (CtGiven  { ctev_evar = ev })           = ev+ctEvEvId ctev@(CtDerived {}) = pprPanic "ctEvId:" (ppr ctev)++instance Outputable TcEvDest where+  ppr (HoleDest h)   = text "hole" <> ppr h+  ppr (EvVarDest ev) = ppr ev++instance Outputable CtEvidence where+  ppr ev = ppr (ctEvFlavour ev)+           <+> pp_ev+           <+> braces (ppr (ctl_depth (ctEvLoc ev))) <> dcolon+                  -- Show the sub-goal depth too+           <+> ppr (ctEvPred ev)+    where+      pp_ev = case ev of+             CtGiven { ctev_evar = v } -> ppr v+             CtWanted {ctev_dest = d } -> ppr d+             CtDerived {}              -> text "_"++isWanted :: CtEvidence -> Bool+isWanted (CtWanted {}) = True+isWanted _ = False++isGiven :: CtEvidence -> Bool+isGiven (CtGiven {})  = True+isGiven _ = False++isDerived :: CtEvidence -> Bool+isDerived (CtDerived {}) = True+isDerived _              = False++{-+%************************************************************************+%*                                                                      *+            CtFlavour+%*                                                                      *+%************************************************************************++Note [Constraint flavours]+~~~~~~~~~~~~~~~~~~~~~~~~~~+Constraints come in four flavours:++* [G] Given: we have evidence++* [W] Wanted WOnly: we want evidence++* [D] Derived: any solution must satisfy this constraint, but+      we don't need evidence for it.  Examples include:+        - superclasses of [W] class constraints+        - equalities arising from functional dependencies+          or injectivity++* [WD] Wanted WDeriv: a single constraint that represents+                      both [W] and [D]+  We keep them paired as one both for efficiency, and because+  when we have a finite map  F tys -> CFunEqCan, it's inconvenient+  to have two CFunEqCans in the range++The ctev_nosh field of a Wanted distinguishes between [W] and [WD]++Wanted constraints are born as [WD], but are split into [W] and its+"shadow" [D] in TcSMonad.maybeEmitShadow.++See Note [The improvement story and derived shadows] in TcSMonad+-}++data CtFlavour  -- See Note [Constraint flavours]+  = Given+  | Wanted ShadowInfo+  | Derived+  deriving Eq++data ShadowInfo+  = WDeriv   -- [WD] This Wanted constraint has no Derived shadow,+             -- so it behaves like a pair of a Wanted and a Derived+  | WOnly    -- [W] It has a separate derived shadow+             -- See Note [The improvement story and derived shadows] in TcSMonad+  deriving( Eq )++isGivenOrWDeriv :: CtFlavour -> Bool+isGivenOrWDeriv Given           = True+isGivenOrWDeriv (Wanted WDeriv) = True+isGivenOrWDeriv _               = False++instance Outputable CtFlavour where+  ppr Given           = text "[G]"+  ppr (Wanted WDeriv) = text "[WD]"+  ppr (Wanted WOnly)  = text "[W]"+  ppr Derived         = text "[D]"++ctEvFlavour :: CtEvidence -> CtFlavour+ctEvFlavour (CtWanted { ctev_nosh = nosh }) = Wanted nosh+ctEvFlavour (CtGiven {})                    = Given+ctEvFlavour (CtDerived {})                  = Derived++-- | Whether or not one 'Ct' can rewrite another is determined by its+-- flavour and its equality relation. See also+-- Note [Flavours with roles] in TcSMonad+type CtFlavourRole = (CtFlavour, EqRel)++-- | Extract the flavour, role, and boxity from a 'CtEvidence'+ctEvFlavourRole :: CtEvidence -> CtFlavourRole+ctEvFlavourRole ev = (ctEvFlavour ev, ctEvEqRel ev)++-- | Extract the flavour and role from a 'Ct'+ctFlavourRole :: Ct -> CtFlavourRole+-- Uses short-cuts to role for special cases+ctFlavourRole (CDictCan { cc_ev = ev })+  = (ctEvFlavour ev, NomEq)+ctFlavourRole (CTyEqCan { cc_ev = ev, cc_eq_rel = eq_rel })+  = (ctEvFlavour ev, eq_rel)+ctFlavourRole (CFunEqCan { cc_ev = ev })+  = (ctEvFlavour ev, NomEq)+ctFlavourRole (CHoleCan { cc_ev = ev })+  = (ctEvFlavour ev, NomEq)  -- NomEq: CHoleCans can be rewritten by+                             -- by nominal equalities but empahatically+                             -- not by representational equalities+ctFlavourRole ct+  = ctEvFlavourRole (ctEvidence ct)++{- Note [eqCanRewrite]+~~~~~~~~~~~~~~~~~~~~~~+(eqCanRewrite ct1 ct2) holds if the constraint ct1 (a CTyEqCan of form+tv ~ ty) can be used to rewrite ct2.  It must satisfy the properties of+a can-rewrite relation, see Definition [Can-rewrite relation] in+TcSMonad.++With the solver handling Coercible constraints like equality constraints,+the rewrite conditions must take role into account, never allowing+a representational equality to rewrite a nominal one.++Note [Wanteds do not rewrite Wanteds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We don't allow Wanteds to rewrite Wanteds, because that can give rise+to very confusing type error messages.  A good example is #8450.+Here's another+   f :: a -> Bool+   f x = ( [x,'c'], [x,True] ) `seq` True+Here we get+  [W] a ~ Char+  [W] a ~ Bool+but we do not want to complain about Bool ~ Char!++Note [Deriveds do rewrite Deriveds]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+However we DO allow Deriveds to rewrite Deriveds, because that's how+improvement works; see Note [The improvement story] in TcInteract.++However, for now at least I'm only letting (Derived,NomEq) rewrite+(Derived,NomEq) and not doing anything for ReprEq.  If we have+    eqCanRewriteFR (Derived, NomEq) (Derived, _)  = True+then we lose property R2 of Definition [Can-rewrite relation]+in TcSMonad+  R2.  If f1 >= f, and f2 >= f,+       then either f1 >= f2 or f2 >= f1+Consider f1 = (Given, ReprEq)+         f2 = (Derived, NomEq)+          f = (Derived, ReprEq)++I thought maybe we could never get Derived ReprEq constraints, but+we can; straight from the Wanteds during improvement. And from a Derived+ReprEq we could conceivably get a Derived NomEq improvement (by decomposing+a type constructor with Nomninal role), and hence unify.+-}++eqCanRewrite :: EqRel -> EqRel -> Bool+eqCanRewrite NomEq  _      = True+eqCanRewrite ReprEq ReprEq = True+eqCanRewrite ReprEq NomEq  = False++eqCanRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool+-- Can fr1 actually rewrite fr2?+-- Very important function!+-- See Note [eqCanRewrite]+-- See Note [Wanteds do not rewrite Wanteds]+-- See Note [Deriveds do rewrite Deriveds]+eqCanRewriteFR (Given,         r1)    (_,       r2)    = eqCanRewrite r1 r2+eqCanRewriteFR (Wanted WDeriv, NomEq) (Derived, NomEq) = True+eqCanRewriteFR (Derived,       NomEq) (Derived, NomEq) = True+eqCanRewriteFR _                      _                = False++eqMayRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool+-- Is it /possible/ that fr1 can rewrite fr2?+-- This is used when deciding which inerts to kick out,+-- at which time a [WD] inert may be split into [W] and [D]+eqMayRewriteFR (Wanted WDeriv, NomEq) (Wanted WDeriv, NomEq) = True+eqMayRewriteFR (Derived,       NomEq) (Wanted WDeriv, NomEq) = True+eqMayRewriteFR fr1 fr2 = eqCanRewriteFR fr1 fr2++-----------------+{- Note [funEqCanDischarge]+~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have two CFunEqCans with the same LHS:+    (x1:F ts ~ f1) `funEqCanDischarge` (x2:F ts ~ f2)+Can we drop x2 in favour of x1, either unifying+f2 (if it's a flatten meta-var) or adding a new Given+(f1 ~ f2), if x2 is a Given?++Answer: yes if funEqCanDischarge is true.+-}++funEqCanDischarge+  :: CtEvidence -> CtEvidence+  -> ( SwapFlag   -- NotSwapped => lhs can discharge rhs+                  -- Swapped    => rhs can discharge lhs+     , Bool)      -- True <=> upgrade non-discharded one+                  --          from [W] to [WD]+-- See Note [funEqCanDischarge]+funEqCanDischarge ev1 ev2+  = ASSERT2( ctEvEqRel ev1 == NomEq, ppr ev1 )+    ASSERT2( ctEvEqRel ev2 == NomEq, ppr ev2 )+    -- CFunEqCans are all Nominal, hence asserts+    funEqCanDischargeF (ctEvFlavour ev1) (ctEvFlavour ev2)++funEqCanDischargeF :: CtFlavour -> CtFlavour -> (SwapFlag, Bool)+funEqCanDischargeF Given           _               = (NotSwapped, False)+funEqCanDischargeF _               Given           = (IsSwapped,  False)+funEqCanDischargeF (Wanted WDeriv) _               = (NotSwapped, False)+funEqCanDischargeF _               (Wanted WDeriv) = (IsSwapped,  True)+funEqCanDischargeF (Wanted WOnly)  (Wanted WOnly)  = (NotSwapped, False)+funEqCanDischargeF (Wanted WOnly)  Derived         = (NotSwapped, True)+funEqCanDischargeF Derived         (Wanted WOnly)  = (IsSwapped,  True)+funEqCanDischargeF Derived         Derived         = (NotSwapped, False)+++{- Note [eqCanDischarge]+~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we have two identical CTyEqCan equality constraints+(i.e. both LHS and RHS are the same)+      (x1:a~t) `eqCanDischarge` (xs:a~t)+Can we just drop x2 in favour of x1?++Answer: yes if eqCanDischarge is true.++Note that we do /not/ allow Wanted to discharge Derived.+We must keep both.  Why?  Because the Derived may rewrite+other Deriveds in the model whereas the Wanted cannot.++However a Wanted can certainly discharge an identical Wanted.  So+eqCanDischarge does /not/ define a can-rewrite relation in the+sense of Definition [Can-rewrite relation] in TcSMonad.++We /do/ say that a [W] can discharge a [WD].  In evidence terms it+certainly can, and the /caller/ arranges that the otherwise-lost [D]+is spat out as a new Derived.  -}++eqCanDischargeFR :: CtFlavourRole -> CtFlavourRole -> Bool+-- See Note [eqCanDischarge]+eqCanDischargeFR (f1,r1) (f2, r2) =  eqCanRewrite r1 r2+                                  && eqCanDischargeF f1 f2++eqCanDischargeF :: CtFlavour -> CtFlavour -> Bool+eqCanDischargeF Given   _                  = True+eqCanDischargeF (Wanted _)      (Wanted _) = True+eqCanDischargeF (Wanted WDeriv) Derived    = True+eqCanDischargeF Derived         Derived    = True+eqCanDischargeF _               _          = False+++{-+************************************************************************+*                                                                      *+            SubGoalDepth+*                                                                      *+************************************************************************++Note [SubGoalDepth]+~~~~~~~~~~~~~~~~~~~+The 'SubGoalDepth' takes care of stopping the constraint solver from looping.++The counter starts at zero and increases. It includes dictionary constraints,+equality simplification, and type family reduction. (Why combine these? Because+it's actually quite easy to mistake one for another, in sufficiently involved+scenarios, like ConstraintKinds.)++The flag -freduction-depth=n fixes the maximium level.++* The counter includes the depth of type class instance declarations.  Example:+     [W] d{7} : Eq [Int]+  That is d's dictionary-constraint depth is 7.  If we use the instance+     $dfEqList :: Eq a => Eq [a]+  to simplify it, we get+     d{7} = $dfEqList d'{8}+  where d'{8} : Eq Int, and d' has depth 8.++  For civilised (decidable) instance declarations, each increase of+  depth removes a type constructor from the type, so the depth never+  gets big; i.e. is bounded by the structural depth of the type.++* The counter also increments when resolving+equalities involving type functions. Example:+  Assume we have a wanted at depth 7:+    [W] d{7} : F () ~ a+  If there is a type function equation "F () = Int", this would be rewritten to+    [W] d{8} : Int ~ a+  and remembered as having depth 8.++  Again, without UndecidableInstances, this counter is bounded, but without it+  can resolve things ad infinitum. Hence there is a maximum level.++* Lastly, every time an equality is rewritten, the counter increases. Again,+  rewriting an equality constraint normally makes progress, but it's possible+  the "progress" is just the reduction of an infinitely-reducing type family.+  Hence we need to track the rewrites.++When compiling a program requires a greater depth, then GHC recommends turning+off this check entirely by setting -freduction-depth=0. This is because the+exact number that works is highly variable, and is likely to change even between+minor releases. Because this check is solely to prevent infinite compilation+times, it seems safe to disable it when a user has ascertained that their program+doesn't loop at the type level.++-}++-- | See Note [SubGoalDepth]+newtype SubGoalDepth = SubGoalDepth Int+  deriving (Eq, Ord, Outputable)++initialSubGoalDepth :: SubGoalDepth+initialSubGoalDepth = SubGoalDepth 0++bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth+bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)++maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth+maxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)++subGoalDepthExceeded :: DynFlags -> SubGoalDepth -> Bool+subGoalDepthExceeded dflags (SubGoalDepth d)+  = mkIntWithInf d > reductionDepth dflags++{-+************************************************************************+*                                                                      *+            CtLoc+*                                                                      *+************************************************************************++The 'CtLoc' gives information about where a constraint came from.+This is important for decent error message reporting because+dictionaries don't appear in the original source code.+type will evolve...++-}++data CtLoc = CtLoc { ctl_origin :: CtOrigin+                   , ctl_env    :: TcLclEnv+                   , ctl_t_or_k :: Maybe TypeOrKind  -- OK if we're not sure+                   , ctl_depth  :: !SubGoalDepth }++  -- The TcLclEnv includes particularly+  --    source location:  tcl_loc   :: RealSrcSpan+  --    context:          tcl_ctxt  :: [ErrCtxt]+  --    binder stack:     tcl_bndrs :: TcBinderStack+  --    level:            tcl_tclvl :: TcLevel++mkKindLoc :: TcType -> TcType   -- original *types* being compared+          -> CtLoc -> CtLoc+mkKindLoc s1 s2 loc = setCtLocOrigin (toKindLoc loc)+                        (KindEqOrigin s1 (Just s2) (ctLocOrigin loc)+                                      (ctLocTypeOrKind_maybe loc))++-- | Take a CtLoc and moves it to the kind level+toKindLoc :: CtLoc -> CtLoc+toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }++mkGivenLoc :: TcLevel -> SkolemInfo -> TcLclEnv -> CtLoc+mkGivenLoc tclvl skol_info env+  = CtLoc { ctl_origin = GivenOrigin skol_info+          , ctl_env    = setLclEnvTcLevel env tclvl+          , ctl_t_or_k = Nothing    -- this only matters for error msgs+          , ctl_depth  = initialSubGoalDepth }++ctLocEnv :: CtLoc -> TcLclEnv+ctLocEnv = ctl_env++ctLocLevel :: CtLoc -> TcLevel+ctLocLevel loc = getLclEnvTcLevel (ctLocEnv loc)++ctLocDepth :: CtLoc -> SubGoalDepth+ctLocDepth = ctl_depth++ctLocOrigin :: CtLoc -> CtOrigin+ctLocOrigin = ctl_origin++ctLocSpan :: CtLoc -> RealSrcSpan+ctLocSpan (CtLoc { ctl_env = lcl}) = getLclEnvLoc lcl++ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind+ctLocTypeOrKind_maybe = ctl_t_or_k++setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc+setCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (setLclEnvLoc lcl loc)++bumpCtLocDepth :: CtLoc -> CtLoc+bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }++setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc+setCtLocOrigin ctl orig = ctl { ctl_origin = orig }++updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc+updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd+  = ctl { ctl_origin = upd orig }++setCtLocEnv :: CtLoc -> TcLclEnv -> CtLoc+setCtLocEnv ctl env = ctl { ctl_env = env }++pprCtLoc :: CtLoc -> SDoc+-- "arising from ... at ..."+-- Not an instance of Outputable because of the "arising from" prefix+pprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})+  = sep [ pprCtOrigin o+        , text "at" <+> ppr (getLclEnvLoc lcl)]

@@ -64,12 +64,12 @@ import DynFlags   ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) ) import VarEnv import VarSet+import Predicate import Name import Pair  import CoreSyn import Class ( classSCSelId )-import Id ( isEvVar ) import CoreFVs ( exprSomeFreeVars )  import Util@@ -118,7 +118,6 @@ mkTcNthCo              :: Role -> Int -> TcCoercion -> TcCoercion mkTcLRCo               :: LeftOrRight -> TcCoercion -> TcCoercion mkTcSubCo              :: TcCoercionN -> TcCoercionR-maybeTcSubCo           :: EqRel -> TcCoercion -> TcCoercion tcDowngradeRole        :: Role -> Role -> TcCoercion -> TcCoercion mkTcAxiomRuleCo        :: CoAxiomRule -> [TcCoercion] -> TcCoercionR mkTcGReflRightCo       :: Role -> TcType -> TcCoercionN -> TcCoercion@@ -156,7 +155,6 @@ mkTcNthCo              = mkNthCo mkTcLRCo               = mkLRCo mkTcSubCo              = mkSubCo-maybeTcSubCo           = maybeSubCo tcDowngradeRole        = downgradeRole mkTcAxiomRuleCo        = mkAxiomRuleCo mkTcGReflRightCo       = mkGReflRightCo@@ -177,6 +175,13 @@ tcCoToMCo :: TcCoercion -> TcMCoercion tcCoToMCo = coToMCo +-- | If the EqRel is ReprEq, makes a SubCo; otherwise, does nothing.+-- Note that the input coercion should always be nominal.+maybeTcSubCo :: EqRel -> TcCoercion -> TcCoercion+maybeTcSubCo NomEq  = id+maybeTcSubCo ReprEq = mkTcSubCo++ {- %************************************************************************ %*                                                                      *@@ -641,7 +646,7 @@     g1 :: a~Bool = g |> ax7 a and the constraint     [G] g1 :: a~Bool-See #7238 and Note [Bind new Givens immediately] in TcRnTypes+See #7238 and Note [Bind new Givens immediately] in Constraint  Note [EvBinds/EvTerm] ~~~~~~~~~~~~~~~~~~~~~

@@ -8,6 +8,7 @@ import GhcPrelude  import TcRnTypes+import Constraint import TcType  import RdrName

@@ -0,0 +1,660 @@+{-++Describes the provenance of types as they flow through the type-checker.+The datatypes here are mainly used for error message generation.++-}++{-# LANGUAGE CPP #-}++module TcOrigin (+  -- UserTypeCtxt+  UserTypeCtxt(..), pprUserTypeCtxt, isSigMaybe,++  -- SkolemInfo+  SkolemInfo(..), pprSigSkolInfo, pprSkolInfo,++  -- CtOrigin+  CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,+  isVisibleOrigin, toInvisibleOrigin,+  pprCtOrigin, isGivenOrigin++  ) where++#include "HsVersions.h"++import GhcPrelude++import TcType++import GHC.Hs++import Id+import DataCon+import ConLike+import TyCon+import InstEnv+import PatSyn++import Module+import Name+import RdrName+import qualified GHC.LanguageExtensions as LangExt+import DynFlags++import SrcLoc+import FastString+import Outputable+import BasicTypes++{- *********************************************************************+*                                                                      *+          UserTypeCtxt+*                                                                      *+********************************************************************* -}++-------------------------------------+-- | UserTypeCtxt describes the origin of the polymorphic type+-- in the places where we need an expression to have that type+data UserTypeCtxt+  = FunSigCtxt      -- Function type signature, when checking the type+                    -- Also used for types in SPECIALISE pragmas+       Name              -- Name of the function+       Bool              -- True <=> report redundant constraints+                            -- This is usually True, but False for+                            --   * Record selectors (not important here)+                            --   * Class and instance methods.  Here+                            --     the code may legitimately be more+                            --     polymorphic than the signature+                            --     generated from the class+                            --     declaration++  | InfSigCtxt Name     -- Inferred type for function+  | ExprSigCtxt         -- Expression type signature+  | KindSigCtxt         -- Kind signature+  | StandaloneKindSigCtxt  -- Standalone kind signature+       Name                -- Name of the type/class+  | TypeAppCtxt         -- Visible type application+  | ConArgCtxt Name     -- Data constructor argument+  | TySynCtxt Name      -- RHS of a type synonym decl+  | PatSynCtxt Name     -- Type sig for a pattern synonym+  | PatSigCtxt          -- Type sig in pattern+                        --   eg  f (x::t) = ...+                        --   or  (x::t, y) = e+  | RuleSigCtxt Name    -- LHS of a RULE forall+                        --    RULE "foo" forall (x :: a -> a). f (Just x) = ...+  | ResSigCtxt          -- Result type sig+                        --      f x :: t = ....+  | ForSigCtxt Name     -- Foreign import or export signature+  | DefaultDeclCtxt     -- Types in a default declaration+  | InstDeclCtxt Bool   -- An instance declaration+                        --    True:  stand-alone deriving+                        --    False: vanilla instance declaration+  | SpecInstCtxt        -- SPECIALISE instance pragma+  | ThBrackCtxt         -- Template Haskell type brackets [t| ... |]+  | GenSigCtxt          -- Higher-rank or impredicative situations+                        -- e.g. (f e) where f has a higher-rank type+                        -- We might want to elaborate this+  | GhciCtxt Bool       -- GHCi command :kind <type>+                        -- The Bool indicates if we are checking the outermost+                        -- type application.+                        -- See Note [Unsaturated type synonyms in GHCi] in+                        -- TcValidity.++  | ClassSCCtxt Name    -- Superclasses of a class+  | SigmaCtxt           -- Theta part of a normal for-all type+                        --      f :: <S> => a -> a+  | DataTyCtxt Name     -- The "stupid theta" part of a data decl+                        --      data <S> => T a = MkT a+  | DerivClauseCtxt     -- A 'deriving' clause+  | TyVarBndrKindCtxt Name  -- The kind of a type variable being bound+  | DataKindCtxt Name   -- The kind of a data/newtype (instance)+  | TySynKindCtxt Name  -- The kind of the RHS of a type synonym+  | TyFamResKindCtxt Name   -- The result kind of a type family++{-+-- Notes re TySynCtxt+-- We allow type synonyms that aren't types; e.g.  type List = []+--+-- If the RHS mentions tyvars that aren't in scope, we'll+-- quantify over them:+--      e.g.    type T = a->a+-- will become  type T = forall a. a->a+--+-- With gla-exts that's right, but for H98 we should complain.+-}+++pprUserTypeCtxt :: UserTypeCtxt -> SDoc+pprUserTypeCtxt (FunSigCtxt n _)  = text "the type signature for" <+> quotes (ppr n)+pprUserTypeCtxt (InfSigCtxt n)    = text "the inferred type for" <+> quotes (ppr n)+pprUserTypeCtxt (RuleSigCtxt n)   = text "a RULE for" <+> quotes (ppr n)+pprUserTypeCtxt ExprSigCtxt       = text "an expression type signature"+pprUserTypeCtxt KindSigCtxt       = text "a kind signature"+pprUserTypeCtxt (StandaloneKindSigCtxt n) = text "a standalone kind signature for" <+> quotes (ppr n)+pprUserTypeCtxt TypeAppCtxt       = text "a type argument"+pprUserTypeCtxt (ConArgCtxt c)    = text "the type of the constructor" <+> quotes (ppr c)+pprUserTypeCtxt (TySynCtxt c)     = text "the RHS of the type synonym" <+> quotes (ppr c)+pprUserTypeCtxt ThBrackCtxt       = text "a Template Haskell quotation [t|...|]"+pprUserTypeCtxt PatSigCtxt        = text "a pattern type signature"+pprUserTypeCtxt ResSigCtxt        = text "a result type signature"+pprUserTypeCtxt (ForSigCtxt n)    = text "the foreign declaration for" <+> quotes (ppr n)+pprUserTypeCtxt DefaultDeclCtxt   = text "a type in a `default' declaration"+pprUserTypeCtxt (InstDeclCtxt False) = text "an instance declaration"+pprUserTypeCtxt (InstDeclCtxt True)  = text "a stand-alone deriving instance declaration"+pprUserTypeCtxt SpecInstCtxt      = text "a SPECIALISE instance pragma"+pprUserTypeCtxt GenSigCtxt        = text "a type expected by the context"+pprUserTypeCtxt (GhciCtxt {})     = text "a type in a GHCi command"+pprUserTypeCtxt (ClassSCCtxt c)   = text "the super-classes of class" <+> quotes (ppr c)+pprUserTypeCtxt SigmaCtxt         = text "the context of a polymorphic type"+pprUserTypeCtxt (DataTyCtxt tc)   = text "the context of the data type declaration for" <+> quotes (ppr tc)+pprUserTypeCtxt (PatSynCtxt n)    = text "the signature for pattern synonym" <+> quotes (ppr n)+pprUserTypeCtxt (DerivClauseCtxt) = text "a `deriving' clause"+pprUserTypeCtxt (TyVarBndrKindCtxt n) = text "the kind annotation on the type variable" <+> quotes (ppr n)+pprUserTypeCtxt (DataKindCtxt n)  = text "the kind annotation on the declaration for" <+> quotes (ppr n)+pprUserTypeCtxt (TySynKindCtxt n) = text "the kind annotation on the declaration for" <+> quotes (ppr n)+pprUserTypeCtxt (TyFamResKindCtxt n) = text "the result kind for" <+> quotes (ppr n)++isSigMaybe :: UserTypeCtxt -> Maybe Name+isSigMaybe (FunSigCtxt n _) = Just n+isSigMaybe (ConArgCtxt n)   = Just n+isSigMaybe (ForSigCtxt n)   = Just n+isSigMaybe (PatSynCtxt n)   = Just n+isSigMaybe _                = Nothing++{-+************************************************************************+*                                                                      *+                SkolemInfo+*                                                                      *+************************************************************************+-}++-- SkolemInfo gives the origin of *given* constraints+--   a) type variables are skolemised+--   b) an implication constraint is generated+data SkolemInfo+  = SigSkol -- A skolem that is created by instantiating+            -- a programmer-supplied type signature+            -- Location of the binding site is on the TyVar+            -- See Note [SigSkol SkolemInfo]+       UserTypeCtxt        -- What sort of signature+       TcType              -- Original type signature (before skolemisation)+       [(Name,TcTyVar)]    -- Maps the original name of the skolemised tyvar+                           -- to its instantiated version++  | SigTypeSkol UserTypeCtxt+                 -- like SigSkol, but when we're kind-checking the *type*+                 -- hence, we have less info++  | ForAllSkol SDoc     -- Bound by a user-written "forall".++  | DerivSkol Type      -- Bound by a 'deriving' clause;+                        -- the type is the instance we are trying to derive++  | InstSkol            -- Bound at an instance decl+  | InstSC TypeSize     -- A "given" constraint obtained by superclass selection.+                        -- If (C ty1 .. tyn) is the largest class from+                        --    which we made a superclass selection in the chain,+                        --    then TypeSize = sizeTypes [ty1, .., tyn]+                        -- See Note [Solving superclass constraints] in TcInstDcls++  | FamInstSkol         -- Bound at a family instance decl+  | PatSkol             -- An existential type variable bound by a pattern for+      ConLike           -- a data constructor with an existential type.+      (HsMatchContext Name)+             -- e.g.   data T = forall a. Eq a => MkT a+             --        f (MkT x) = ...+             -- The pattern MkT x will allocate an existential type+             -- variable for 'a'.++  | ArrowSkol           -- An arrow form (see TcArrows)++  | IPSkol [HsIPName]   -- Binding site of an implicit parameter++  | RuleSkol RuleName   -- The LHS of a RULE++  | InferSkol [(Name,TcType)]+                        -- We have inferred a type for these (mutually-recursivive)+                        -- polymorphic Ids, and are now checking that their RHS+                        -- constraints are satisfied.++  | BracketSkol         -- Template Haskell bracket++  | UnifyForAllSkol     -- We are unifying two for-all types+       TcType           -- The instantiated type *inside* the forall++  | TyConSkol TyConFlavour Name  -- bound in a type declaration of the given flavour++  | DataConSkol Name    -- bound as an existential in a Haskell98 datacon decl or+                        -- as any variable in a GADT datacon decl++  | ReifySkol           -- Bound during Template Haskell reification++  | QuantCtxtSkol       -- Quantified context, e.g.+                        --   f :: forall c. (forall a. c a => c [a]) => blah++  | UnkSkol             -- Unhelpful info (until I improve it)++instance Outputable SkolemInfo where+  ppr = pprSkolInfo++pprSkolInfo :: SkolemInfo -> SDoc+-- Complete the sentence "is a rigid type variable bound by..."+pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty+pprSkolInfo (SigTypeSkol cx)  = pprUserTypeCtxt cx+pprSkolInfo (ForAllSkol doc)  = quotes doc+pprSkolInfo (IPSkol ips)      = text "the implicit-parameter binding" <> plural ips <+> text "for"+                                 <+> pprWithCommas ppr ips+pprSkolInfo (DerivSkol pred)  = text "the deriving clause for" <+> quotes (ppr pred)+pprSkolInfo InstSkol          = text "the instance declaration"+pprSkolInfo (InstSC n)        = text "the instance declaration" <> whenPprDebug (parens (ppr n))+pprSkolInfo FamInstSkol       = text "a family instance declaration"+pprSkolInfo BracketSkol       = text "a Template Haskell bracket"+pprSkolInfo (RuleSkol name)   = text "the RULE" <+> pprRuleName name+pprSkolInfo ArrowSkol         = text "an arrow form"+pprSkolInfo (PatSkol cl mc)   = sep [ pprPatSkolInfo cl+                                    , text "in" <+> pprMatchContext mc ]+pprSkolInfo (InferSkol ids)   = hang (text "the inferred type" <> plural ids <+> text "of")+                                   2 (vcat [ ppr name <+> dcolon <+> ppr ty+                                                   | (name,ty) <- ids ])+pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty+pprSkolInfo (TyConSkol flav name) = text "the" <+> ppr flav <+> text "declaration for" <+> quotes (ppr name)+pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name)+pprSkolInfo ReifySkol         = text "the type being reified"++pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context"++-- UnkSkol+-- For type variables the others are dealt with by pprSkolTvBinding.+-- For Insts, these cases should not happen+pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) text "UnkSkol"++pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc+-- The type is already tidied+pprSigSkolInfo ctxt ty+  = case ctxt of+       FunSigCtxt f _ -> vcat [ text "the type signature for:"+                              , nest 2 (pprPrefixOcc f <+> dcolon <+> ppr ty) ]+       PatSynCtxt {}  -> pprUserTypeCtxt ctxt  -- See Note [Skolem info for pattern synonyms]+       _              -> vcat [ pprUserTypeCtxt ctxt <> colon+                              , nest 2 (ppr ty) ]++pprPatSkolInfo :: ConLike -> SDoc+pprPatSkolInfo (RealDataCon dc)+  = sep [ text "a pattern with constructor:"+        , nest 2 $ ppr dc <+> dcolon+          <+> pprType (dataConUserType dc) <> comma ]+          -- pprType prints forall's regardless of -fprint-explicit-foralls+          -- which is what we want here, since we might be saying+          -- type variable 't' is bound by ...++pprPatSkolInfo (PatSynCon ps)+  = sep [ text "a pattern with pattern synonym:"+        , nest 2 $ ppr ps <+> dcolon+                   <+> pprPatSynType ps <> comma ]++{- Note [Skolem info for pattern synonyms]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+For pattern synonym SkolemInfo we have+   SigSkol (PatSynCtxt p) ty _+but the type 'ty' is not very helpful.  The full pattern-synonym type+has the provided and required pieces, which it is inconvenient to+record and display here. So we simply don't display the type at all,+contenting outselves with just the name of the pattern synonym, which+is fine.  We could do more, but it doesn't seem worth it.++Note [SigSkol SkolemInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose we (deeply) skolemise a type+   f :: forall a. a -> forall b. b -> a+Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated+      a' -> b' -> a.+But when, in an error message, we report that "b is a rigid type+variable bound by the type signature for f", we want to show the foralls+in the right place.  So we proceed as follows:++* In SigSkol we record+    - the original signature forall a. a -> forall b. b -> a+    - the instantiation mapping [a :-> a', b :-> b']++* Then when tidying in TcMType.tidySkolemInfo, we first tidy a' to+  whatever it tidies to, say a''; and then we walk over the type+  replacing the binder a by the tidied version a'', to give+       forall a''. a'' -> forall b''. b'' -> a''+  We need to do this under function arrows, to match what deeplySkolemise+  does.++* Typically a'' will have a nice pretty name like "a", but the point is+  that the foral-bound variables of the signature we report line up with+  the instantiated skolems lying  around in other types.+++************************************************************************+*                                                                      *+            CtOrigin+*                                                                      *+************************************************************************+-}++data CtOrigin+  = GivenOrigin SkolemInfo++  -- All the others are for *wanted* constraints+  | OccurrenceOf Name              -- Occurrence of an overloaded identifier+  | OccurrenceOfRecSel RdrName     -- Occurrence of a record selector+  | AppOrigin                      -- An application of some kind++  | SpecPragOrigin UserTypeCtxt    -- Specialisation pragma for+                                   -- function or instance++  | TypeEqOrigin { uo_actual   :: TcType+                 , uo_expected :: TcType+                 , uo_thing    :: Maybe SDoc+                       -- ^ The thing that has type "actual"+                 , uo_visible  :: Bool+                       -- ^ Is at least one of the three elements above visible?+                       -- (Errors from the polymorphic subsumption check are considered+                       -- visible.) Only used for prioritizing error messages.+                 }++  | KindEqOrigin  -- See Note [Equalities with incompatible kinds] in TcCanonical.+      TcType (Maybe TcType)     -- A kind equality arising from unifying these two types+      CtOrigin                  -- originally arising from this+      (Maybe TypeOrKind)        -- the level of the eq this arises from++  | IPOccOrigin  HsIPName       -- Occurrence of an implicit parameter+  | OverLabelOrigin FastString  -- Occurrence of an overloaded label++  | LiteralOrigin (HsOverLit GhcRn)     -- Occurrence of a literal+  | NegateOrigin                        -- Occurrence of syntactic negation++  | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc+  | AssocFamPatOrigin   -- When matching the patterns of an associated+                        -- family instance with that of its parent class+  | SectionOrigin+  | TupleOrigin         -- (..,..)+  | ExprSigOrigin       -- e :: ty+  | PatSigOrigin        -- p :: ty+  | PatOrigin           -- Instantiating a polytyped pattern at a constructor+  | ProvCtxtOrigin      -- The "provided" context of a pattern synonym signature+        (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in+                                 -- particular the name and the right-hand side+  | RecordUpdOrigin+  | ViewPatOrigin++  | ScOrigin TypeSize   -- Typechecking superclasses of an instance declaration+                        -- If the instance head is C ty1 .. tyn+                        --    then TypeSize = sizeTypes [ty1, .., tyn]+                        -- See Note [Solving superclass constraints] in TcInstDcls++  | DerivClauseOrigin   -- Typechecking a deriving clause (as opposed to+                        -- standalone deriving).+  | DerivOriginDC DataCon Int Bool+      -- Checking constraints arising from this data con and field index. The+      -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if+      -- standalong deriving (with a wildcard constraint) is being used. This+      -- is used to inform error messages on how to recommended fixes (e.g., if+      -- the argument is True, then don't recommend "use standalone deriving",+      -- but rather "fill in the wildcard constraint yourself").+      -- See Note [Inferring the instance context] in TcDerivInfer+  | DerivOriginCoerce Id Type Type Bool+                        -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from+                        -- `ty1` to `ty2`.+  | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for+                          -- constraints coming from a wildcard constraint,+                          -- e.g., deriving instance _ => Eq (Foo a)+                          -- See Note [Inferring the instance context]+                          -- in TcDerivInfer+  | DefaultOrigin       -- Typechecking a default decl+  | DoOrigin            -- Arising from a do expression+  | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in+                             -- a do expression+  | MCompOrigin         -- Arising from a monad comprehension+  | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a+                                -- monad comprehension+  | IfOrigin            -- Arising from an if statement+  | ProcOrigin          -- Arising from a proc expression+  | AnnOrigin           -- An annotation++  | FunDepOrigin1       -- A functional dependency from combining+        PredType CtOrigin RealSrcSpan      -- This constraint arising from ...+        PredType CtOrigin RealSrcSpan      -- and this constraint arising from ...++  | FunDepOrigin2       -- A functional dependency from combining+        PredType CtOrigin   -- This constraint arising from ...+        PredType SrcSpan    -- and this top-level instance+        -- We only need a CtOrigin on the first, because the location+        -- is pinned on the entire error message++  | HoleOrigin+  | UnboundOccurrenceOf OccName+  | ListOrigin          -- An overloaded list+  | StaticOrigin        -- A static form+  | FailablePattern (LPat GhcTcId) -- A failable pattern in do-notation for the+                                   -- MonadFail Proposal (MFP). Obsolete when+                                   -- actual desugaring to MonadFail.fail is+                                   -- live.+  | Shouldn'tHappenOrigin String+                            -- the user should never see this one,+                            -- unless ImpredicativeTypes is on, where all+                            -- bets are off+  | InstProvidedOrigin Module ClsInst+        -- Skolem variable arose when we were testing if an instance+        -- is solvable or not.+-- An origin is visible if the place where the constraint arises is manifest+-- in user code. Currently, all origins are visible except for invisible+-- TypeEqOrigins. This is used when choosing which error of+-- several to report+isVisibleOrigin :: CtOrigin -> Bool+isVisibleOrigin (TypeEqOrigin { uo_visible = vis }) = vis+isVisibleOrigin (KindEqOrigin _ _ sub_orig _)       = isVisibleOrigin sub_orig+isVisibleOrigin _                                   = True++-- Converts a visible origin to an invisible one, if possible. Currently,+-- this works only for TypeEqOrigin+toInvisibleOrigin :: CtOrigin -> CtOrigin+toInvisibleOrigin orig@(TypeEqOrigin {}) = orig { uo_visible = False }+toInvisibleOrigin orig                   = orig++isGivenOrigin :: CtOrigin -> Bool+isGivenOrigin (GivenOrigin {})              = True+isGivenOrigin (FunDepOrigin1 _ o1 _ _ o2 _) = isGivenOrigin o1 && isGivenOrigin o2+isGivenOrigin (FunDepOrigin2 _ o1 _ _)      = isGivenOrigin o1+isGivenOrigin _                             = False++instance Outputable CtOrigin where+  ppr = pprCtOrigin++ctoHerald :: SDoc+ctoHerald = text "arising from"++-- | Extract a suitable CtOrigin from a HsExpr+lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin+lexprCtOrigin (L _ e) = exprCtOrigin e++exprCtOrigin :: HsExpr GhcRn -> CtOrigin+exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name+exprCtOrigin (HsUnboundVar _ uv)  = UnboundOccurrenceOf uv+exprCtOrigin (HsConLikeOut {})    = panic "exprCtOrigin HsConLikeOut"+exprCtOrigin (HsRecFld _ f)    = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)+exprCtOrigin (HsOverLabel _ _ l)  = OverLabelOrigin l+exprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip+exprCtOrigin (HsOverLit _ lit)    = LiteralOrigin lit+exprCtOrigin (HsLit {})           = Shouldn'tHappenOrigin "concrete literal"+exprCtOrigin (HsLam _ matches)    = matchesCtOrigin matches+exprCtOrigin (HsLamCase _ ms)     = matchesCtOrigin ms+exprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1+exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1+exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op+exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e+exprCtOrigin (HsPar _ e)          = lexprCtOrigin e+exprCtOrigin (SectionL _ _ _)     = SectionOrigin+exprCtOrigin (SectionR _ _ _)     = SectionOrigin+exprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin "explicit tuple"+exprCtOrigin ExplicitSum{}        = Shouldn'tHappenOrigin "explicit sum"+exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches+exprCtOrigin (HsIf _ (Just syn) _ _ _) = exprCtOrigin (syn_expr syn)+exprCtOrigin (HsIf {})           = Shouldn'tHappenOrigin "if expression"+exprCtOrigin (HsMultiIf _ rhs)   = lGRHSCtOrigin rhs+exprCtOrigin (HsLet _ _ e)       = lexprCtOrigin e+exprCtOrigin (HsDo {})           = DoOrigin+exprCtOrigin (ExplicitList {})   = Shouldn'tHappenOrigin "list"+exprCtOrigin (RecordCon {})      = Shouldn'tHappenOrigin "record construction"+exprCtOrigin (RecordUpd {})      = Shouldn'tHappenOrigin "record update"+exprCtOrigin (ExprWithTySig {})  = ExprSigOrigin+exprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin "arithmetic sequence"+exprCtOrigin (HsSCC _ _ _ e)     = lexprCtOrigin e+exprCtOrigin (HsCoreAnn _ _ _ e) = lexprCtOrigin e+exprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin "TH bracket"+exprCtOrigin (HsRnBracketOut {})= Shouldn'tHappenOrigin "HsRnBracketOut"+exprCtOrigin (HsTcBracketOut {})= panic "exprCtOrigin HsTcBracketOut"+exprCtOrigin (HsSpliceE {})      = Shouldn'tHappenOrigin "TH splice"+exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc"+exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"+exprCtOrigin (HsTick _ _ e)           = lexprCtOrigin e+exprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e+exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e+exprCtOrigin (HsWrap {})        = panic "exprCtOrigin HsWrap"+exprCtOrigin (XExpr nec)        = noExtCon nec++-- | Extract a suitable CtOrigin from a MatchGroup+matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin+matchesCtOrigin (MG { mg_alts = alts })+  | L _ [L _ match] <- alts+  , Match { m_grhss = grhss } <- match+  = grhssCtOrigin grhss++  | otherwise+  = Shouldn'tHappenOrigin "multi-way match"+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 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 nec)] = noExtCon nec+lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS"++pprCtOrigin :: CtOrigin -> SDoc+-- "arising from ..."+-- Not an instance of Outputable because of the "arising from" prefix+pprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk++pprCtOrigin (SpecPragOrigin ctxt)+  = case ctxt of+       FunSigCtxt n _ -> text "a SPECIALISE pragma for" <+> quotes (ppr n)+       SpecInstCtxt   -> text "a SPECIALISE INSTANCE pragma"+       _              -> text "a SPECIALISE pragma"  -- Never happens I think++pprCtOrigin (FunDepOrigin1 pred1 orig1 loc1 pred2 orig2 loc2)+  = hang (ctoHerald <+> text "a functional dependency between constraints:")+       2 (vcat [ hang (quotes (ppr pred1)) 2 (pprCtOrigin orig1 <+> text "at" <+> ppr loc1)+               , hang (quotes (ppr pred2)) 2 (pprCtOrigin orig2 <+> text "at" <+> ppr loc2) ])++pprCtOrigin (FunDepOrigin2 pred1 orig1 pred2 loc2)+  = hang (ctoHerald <+> text "a functional dependency between:")+       2 (vcat [ hang (text "constraint" <+> quotes (ppr pred1))+                    2 (pprCtOrigin orig1 )+               , hang (text "instance" <+> quotes (ppr pred2))+                    2 (text "at" <+> ppr loc2) ])++pprCtOrigin (KindEqOrigin t1 (Just t2) _ _)+  = hang (ctoHerald <+> text "a kind equality arising from")+       2 (sep [ppr t1, char '~', ppr t2])++pprCtOrigin AssocFamPatOrigin+  = text "when matching a family LHS with its class instance head"++pprCtOrigin (KindEqOrigin t1 Nothing _ _)+  = hang (ctoHerald <+> text "a kind equality when matching")+       2 (ppr t1)++pprCtOrigin (UnboundOccurrenceOf name)+  = ctoHerald <+> text "an undeclared identifier" <+> quotes (ppr name)++pprCtOrigin (DerivOriginDC dc n _)+  = hang (ctoHerald <+> text "the" <+> speakNth n+          <+> text "field of" <+> quotes (ppr dc))+       2 (parens (text "type" <+> quotes (ppr ty)))+  where+    ty = dataConOrigArgTys dc !! (n-1)++pprCtOrigin (DerivOriginCoerce meth ty1 ty2 _)+  = hang (ctoHerald <+> text "the coercion of the method" <+> quotes (ppr meth))+       2 (sep [ text "from type" <+> quotes (ppr ty1)+              , nest 2 $ text "to type" <+> quotes (ppr ty2) ])++pprCtOrigin (DoPatOrigin pat)+    = ctoHerald <+> text "a do statement"+      $$+      text "with the failable pattern" <+> quotes (ppr pat)++pprCtOrigin (MCompPatOrigin pat)+    = ctoHerald <+> hsep [ text "the failable pattern"+           , quotes (ppr pat)+           , text "in a statement in a monad comprehension" ]+pprCtOrigin (FailablePattern pat)+    = ctoHerald <+> text "the failable pattern" <+> quotes (ppr pat)+      $$+      text "(this will become an error in a future GHC release)"++pprCtOrigin (Shouldn'tHappenOrigin note)+  = sdocWithDynFlags $ \dflags ->+    if xopt LangExt.ImpredicativeTypes dflags+    then text "a situation created by impredicative types"+    else+    vcat [ text "<< This should not appear in error messages. If you see this"+         , text "in an error message, please report a bug mentioning" <+> quotes (text note) <+> text "at"+         , text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>" ]++pprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) })+  = hang (ctoHerald <+> text "the \"provided\" constraints claimed by")+       2 (text "the signature of" <+> quotes (ppr name))++pprCtOrigin (InstProvidedOrigin mod cls_inst)+  = vcat [ text "arising when attempting to show that"+         , ppr cls_inst+         , text "is provided by" <+> quotes (ppr mod)]++pprCtOrigin simple_origin+  = ctoHerald <+> pprCtO simple_origin++-- | Short one-liners+pprCtO :: CtOrigin -> SDoc+pprCtO (OccurrenceOf name)   = hsep [text "a use of", quotes (ppr name)]+pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)]+pprCtO AppOrigin             = text "an application"+pprCtO (IPOccOrigin name)    = hsep [text "a use of implicit parameter", quotes (ppr name)]+pprCtO (OverLabelOrigin l)   = hsep [text "the overloaded label"+                                    ,quotes (char '#' <> ppr l)]+pprCtO RecordUpdOrigin       = text "a record update"+pprCtO ExprSigOrigin         = text "an expression type signature"+pprCtO PatSigOrigin          = text "a pattern type signature"+pprCtO PatOrigin             = text "a pattern"+pprCtO ViewPatOrigin         = text "a view pattern"+pprCtO IfOrigin              = text "an if expression"+pprCtO (LiteralOrigin lit)   = hsep [text "the literal", quotes (ppr lit)]+pprCtO (ArithSeqOrigin seq)  = hsep [text "the arithmetic sequence", quotes (ppr seq)]+pprCtO SectionOrigin         = text "an operator section"+pprCtO AssocFamPatOrigin     = text "the LHS of a famly instance"+pprCtO TupleOrigin           = text "a tuple"+pprCtO NegateOrigin          = text "a use of syntactic negation"+pprCtO (ScOrigin n)          = text "the superclasses of an instance declaration"+                               <> whenPprDebug (parens (ppr n))+pprCtO DerivClauseOrigin     = text "the 'deriving' clause of a data type declaration"+pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration"+pprCtO DefaultOrigin         = text "a 'default' declaration"+pprCtO DoOrigin              = text "a do statement"+pprCtO MCompOrigin           = text "a statement in a monad comprehension"+pprCtO ProcOrigin            = text "a proc expression"+pprCtO (TypeEqOrigin t1 t2 _ _)= text "a type equality" <+> sep [ppr t1, char '~', ppr t2]+pprCtO AnnOrigin             = text "an annotation"+pprCtO HoleOrigin            = text "a use of" <+> quotes (text "_")+pprCtO ListOrigin            = text "an overloaded list"+pprCtO StaticOrigin          = text "a static form"+pprCtO _                     = panic "pprCtOrigin"

@@ -26,3853 +26,1608 @@         -- The environment types         Env(..),         TcGblEnv(..), TcLclEnv(..),-        IfGblEnv(..), IfLclEnv(..),-        tcVisibleOrphanMods,--        -- Frontend types (shouldn't really be here)-        FrontendResult(..),--        -- Renamer types-        ErrCtxt, RecFieldEnv,-        ImportAvails(..), emptyImportAvails, plusImportAvails,-        WhereFrom(..), mkModDeps, modDepsElts,--        -- Typechecker types-        TcTypeEnv, TcBinderStack, TcBinder(..),-        TcTyThing(..), PromotionErr(..),-        IdBindingInfo(..), ClosedTypeId, RhsNames,-        IsGroupClosed(..),-        SelfBootInfo(..),-        pprTcTyThingCategory, pprPECategory, CompleteMatch(..),--        -- Desugaring types-        DsM, DsLclEnv(..), DsGblEnv(..),-        DsMetaEnv, DsMetaVal(..), CompleteMatchMap,-        mkCompleteMatchMap, extendCompleteMatchMap,--        -- Template Haskell-        ThStage(..), SpliceType(..), PendingStuff(..),-        topStage, topAnnStage, topSpliceStage,-        ThLevel, impLevel, outerLevel, thLevel,-        ForeignSrcLang(..),--        -- Arrows-        ArrowCtxt(..),--        -- TcSigInfo-        TcSigFun, TcSigInfo(..), TcIdSigInfo(..),-        TcIdSigInst(..), TcPatSynInfo(..),-        isPartialSig, hasCompleteSig,--        -- QCInst-        QCInst(..), isPendingScInst,--        -- Canonical constraints-        Xi, Ct(..), Cts, emptyCts, andCts, andManyCts, pprCts,-        singleCt, listToCts, ctsElts, consCts, snocCts, extendCtsList,-        isEmptyCts, isCTyEqCan, isCFunEqCan,-        isPendingScDict, superClassesMightHelp, getPendingWantedScs,-        isCDictCan_Maybe, isCFunEqCan_maybe,-        isCNonCanonical, isWantedCt, isDerivedCt,-        isGivenCt, isHoleCt, isOutOfScopeCt, isExprHoleCt, isTypeHoleCt,-        isUserTypeErrorCt, getUserTypeErrorMsg,-        ctEvidence, ctLoc, setCtLoc, ctPred, ctFlavour, ctEqRel, ctOrigin,-        ctEvId, mkTcEqPredLikeEv,-        mkNonCanonical, mkNonCanonicalCt, mkGivens,-        mkIrredCt, mkInsolubleCt,-        ctEvPred, ctEvLoc, ctEvOrigin, ctEvEqRel,-        ctEvExpr, ctEvTerm, ctEvCoercion, ctEvEvId,-        tyCoVarsOfCt, tyCoVarsOfCts,-        tyCoVarsOfCtList, tyCoVarsOfCtsList,--        WantedConstraints(..), insolubleWC, emptyWC, isEmptyWC,-        isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC,-        addInsols, insolublesOnly, addSimples, addImplics,-        tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples,-        tyCoVarsOfWCList, insolubleCt, insolubleEqCt,-        isDroppableCt, insolubleImplic,-        arisesFromGivens,--        Implication(..), newImplication, implicationPrototype,-        implicLclEnv, implicDynFlags,-        ImplicStatus(..), isInsolubleStatus, isSolvedStatus,-        SubGoalDepth, initialSubGoalDepth, maxSubGoalDepth,-        bumpSubGoalDepth, subGoalDepthExceeded,-        CtLoc(..), ctLocSpan, ctLocEnv, ctLocLevel, ctLocOrigin,-        ctLocTypeOrKind_maybe,-        ctLocDepth, bumpCtLocDepth, isGivenLoc,-        setCtLocOrigin, updateCtLocOrigin, setCtLocEnv, setCtLocSpan,-        CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin,-        isVisibleOrigin, toInvisibleOrigin,-        TypeOrKind(..), isTypeLevel, isKindLevel,-        pprCtOrigin, pprCtLoc,-        pushErrCtxt, pushErrCtxtSameOrigin,---        SkolemInfo(..), pprSigSkolInfo, pprSkolInfo,--        CtEvidence(..), TcEvDest(..),-        mkKindLoc, toKindLoc, mkGivenLoc,-        isWanted, isGiven, isDerived, isGivenOrWDeriv,-        ctEvRole,--        wrapType, wrapTypeWithImplication,-        removeBindingShadowing,--        -- Constraint solver plugins-        TcPlugin(..), TcPluginResult(..), TcPluginSolver,-        TcPluginM, runTcPluginM, unsafeTcPluginTcM,-        getEvBindsTcPluginM,--        CtFlavour(..), ShadowInfo(..), ctEvFlavour,-        CtFlavourRole, ctEvFlavourRole, ctFlavourRole,-        eqCanRewrite, eqCanRewriteFR, eqMayRewriteFR,-        eqCanDischargeFR,-        funEqCanDischarge, funEqCanDischargeF,--        -- Pretty printing-        pprEvVarTheta,-        pprEvVars, pprEvVarWithType,--        -- Misc other types-        TcId, TcIdSet,-        Hole(..), holeOcc,-        NameShape(..),--        -- Role annotations-        RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,-        lookupRoleAnnot, getRoleAnnots,--  ) where--#include "HsVersions.h"--import GhcPrelude--import GHC.Hs-import CoreSyn-import HscTypes-import TcEvidence-import Type-import Class    ( Class )-import TyCon    ( TyCon, TyConFlavour, tyConKind )-import TyCoRep  ( coHoleCoVar )-import Coercion ( Coercion, mkHoleCo )-import ConLike  ( ConLike(..) )-import DataCon  ( DataCon, dataConUserType, dataConOrigArgTys )-import PatSyn   ( PatSyn, pprPatSynType )-import Id       ( idType, idName )-import FieldLabel ( FieldLabel )-import TcType-import Annotations-import InstEnv-import FamInstEnv-import {-# SOURCE #-} PmTypes (Delta)-import IOEnv-import RdrName-import Name-import NameEnv-import NameSet-import Avail-import Var-import FV-import VarEnv-import Module-import SrcLoc-import VarSet-import ErrUtils-import UniqFM-import UniqSupply-import BasicTypes-import Bag-import DynFlags-import Outputable-import ListSetOps-import FastString-import qualified GHC.LanguageExtensions as LangExt-import Fingerprint-import Util-import PrelNames ( isUnboundName )-import CostCentreState--import Control.Monad (ap, msum)-import qualified Control.Monad.Fail as MonadFail-import Data.Set      ( Set )-import qualified Data.Set as S--import Data.List ( sort )-import Data.Map ( Map )-import Data.Dynamic  ( Dynamic )-import Data.Typeable ( TypeRep )-import Data.Maybe    ( mapMaybe )-import GHCi.Message-import GHCi.RemoteTypes--import {-# SOURCE #-} TcHoleFitTypes ( HoleFitPlugin )--import qualified Language.Haskell.TH as TH---- | A 'NameShape' is a substitution on 'Name's that can be used--- to refine the identities of a hole while we are renaming interfaces--- (see 'RnModIface').  Specifically, a 'NameShape' for--- 'ns_module_name' @A@, defines a mapping from @{A.T}@--- (for some 'OccName' @T@) to some arbitrary other 'Name'.------ The most intruiging thing about a 'NameShape', however, is--- how it's constructed.  A 'NameShape' is *implied* by the--- exported 'AvailInfo's of the implementor of an interface:--- if an implementor of signature @<H>@ exports @M.T@, you implicitly--- define a substitution from @{H.T}@ to @M.T@.  So a 'NameShape'--- is computed from the list of 'AvailInfo's that are exported--- by the implementation of a module, or successively merged--- together by the export lists of signatures which are joining--- together.------ It's not the most obvious way to go about doing this, but it--- does seem to work!------ NB: Can't boot this and put it in NameShape because then we--- start pulling in too many DynFlags things.-data NameShape = NameShape {-        ns_mod_name :: ModuleName,-        ns_exports :: [AvailInfo],-        ns_map :: OccEnv Name-    }---{--************************************************************************-*                                                                      *-               Standard monad definition for TcRn-    All the combinators for the monad can be found in TcRnMonad-*                                                                      *-************************************************************************--The monad itself has to be defined here, because it is mentioned by ErrCtxt--}--type TcRnIf a b = IOEnv (Env a b)-type TcRn       = TcRnIf TcGblEnv TcLclEnv    -- Type inference-type IfM lcl    = TcRnIf IfGblEnv lcl         -- Iface stuff-type IfG        = IfM ()                      --    Top level-type IfL        = IfM IfLclEnv                --    Nested-type DsM        = TcRnIf DsGblEnv DsLclEnv    -- Desugaring---- TcRn is the type-checking and renaming monad: the main monad that--- most type-checking takes place in.  The global environment is--- 'TcGblEnv', which tracks all of the top-level type-checking--- information we've accumulated while checking a module, while the--- local environment is 'TcLclEnv', which tracks local information as--- we move inside expressions.---- | Historical "renaming monad" (now it's just 'TcRn').-type RnM  = TcRn---- | Historical "type-checking monad" (now it's just 'TcRn').-type TcM  = TcRn---- We 'stack' these envs through the Reader like monad infrastructure--- as we move into an expression (although the change is focused in--- the lcl type).-data Env gbl lcl-  = Env {-        env_top  :: !HscEnv, -- Top-level stuff that never changes-                             -- Includes all info about imported things-                             -- BangPattern is to fix leak, see #15111--        env_us   :: {-# UNPACK #-} !(IORef UniqSupply),-                             -- Unique supply for local variables--        env_gbl  :: gbl,     -- Info about things defined at the top level-                             -- of the module being compiled--        env_lcl  :: lcl      -- Nested stuff; changes as we go into-    }--instance ContainsDynFlags (Env gbl lcl) where-    extractDynFlags env = hsc_dflags (env_top env)--instance ContainsModule gbl => ContainsModule (Env gbl lcl) where-    extractModule env = extractModule (env_gbl env)---{--************************************************************************-*                                                                      *-                The interface environments-              Used when dealing with IfaceDecls-*                                                                      *-************************************************************************--}--data IfGblEnv-  = IfGblEnv {-        -- Some information about where this environment came from;-        -- useful for debugging.-        if_doc :: SDoc,-        -- The type environment for the module being compiled,-        -- in case the interface refers back to it via a reference that-        -- was originally a hi-boot file.-        -- We need the module name so we can test when it's appropriate-        -- to look in this env.-        -- See Note [Tying the knot] in TcIface-        if_rec_types :: Maybe (Module, IfG TypeEnv)-                -- Allows a read effect, so it can be in a mutable-                -- variable; c.f. handling the external package type env-                -- Nothing => interactive stuff, no loops possible-    }--data IfLclEnv-  = IfLclEnv {-        -- The module for the current IfaceDecl-        -- So if we see   f = \x -> x-        -- it means M.f = \x -> x, where M is the if_mod-        -- NB: This is a semantic module, see-        -- Note [Identity versus semantic module]-        if_mod :: Module,--        -- Whether or not the IfaceDecl came from a boot-        -- file or not; we'll use this to choose between-        -- NoUnfolding and BootUnfolding-        if_boot :: Bool,--        -- The field is used only for error reporting-        -- if (say) there's a Lint error in it-        if_loc :: SDoc,-                -- Where the interface came from:-                --      .hi file, or GHCi state, or ext core-                -- plus which bit is currently being examined--        if_nsubst :: Maybe NameShape,--        -- This field is used to make sure "implicit" declarations-        -- (anything that cannot be exported in mi_exports) get-        -- wired up correctly in typecheckIfacesForMerging.  Most-        -- of the time it's @Nothing@.  See Note [Resolving never-exported Names in TcIface]-        -- in TcIface.-        if_implicits_env :: Maybe TypeEnv,--        if_tv_env  :: FastStringEnv TyVar,     -- Nested tyvar bindings-        if_id_env  :: FastStringEnv Id         -- Nested id binding-    }--{--************************************************************************-*                                                                      *-                Desugarer monad-*                                                                      *-************************************************************************--Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around-a @UniqueSupply@ and some annotations, which-presumably include source-file location information:--}--data DsGblEnv-        = DsGblEnv-        { ds_mod          :: Module             -- For SCC profiling-        , ds_fam_inst_env :: FamInstEnv         -- Like tcg_fam_inst_env-        , ds_unqual  :: PrintUnqualified-        , ds_msgs    :: IORef Messages          -- Warning messages-        , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global,-                                                -- possibly-imported things-        , ds_complete_matches :: CompleteMatchMap-           -- Additional complete pattern matches-        , ds_cc_st   :: IORef CostCentreState-           -- Tracking indices for cost centre annotations-        }--instance ContainsModule DsGblEnv where-    extractModule = ds_mod--data DsLclEnv = DsLclEnv {-        dsl_meta    :: DsMetaEnv,        -- Template Haskell bindings-        dsl_loc     :: RealSrcSpan,      -- To put in pattern-matching error msgs--        -- See Note [Note [Type and Term Equality Propagation] in Check.hs-        -- The oracle state Delta is augmented as we walk inwards,-        -- through each pattern match in turn-        dsl_delta   :: Delta-     }---- Inside [| |] brackets, the desugarer looks--- up variables in the DsMetaEnv-type DsMetaEnv = NameEnv DsMetaVal--data DsMetaVal-   = DsBound Id         -- Bound by a pattern inside the [| |].-                        -- Will be dynamically alpha renamed.-                        -- The Id has type THSyntax.Var--   | DsSplice (HsExpr GhcTc) -- These bindings are introduced by-                             -- the PendingSplices on a HsBracketOut---{--************************************************************************-*                                                                      *-                Global typechecker environment-*                                                                      *-************************************************************************--}---- | 'FrontendResult' describes the result of running the--- frontend of a Haskell module.  Usually, you'll get--- a 'FrontendTypecheck', since running the frontend involves--- typechecking a program, but for an hs-boot merge you'll--- just get a ModIface, since no actual typechecking occurred.------ This data type really should be in HscTypes, but it needs--- to have a TcGblEnv which is only defined here.-data FrontendResult-        = FrontendTypecheck TcGblEnv---- Note [Identity versus semantic module]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- When typechecking an hsig file, it is convenient to keep track--- of two different "this module" identifiers:------      - The IDENTITY module is simply thisPackage + the module---        name; i.e. it uniquely *identifies* the interface file---        we're compiling.  For example, p[A=<A>]:A is an---        identity module identifying the requirement named A---        from library p.------      - The SEMANTIC module, which is the actual module that---        this signature is intended to represent (e.g. if---        we have a identity module p[A=base:Data.IORef]:A,---        then the semantic module is base:Data.IORef)------ Which one should you use?------      - In the desugarer and later phases of compilation,---        identity and semantic modules coincide, since we never compile---        signatures (we just generate blank object files for---        hsig files.)------        A corrolary of this is that the following invariant holds at any point---        past desugaring,------            if I have a Module, this_mod, in hand representing the module---            currently being compiled,---            then moduleUnitId this_mod == thisPackage dflags------      - For any code involving Names, we want semantic modules.---        See lookupIfaceTop in IfaceEnv, mkIface and addFingerprints---        in MkIface, and tcLookupGlobal in TcEnv------      - When reading interfaces, we want the identity module to---        identify the specific interface we want (such interfaces---        should never be loaded into the EPS).  However, if a---        hole module <A> is requested, we look for A.hi---        in the home library we are compiling.  (See LoadIface.)---        Similarly, in RnNames we check for self-imports using---        identity modules, to allow signatures to import their implementor.------      - For recompilation avoidance, you want the identity module,---        since that will actually say the specific interface you---        want to track (and recompile if it changes)---- | 'TcGblEnv' describes the top-level of the module at the--- point at which the typechecker is finished work.--- It is this structure that is handed on to the desugarer--- For state that needs to be updated during the typechecking--- phase and returned at end, use a 'TcRef' (= 'IORef').-data TcGblEnv-  = TcGblEnv {-        tcg_mod     :: Module,         -- ^ Module being compiled-        tcg_semantic_mod :: Module,    -- ^ If a signature, the backing module-            -- See also Note [Identity versus semantic module]-        tcg_src     :: HscSource,-          -- ^ What kind of module (regular Haskell, hs-boot, hsig)--        tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming-        tcg_default :: Maybe [Type],-          -- ^ Types used for defaulting. @Nothing@ => no @default@ decl--        tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module-        tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module-                                        -- See Note [The interactive package] in HscTypes--        tcg_type_env :: TypeEnv,-          -- ^ Global type env for the module we are compiling now.  All-          -- TyCons and Classes (for this module) end up in here right away,-          -- along with their derived constructors, selectors.-          ---          -- (Ids defined in this module start in the local envt, though they-          --  move to the global envt during zonking)-          ---          -- NB: for what "things in this module" means, see-          -- Note [The interactive package] in HscTypes--        tcg_type_env_var :: TcRef TypeEnv,-                -- Used only to initialise the interface-file-                -- typechecker in initIfaceTcRn, so that it can see stuff-                -- bound in this module when dealing with hi-boot recursions-                -- Updated at intervals (e.g. after dealing with types and classes)--        tcg_inst_env     :: !InstEnv,-          -- ^ Instance envt for all /home-package/ modules;-          -- Includes the dfuns in tcg_insts-          -- NB. BangPattern is to fix a leak, see #15111-        tcg_fam_inst_env :: !FamInstEnv, -- ^ Ditto for family instances-          -- NB. BangPattern is to fix a leak, see #15111-        tcg_ann_env      :: AnnEnv,     -- ^ And for annotations--                -- Now a bunch of things about this module that are simply-                -- accumulated, but never consulted until the end.-                -- Nevertheless, it's convenient to accumulate them along-                -- with the rest of the info from this module.-        tcg_exports :: [AvailInfo],     -- ^ What is exported-        tcg_imports :: ImportAvails,-          -- ^ Information about what was imported from where, including-          -- things bound in this module. Also store Safe Haskell info-          -- here about transitive trusted package requirements.-          ---          -- There are not many uses of this field, so you can grep for-          -- all them.-          ---          -- The ImportAvails records information about the following-          -- things:-          ---          --    1. All of the modules you directly imported (tcRnImports)-          --    2. The orphans (only!) of all imported modules in a GHCi-          --       session (runTcInteractive)-          --    3. The module that instantiated a signature-          --    4. Each of the signatures that merged in-          ---          -- It is used in the following ways:-          --    - imp_orphs is used to determine what orphan modules should be-          --      visible in the context (tcVisibleOrphanMods)-          --    - imp_finsts is used to determine what family instances should-          --      be visible (tcExtendLocalFamInstEnv)-          --    - To resolve the meaning of the export list of a module-          --      (tcRnExports)-          --    - imp_mods is used to compute usage info (mkIfaceTc, deSugar)-          --    - imp_trust_own_pkg is used for Safe Haskell in interfaces-          --      (mkIfaceTc, as well as in HscMain)-          --    - To create the Dependencies field in interface (mkDependencies)--        tcg_dus       :: DefUses,   -- ^ What is defined in this module and what is used.-        tcg_used_gres :: TcRef [GlobalRdrElt],  -- ^ Records occurrences of imported entities-          -- One entry for each occurrence; but may have different GREs for-          -- the same Name See Note [Tracking unused binding and imports]--        tcg_keep :: TcRef NameSet,-          -- ^ Locally-defined top-level names to keep alive.-          ---          -- "Keep alive" means give them an Exported flag, so that the-          -- simplifier does not discard them as dead code, and so that they-          -- are exposed in the interface file (but not to export to the-          -- user).-          ---          -- Some things, like dict-fun Ids and default-method Ids are "born"-          -- with the Exported flag on, for exactly the above reason, but some-          -- we only discover as we go.  Specifically:-          ---          --   * The to/from functions for generic data types-          ---          --   * Top-level variables appearing free in the RHS of an orphan-          --     rule-          ---          --   * Top-level variables appearing free in a TH bracket--        tcg_th_used :: TcRef Bool,-          -- ^ @True@ <=> Template Haskell syntax used.-          ---          -- We need this so that we can generate a dependency on the-          -- Template Haskell package, because the desugarer is going-          -- to emit loads of references to TH symbols.  The reference-          -- is implicit rather than explicit, so we have to zap a-          -- mutable variable.--        tcg_th_splice_used :: TcRef Bool,-          -- ^ @True@ <=> A Template Haskell splice was used.-          ---          -- Splices disable recompilation avoidance (see #481)--        tcg_th_top_level_locs :: TcRef (Set RealSrcSpan),-          -- ^ Locations of the top-level splices; used for providing details on-          -- scope in error messages for out-of-scope variables--        tcg_dfun_n  :: TcRef OccSet,-          -- ^ Allows us to choose unique DFun names.--        tcg_merged :: [(Module, Fingerprint)],-          -- ^ The requirements we merged with; we always have to recompile-          -- if any of these changed.--        -- The next fields accumulate the payload of the module-        -- The binds, rules and foreign-decl fields are collected-        -- initially in un-zonked form and are finally zonked in tcRnSrcDecls--        tcg_rn_exports :: Maybe [(Located (IE GhcRn), Avails)],-                -- Nothing <=> no explicit export list-                -- Is always Nothing if we don't want to retain renamed-                -- exports.-                -- If present contains each renamed export list item-                -- together with its exported names.--        tcg_rn_imports :: [LImportDecl GhcRn],-                -- Keep the renamed imports regardless.  They are not-                -- voluminous and are needed if you want to report unused imports--        tcg_rn_decls :: Maybe (HsGroup GhcRn),-          -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed-          -- decls.--        tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile--        tcg_th_topdecls :: TcRef [LHsDecl GhcPs],-        -- ^ Top-level declarations from addTopDecls--        tcg_th_foreign_files :: TcRef [(ForeignSrcLang, FilePath)],-        -- ^ Foreign files emitted from TH.--        tcg_th_topnames :: TcRef NameSet,-        -- ^ Exact names bound in top-level declarations in tcg_th_topdecls--        tcg_th_modfinalizers :: TcRef [(TcLclEnv, ThModFinalizers)],-        -- ^ Template Haskell module finalizers.-        ---        -- They can use particular local environments.--        tcg_th_coreplugins :: TcRef [String],-        -- ^ Core plugins added by Template Haskell code.--        tcg_th_state :: TcRef (Map TypeRep Dynamic),-        tcg_th_remote_state :: TcRef (Maybe (ForeignRef (IORef QState))),-        -- ^ Template Haskell state--        tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings--        -- Things defined in this module, or (in GHCi)-        -- in the declarations for a single GHCi command.-        -- For the latter, see Note [The interactive package] in HscTypes-        tcg_tr_module :: Maybe Id,   -- Id for $trModule :: GHC.Types.Module-                                             -- for which every module has a top-level defn-                                             -- except in GHCi in which case we have Nothing-        tcg_binds     :: LHsBinds GhcTc,     -- Value bindings in this module-        tcg_sigs      :: NameSet,            -- ...Top-level names that *lack* a signature-        tcg_imp_specs :: [LTcSpecPrag],      -- ...SPECIALISE prags for imported Ids-        tcg_warns     :: Warnings,           -- ...Warnings and deprecations-        tcg_anns      :: [Annotation],       -- ...Annotations-        tcg_tcs       :: [TyCon],            -- ...TyCons and Classes-        tcg_insts     :: [ClsInst],          -- ...Instances-        tcg_fam_insts :: [FamInst],          -- ...Family instances-        tcg_rules     :: [LRuleDecl GhcTc],  -- ...Rules-        tcg_fords     :: [LForeignDecl GhcTc], -- ...Foreign import & exports-        tcg_patsyns   :: [PatSyn],            -- ...Pattern synonyms--        tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs-        tcg_hpc       :: !AnyHpcUsage,       -- ^ @True@ if any part of the-                                             --  prog uses hpc instrumentation.-           -- NB. BangPattern is to fix a leak, see #15111--        tcg_self_boot :: SelfBootInfo,       -- ^ Whether this module has a-                                             -- corresponding hi-boot file--        tcg_main      :: Maybe Name,         -- ^ The Name of the main-                                             -- function, if this module is-                                             -- the main module.--        tcg_safeInfer :: TcRef (Bool, WarningMessages),-        -- ^ Has the typechecker inferred this module as -XSafe (Safe Haskell)-        -- See Note [Safe Haskell Overlapping Instances Implementation],-        -- although this is used for more than just that failure case.--        tcg_tc_plugins :: [TcPluginSolver],-        -- ^ A list of user-defined plugins for the constraint solver.-        tcg_hf_plugins :: [HoleFitPlugin],-        -- ^ A list of user-defined plugins for hole fit suggestions.--        tcg_top_loc :: RealSrcSpan,-        -- ^ The RealSrcSpan this module came from--        tcg_static_wc :: TcRef WantedConstraints,-          -- ^ Wanted constraints of static forms.-        -- See Note [Constraints in static forms].-        tcg_complete_matches :: [CompleteMatch],--        -- ^ Tracking indices for cost centre annotations-        tcg_cc_st   :: TcRef CostCentreState-    }---- NB: topModIdentity, not topModSemantic!--- Definition sites of orphan identities will be identity modules, not semantic--- modules.---- Note [Constraints in static forms]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~------ When a static form produces constraints like------ f :: StaticPtr (Bool -> String)--- f = static show------ we collect them in tcg_static_wc and resolve them at the end--- of type checking. They need to be resolved separately because--- we don't want to resolve them in the context of the enclosing--- expression. Consider------ g :: Show a => StaticPtr (a -> String)--- g = static show------ If the @Show a0@ constraint that the body of the static form produces was--- resolved in the context of the enclosing expression, then the body of the--- static form wouldn't be closed because the Show dictionary would come from--- g's context instead of coming from the top level.--tcVisibleOrphanMods :: TcGblEnv -> ModuleSet-tcVisibleOrphanMods tcg_env-    = mkModuleSet (tcg_mod tcg_env : imp_orphs (tcg_imports tcg_env))--instance ContainsModule TcGblEnv where-    extractModule env = tcg_semantic_mod env--type RecFieldEnv = NameEnv [FieldLabel]-        -- Maps a constructor name *in this module*-        -- to the fields for that constructor.-        -- This is used when dealing with ".." notation in record-        -- construction and pattern matching.-        -- The FieldEnv deals *only* with constructors defined in *this*-        -- module.  For imported modules, we get the same info from the-        -- TypeEnv--data SelfBootInfo-  = NoSelfBoot    -- No corresponding hi-boot file-  | SelfBoot-       { sb_mds :: ModDetails   -- There was a hi-boot file,-       , sb_tcs :: NameSet }    -- defining these TyCons,--- What is sb_tcs used for?  See Note [Extra dependencies from .hs-boot files]--- in RnSource---{- Note [Tracking unused binding and imports]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We gather two sorts of usage information-- * tcg_dus (defs/uses)-      Records *defined* Names (local, top-level)-          and *used*    Names (local or imported)--      Used (a) to report "defined but not used"-               (see RnNames.reportUnusedNames)-           (b) to generate version-tracking usage info in interface-               files (see MkIface.mkUsedNames)-   This usage info is mainly gathered by the renamer's-   gathering of free-variables-- * tcg_used_gres-      Used only to report unused import declarations--      Records each *occurrence* an *imported* (not locally-defined) entity.-      The occurrence is recorded by keeping a GlobalRdrElt for it.-      These is not the GRE that is in the GlobalRdrEnv; rather it-      is recorded *after* the filtering done by pickGREs.  So it reflect-      /how that occurrence is in scope/.   See Note [GRE filtering] in-      RdrName.---************************************************************************-*                                                                      *-                The local typechecker environment-*                                                                      *-************************************************************************--Note [The Global-Env/Local-Env story]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-During type checking, we keep in the tcg_type_env-        * All types and classes-        * All Ids derived from types and classes (constructors, selectors)--At the end of type checking, we zonk the local bindings,-and as we do so we add to the tcg_type_env-        * Locally defined top-level Ids--Why?  Because they are now Ids not TcIds.  This final GlobalEnv is-        a) fed back (via the knot) to typechecking the-           unfoldings of interface signatures-        b) used in the ModDetails of this module--}--data TcLclEnv           -- Changes as we move inside an expression-                        -- Discarded after typecheck/rename; not passed on to desugarer-  = TcLclEnv {-        tcl_loc        :: RealSrcSpan,     -- Source span-        tcl_ctxt       :: [ErrCtxt],       -- Error context, innermost on top-        tcl_tclvl      :: TcLevel,         -- Birthplace for new unification variables--        tcl_th_ctxt    :: ThStage,         -- Template Haskell context-        tcl_th_bndrs   :: ThBindEnv,       -- and binder info-            -- The ThBindEnv records the TH binding level of in-scope Names-            -- defined in this module (not imported)-            -- We can't put this info in the TypeEnv because it's needed-            -- (and extended) in the renamer, for untyed splices--        tcl_arrow_ctxt :: ArrowCtxt,       -- Arrow-notation context--        tcl_rdr :: LocalRdrEnv,         -- Local name envt-                -- Maintained during renaming, of course, but also during-                -- type checking, solely so that when renaming a Template-Haskell-                -- splice we have the right environment for the renamer.-                ---                --   Does *not* include global name envt; may shadow it-                --   Includes both ordinary variables and type variables;-                --   they are kept distinct because tyvar have a different-                --   occurrence constructor (Name.TvOcc)-                -- We still need the unsullied global name env so that-                --   we can look up record field names--        tcl_env  :: TcTypeEnv,    -- The local type environment:-                                  -- Ids and TyVars defined in this module--        tcl_bndrs :: TcBinderStack,   -- Used for reporting relevant bindings,-                                      -- and for tidying types--        tcl_lie  :: TcRef WantedConstraints,    -- Place to accumulate type constraints-        tcl_errs :: TcRef Messages              -- Place to accumulate errors-    }--type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))-        -- Monadic so that we have a chance-        -- to deal with bound type variables just before error-        -- message construction--        -- Bool:  True <=> this is a landmark context; do not-        --                 discard it when trimming for display--type TcTypeEnv = NameEnv TcTyThing--type ThBindEnv = NameEnv (TopLevelFlag, ThLevel)-   -- Domain = all Ids bound in this module (ie not imported)-   -- The TopLevelFlag tells if the binding is syntactically top level.-   -- We need to know this, because the cross-stage persistence story allows-   -- cross-stage at arbitrary types if the Id is bound at top level.-   ---   -- Nota bene: a ThLevel of 'outerLevel' is *not* the same as being-   -- bound at top level!  See Note [Template Haskell levels] in TcSplice--{- Note [Given Insts]-   ~~~~~~~~~~~~~~~~~~-Because of GADTs, we have to pass inwards the Insts provided by type signatures-and existential contexts. Consider-        data T a where { T1 :: b -> b -> T [b] }-        f :: Eq a => T a -> Bool-        f (T1 x y) = [x]==[y]--The constructor T1 binds an existential variable 'b', and we need Eq [b].-Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we-pass it inwards.---}---- | Type alias for 'IORef'; the convention is we'll use this for mutable--- bits of data in 'TcGblEnv' which are updated during typechecking and--- returned at the end.-type TcRef a     = IORef a--- ToDo: when should I refer to it as a 'TcId' instead of an 'Id'?-type TcId        = Id-type TcIdSet     = IdSet-------------------------------- The TcBinderStack------------------------------type TcBinderStack = [TcBinder]-   -- This is a stack of locally-bound ids and tyvars,-   --   innermost on top-   -- Used only in error reporting (relevantBindings in TcError),-   --   and in tidying-   -- We can't use the tcl_env type environment, because it doesn't-   --   keep track of the nesting order--data TcBinder-  = TcIdBndr-       TcId-       TopLevelFlag    -- Tells whether the binding is syntactically top-level-                       -- (The monomorphic Ids for a recursive group count-                       --  as not-top-level for this purpose.)--  | TcIdBndr_ExpType  -- Variant that allows the type to be specified as-                      -- an ExpType-       Name-       ExpType-       TopLevelFlag--  | TcTvBndr          -- e.g.   case x of P (y::a) -> blah-       Name           -- We bind the lexical name "a" to the type of y,-       TyVar          -- which might be an utterly different (perhaps-                      -- existential) tyvar--instance Outputable TcBinder where-   ppr (TcIdBndr id top_lvl)           = ppr id <> brackets (ppr top_lvl)-   ppr (TcIdBndr_ExpType id _ top_lvl) = ppr id <> brackets (ppr top_lvl)-   ppr (TcTvBndr name tv)              = ppr name <+> ppr tv--instance HasOccName TcBinder where-    occName (TcIdBndr id _)             = occName (idName id)-    occName (TcIdBndr_ExpType name _ _) = occName name-    occName (TcTvBndr name _)           = occName name---- fixes #12177--- Builds up a list of bindings whose OccName has not been seen before--- i.e., If    ys  = removeBindingShadowing xs--- then---  - ys is obtained from xs by deleting some elements---  - ys has no duplicate OccNames---  - The first duplicated OccName in xs is retained in ys--- Overloaded so that it can be used for both GlobalRdrElt in typed-hole--- substitutions and TcBinder when looking for relevant bindings.-removeBindingShadowing :: HasOccName a => [a] -> [a]-removeBindingShadowing bindings = reverse $ fst $ foldl-    (\(bindingAcc, seenNames) binding ->-    if occName binding `elemOccSet` seenNames -- if we've seen it-        then (bindingAcc, seenNames)              -- skip it-        else (binding:bindingAcc, extendOccSet seenNames (occName binding)))-    ([], emptyOccSet) bindings-------------------------------- Template Haskell stages and levels------------------------------data SpliceType = Typed | Untyped--data ThStage    -- See Note [Template Haskell state diagram] in TcSplice-  = Splice SpliceType -- Inside a top-level splice-                      -- This code will be run *at compile time*;-                      --   the result replaces the splice-                      -- Binding level = 0--  | RunSplice (TcRef [ForeignRef (TH.Q ())])-      -- Set when running a splice, i.e. NOT when renaming or typechecking the-      -- Haskell code for the splice. See Note [RunSplice ThLevel].-      ---      -- Contains a list of mod finalizers collected while executing the splice.-      ---      -- 'addModFinalizer' inserts finalizers here, and from here they are taken-      -- to construct an @HsSpliced@ annotation for untyped splices. See Note-      -- [Delaying modFinalizers in untyped splices] in "RnSplice".-      ---      -- For typed splices, the typechecker takes finalizers from here and-      -- inserts them in the list of finalizers in the global environment.-      ---      -- See Note [Collecting modFinalizers in typed splices] in "TcSplice".--  | Comp        -- Ordinary Haskell code-                -- Binding level = 1--  | Brack                       -- Inside brackets-      ThStage                   --   Enclosing stage-      PendingStuff--data PendingStuff-  = RnPendingUntyped              -- Renaming the inside of an *untyped* bracket-      (TcRef [PendingRnSplice])   -- Pending splices in here--  | RnPendingTyped                -- Renaming the inside of a *typed* bracket--  | TcPending                     -- Typechecking the inside of a typed bracket-      (TcRef [PendingTcSplice])   --   Accumulate pending splices here-      (TcRef WantedConstraints)   --     and type constraints here--topStage, topAnnStage, topSpliceStage :: ThStage-topStage       = Comp-topAnnStage    = Splice Untyped-topSpliceStage = Splice Untyped--instance Outputable ThStage where-   ppr (Splice _)    = text "Splice"-   ppr (RunSplice _) = text "RunSplice"-   ppr Comp          = text "Comp"-   ppr (Brack s _)   = text "Brack" <> parens (ppr s)--type ThLevel = Int-    -- NB: see Note [Template Haskell levels] in TcSplice-    -- Incremented when going inside a bracket,-    -- decremented when going inside a splice-    -- NB: ThLevel is one greater than the 'n' in Fig 2 of the-    --     original "Template meta-programming for Haskell" paper--impLevel, outerLevel :: ThLevel-impLevel = 0    -- Imported things; they can be used inside a top level splice-outerLevel = 1  -- Things defined outside brackets--thLevel :: ThStage -> ThLevel-thLevel (Splice _)    = 0-thLevel (RunSplice _) =-    -- See Note [RunSplice ThLevel].-    panic "thLevel: called when running a splice"-thLevel Comp          = 1-thLevel (Brack s _)   = thLevel s + 1--{- Node [RunSplice ThLevel]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The 'RunSplice' stage is set when executing a splice, and only when running a-splice. In particular it is not set when the splice is renamed or typechecked.--'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert-the finalizer (see Note [Delaying modFinalizers in untyped splices]), and-'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to-set 'RunSplice' when renaming or typechecking the splice, where 'Splice',-'Brack' or 'Comp' are used instead.---}-------------------------------- Arrow-notation context------------------------------{- Note [Escaping the arrow scope]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-In arrow notation, a variable bound by a proc (or enclosed let/kappa)-is not in scope to the left of an arrow tail (-<) or the head of (|..|).-For example--        proc x -> (e1 -< e2)--Here, x is not in scope in e1, but it is in scope in e2.  This can get-a bit complicated:--        let x = 3 in-        proc y -> (proc z -> e1) -< e2--Here, x and z are in scope in e1, but y is not.--We implement this by-recording the environment when passing a proc (using newArrowScope),-and returning to that (using escapeArrowScope) on the left of -< and the-head of (|..|).--All this can be dealt with by the *renamer*. But the type checker needs-to be involved too.  Example (arrowfail001)-  class Foo a where foo :: a -> ()-  data Bar = forall a. Foo a => Bar a-  get :: Bar -> ()-  get = proc x -> case x of Bar a -> foo -< a-Here the call of 'foo' gives rise to a (Foo a) constraint that should not-be captured by the pattern match on 'Bar'.  Rather it should join the-constraints from further out.  So we must capture the constraint bag-from further out in the ArrowCtxt that we push inwards.--}--data ArrowCtxt   -- Note [Escaping the arrow scope]-  = NoArrowCtxt-  | ArrowCtxt LocalRdrEnv (TcRef WantedConstraints)--------------------------------- TcTyThing-------------------------------- | A typecheckable thing available in a local context.  Could be--- 'AGlobal' 'TyThing', but also lexically scoped variables, etc.--- See 'TcEnv' for how to retrieve a 'TyThing' given a 'Name'.-data TcTyThing-  = AGlobal TyThing             -- Used only in the return type of a lookup--  | ATcId           -- Ids defined in this module; may not be fully zonked-      { tct_id   :: TcId-      , tct_info :: IdBindingInfo   -- See Note [Meaning of IdBindingInfo]-      }--  | ATyVar  Name TcTyVar   -- See Note [Type variables in the type environment]--  | ATcTyCon TyCon   -- Used temporarily, during kind checking, for the-                     -- tycons and clases in this recursive group-                     -- The TyCon is always a TcTyCon.  Its kind-                     -- can be a mono-kind or a poly-kind; in TcTyClsDcls see-                     -- Note [Type checking recursive type and class declarations]--  | APromotionErr PromotionErr--data PromotionErr-  = TyConPE          -- TyCon used in a kind before we are ready-                     --     data T :: T -> * where ...-  | ClassPE          -- Ditto Class--  | FamDataConPE     -- Data constructor for a data family-                     -- See Note [AFamDataCon: not promoting data family constructors]-                     -- in TcEnv.-  | ConstrainedDataConPE PredType-                     -- Data constructor with a non-equality context-                     -- See Note [Don't promote data constructors with-                     --           non-equality contexts] in TcHsType-  | PatSynPE         -- Pattern synonyms-                     -- See Note [Don't promote pattern synonyms] in TcEnv--  | RecDataConPE     -- Data constructor in a recursive loop-                     -- See Note [Recursion and promoting data constructors] in TcTyClsDecls-  | NoDataKindsTC    -- -XDataKinds not enabled (for a tycon)-  | NoDataKindsDC    -- -XDataKinds not enabled (for a datacon)--instance Outputable TcTyThing where     -- Debugging only-   ppr (AGlobal g)      = ppr g-   ppr elt@(ATcId {})   = text "Identifier" <>-                          brackets (ppr (tct_id elt) <> dcolon-                                 <> ppr (varType (tct_id elt)) <> comma-                                 <+> ppr (tct_info elt))-   ppr (ATyVar n tv)    = text "Type variable" <+> quotes (ppr n) <+> equals <+> ppr tv-                            <+> dcolon <+> ppr (varType tv)-   ppr (ATcTyCon tc)    = text "ATcTyCon" <+> ppr tc <+> dcolon <+> ppr (tyConKind tc)-   ppr (APromotionErr err) = text "APromotionErr" <+> ppr err---- | IdBindingInfo describes how an Id is bound.------ It is used for the following purposes:--- a) for static forms in TcExpr.checkClosedInStaticForm and--- b) to figure out when a nested binding can be generalised,---    in TcBinds.decideGeneralisationPlan.----data IdBindingInfo -- See Note [Meaning of IdBindingInfo and ClosedTypeId]-    = NotLetBound-    | ClosedLet-    | NonClosedLet-         RhsNames        -- Used for (static e) checks only-         ClosedTypeId    -- Used for generalisation checks-                         -- and for (static e) checks---- | IsGroupClosed describes a group of mutually-recursive bindings-data IsGroupClosed-  = IsGroupClosed-      (NameEnv RhsNames)  -- Free var info for the RHS of each binding in the goup-                          -- Used only for (static e) checks--      ClosedTypeId        -- True <=> all the free vars of the group are-                          --          imported or ClosedLet or-                          --          NonClosedLet with ClosedTypeId=True.-                          --          In particular, no tyvars, no NotLetBound--type RhsNames = NameSet   -- Names of variables, mentioned on the RHS of-                          -- a definition, that are not Global or ClosedLet--type ClosedTypeId = Bool-  -- See Note [Meaning of IdBindingInfo and ClosedTypeId]--{- Note [Meaning of IdBindingInfo]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-NotLetBound means that-  the Id is not let-bound (e.g. it is bound in a-  lambda-abstraction or in a case pattern)--ClosedLet means that-   - The Id is let-bound,-   - Any free term variables are also Global or ClosedLet-   - Its type has no free variables (NB: a top-level binding subject-     to the MR might have free vars in its type)-   These ClosedLets can definitely be floated to top level; and we-   may need to do so for static forms.--   Property:   ClosedLet-             is equivalent to-               NonClosedLet emptyNameSet True--(NonClosedLet (fvs::RhsNames) (cl::ClosedTypeId)) means that-   - The Id is let-bound--   - The fvs::RhsNames contains the free names of the RHS,-     excluding Global and ClosedLet ones.--   - For the ClosedTypeId field see Note [Bindings with closed types]--For (static e) to be valid, we need for every 'x' free in 'e',-that x's binding is floatable to the top level.  Specifically:-   * x's RhsNames must be empty-   * x's type has no free variables-See Note [Grand plan for static forms] in StaticPtrTable.hs.-This test is made in TcExpr.checkClosedInStaticForm.-Actually knowing x's RhsNames (rather than just its emptiness-or otherwise) is just so we can produce better error messages--Note [Bindings with closed types: ClosedTypeId]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider--  f x = let g ys = map not ys-        in ...--Can we generalise 'g' under the OutsideIn algorithm?  Yes,-because all g's free variables are top-level; that is they themselves-have no free type variables, and it is the type variables in the-environment that makes things tricky for OutsideIn generalisation.--Here's the invariant:-   If an Id has ClosedTypeId=True (in its IdBindingInfo), then-   the Id's type is /definitely/ closed (has no free type variables).-   Specifically,-       a) The Id's acutal type is closed (has no free tyvars)-       b) Either the Id has a (closed) user-supplied type signature-          or all its free variables are Global/ClosedLet-             or NonClosedLet with ClosedTypeId=True.-          In particular, none are NotLetBound.--Why is (b) needed?   Consider-    \x. (x :: Int, let y = x+1 in ...)-Initially x::alpha.  If we happen to typecheck the 'let' before the-(x::Int), y's type will have a free tyvar; but if the other way round-it won't.  So we treat any let-bound variable with a free-non-let-bound variable as not ClosedTypeId, regardless of what the-free vars of its type actually are.--But if it has a signature, all is well:-   \x. ...(let { y::Int; y = x+1 } in-           let { v = y+2 } in ...)...-Here the signature on 'v' makes 'y' a ClosedTypeId, so we can-generalise 'v'.--Note that:--  * A top-level binding may not have ClosedTypeId=True, if it suffers-    from the MR--  * A nested binding may be closed (eg 'g' in the example we started-    with). Indeed, that's the point; whether a function is defined at-    top level or nested is orthogonal to the question of whether or-    not it is closed.--  * A binding may be non-closed because it mentions a lexically scoped-    *type variable*  Eg-        f :: forall a. blah-        f x = let g y = ...(y::a)...--Under OutsideIn we are free to generalise an Id all of whose free-variables have ClosedTypeId=True (or imported).  This is an extension-compared to the JFP paper on OutsideIn, which used "top-level" as a-proxy for "closed".  (It's not a good proxy anyway -- the MR can make-a top-level binding with a free type variable.)--Note [Type variables in the type environment]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The type environment has a binding for each lexically-scoped-type variable that is in scope.  For example--  f :: forall a. a -> a-  f x = (x :: a)--  g1 :: [a] -> a-  g1 (ys :: [b]) = head ys :: b--  g2 :: [Int] -> Int-  g2 (ys :: [c]) = head ys :: c--* The forall'd variable 'a' in the signature scopes over f's RHS.--* The pattern-bound type variable 'b' in 'g1' scopes over g1's-  RHS; note that it is bound to a skolem 'a' which is not itself-  lexically in scope.--* The pattern-bound type variable 'c' in 'g2' is bound to-  Int; that is, pattern-bound type variables can stand for-  arbitrary types. (see-    GHC proposal #128 "Allow ScopedTypeVariables to refer to types"-    https://github.com/ghc-proposals/ghc-proposals/pull/128,-  and the paper-    "Type variables in patterns", Haskell Symposium 2018.---This is implemented by the constructor-   ATyVar Name TcTyVar-in the type environment.--* The Name is the name of the original, lexically scoped type-  variable--* The TcTyVar is sometimes a skolem (like in 'f'), and sometimes-  a unification variable (like in 'g1', 'g2').  We never zonk the-  type environment so in the latter case it always stays as a-  unification variable, although that variable may be later-  unified with a type (such as Int in 'g2').--}--instance Outputable IdBindingInfo where-  ppr NotLetBound = text "NotLetBound"-  ppr ClosedLet = text "TopLevelLet"-  ppr (NonClosedLet fvs closed_type) =-    text "TopLevelLet" <+> ppr fvs <+> ppr closed_type--instance Outputable PromotionErr where-  ppr ClassPE                     = text "ClassPE"-  ppr TyConPE                     = text "TyConPE"-  ppr PatSynPE                    = text "PatSynPE"-  ppr FamDataConPE                = text "FamDataConPE"-  ppr (ConstrainedDataConPE pred) = text "ConstrainedDataConPE"-                                      <+> parens (ppr pred)-  ppr RecDataConPE                = text "RecDataConPE"-  ppr NoDataKindsTC               = text "NoDataKindsTC"-  ppr NoDataKindsDC               = text "NoDataKindsDC"--pprTcTyThingCategory :: TcTyThing -> SDoc-pprTcTyThingCategory (AGlobal thing)    = pprTyThingCategory thing-pprTcTyThingCategory (ATyVar {})        = text "Type variable"-pprTcTyThingCategory (ATcId {})         = text "Local identifier"-pprTcTyThingCategory (ATcTyCon {})     = text "Local tycon"-pprTcTyThingCategory (APromotionErr pe) = pprPECategory pe--pprPECategory :: PromotionErr -> SDoc-pprPECategory ClassPE                = text "Class"-pprPECategory TyConPE                = text "Type constructor"-pprPECategory PatSynPE               = text "Pattern synonym"-pprPECategory FamDataConPE           = text "Data constructor"-pprPECategory ConstrainedDataConPE{} = text "Data constructor"-pprPECategory RecDataConPE           = text "Data constructor"-pprPECategory NoDataKindsTC          = text "Type constructor"-pprPECategory NoDataKindsDC          = text "Data constructor"--{--************************************************************************-*                                                                      *-        Operations over ImportAvails-*                                                                      *-************************************************************************--}---- | 'ImportAvails' summarises what was imported from where, irrespective of--- whether the imported things are actually used or not.  It is used:------  * when processing the export list,------  * when constructing usage info for the interface file,------  * to identify the list of directly imported modules for initialisation---    purposes and for optimised overlap checking of family instances,------  * when figuring out what things are really unused----data ImportAvails-   = ImportAvails {-        imp_mods :: ImportedMods,-          --      = ModuleEnv [ImportedModsVal],-          -- ^ Domain is all directly-imported modules-          ---          -- See the documentation on ImportedModsVal in HscTypes for the-          -- meaning of the fields.-          ---          -- We need a full ModuleEnv rather than a ModuleNameEnv here,-          -- because we might be importing modules of the same name from-          -- different packages. (currently not the case, but might be in the-          -- future).--        imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),-          -- ^ Home-package modules needed by the module being compiled-          ---          -- It doesn't matter whether any of these dependencies-          -- are actually /used/ when compiling the module; they-          -- are listed if they are below it at all.  For-          -- example, suppose M imports A which imports X.  Then-          -- compiling M might not need to consult X.hi, but X-          -- is still listed in M's dependencies.--        imp_dep_pkgs :: Set InstalledUnitId,-          -- ^ Packages needed by the module being compiled, whether directly,-          -- or via other modules in this package, or via modules imported-          -- from other packages.--        imp_trust_pkgs :: Set InstalledUnitId,-          -- ^ This is strictly a subset of imp_dep_pkgs and records the-          -- packages the current module needs to trust for Safe Haskell-          -- compilation to succeed. A package is required to be trusted if-          -- we are dependent on a trustworthy module in that package.-          -- While perhaps making imp_dep_pkgs a tuple of (UnitId, Bool)-          -- where True for the bool indicates the package is required to be-          -- trusted is the more logical  design, doing so complicates a lot-          -- of code not concerned with Safe Haskell.-          -- See Note [RnNames . Tracking Trust Transitively]--        imp_trust_own_pkg :: Bool,-          -- ^ Do we require that our own package is trusted?-          -- This is to handle efficiently the case where a Safe module imports-          -- a Trustworthy module that resides in the same package as it.-          -- See Note [RnNames . Trust Own Package]--        imp_orphs :: [Module],-          -- ^ Orphan modules below us in the import tree (and maybe including-          -- us for imported modules)--        imp_finsts :: [Module]-          -- ^ Family instance modules below us in the import tree (and maybe-          -- including us for imported modules)-      }--mkModDeps :: [(ModuleName, IsBootInterface)]-          -> ModuleNameEnv (ModuleName, IsBootInterface)-mkModDeps deps = foldl' add emptyUFM deps-               where-                 add env elt@(m,_) = addToUFM env m elt--modDepsElts-  :: ModuleNameEnv (ModuleName, IsBootInterface)-  -> [(ModuleName, IsBootInterface)]-modDepsElts = sort . nonDetEltsUFM-  -- It's OK to use nonDetEltsUFM here because sorting by module names-  -- restores determinism--emptyImportAvails :: ImportAvails-emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,-                                   imp_dep_mods      = emptyUFM,-                                   imp_dep_pkgs      = S.empty,-                                   imp_trust_pkgs    = S.empty,-                                   imp_trust_own_pkg = False,-                                   imp_orphs         = [],-                                   imp_finsts        = [] }---- | Union two ImportAvails------ This function is a key part of Import handling, basically--- for each import we create a separate ImportAvails structure--- and then union them all together with this function.-plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails-plusImportAvails-  (ImportAvails { imp_mods = mods1,-                  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,-                  imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,-                  imp_orphs = orphs1, imp_finsts = finsts1 })-  (ImportAvails { imp_mods = mods2,-                  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,-                  imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,-                  imp_orphs = orphs2, imp_finsts = finsts2 })-  = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,-                   imp_dep_mods      = plusUFM_C plus_mod_dep dmods1 dmods2,-                   imp_dep_pkgs      = dpkgs1 `S.union` dpkgs2,-                   imp_trust_pkgs    = tpkgs1 `S.union` tpkgs2,-                   imp_trust_own_pkg = tself1 || tself2,-                   imp_orphs         = orphs1 `unionLists` orphs2,-                   imp_finsts        = finsts1 `unionLists` finsts2 }-  where-    plus_mod_dep r1@(m1, boot1) r2@(m2, boot2)-      | ASSERT2( m1 == m2, (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )-        boot1 = r2-      | otherwise = r1-      -- If either side can "see" a non-hi-boot interface, use that-      -- Reusing existing tuples saves 10% of allocations on test-      -- perf/compiler/MultiLayerModules--{--************************************************************************-*                                                                      *-\subsection{Where from}-*                                                                      *-************************************************************************--The @WhereFrom@ type controls where the renamer looks for an interface file--}--data WhereFrom-  = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})-  | ImportBySystem                      -- Non user import.-  | ImportByPlugin                      -- Importing a plugin;-                                        -- See Note [Care with plugin imports] in LoadIface--instance Outputable WhereFrom where-  ppr (ImportByUser is_boot) | is_boot     = text "{- SOURCE -}"-                             | otherwise   = empty-  ppr ImportBySystem                       = text "{- SYSTEM -}"-  ppr ImportByPlugin                       = text "{- PLUGIN -}"---{- *********************************************************************-*                                                                      *-                Type signatures-*                                                                      *-********************************************************************* -}---- These data types need to be here only because--- TcSimplify uses them, and TcSimplify is fairly--- low down in the module hierarchy--type TcSigFun  = Name -> Maybe TcSigInfo--data TcSigInfo = TcIdSig     TcIdSigInfo-               | TcPatSynSig TcPatSynInfo--data TcIdSigInfo   -- See Note [Complete and partial type signatures]-  = CompleteSig    -- A complete signature with no wildcards,-                   -- so the complete polymorphic type is known.-      { sig_bndr :: TcId          -- The polymorphic Id with that type--      , sig_ctxt :: UserTypeCtxt  -- In the case of type-class default methods,-                                  -- the Name in the FunSigCtxt is not the same-                                  -- as the TcId; the former is 'op', while the-                                  -- latter is '$dmop' or some such--      , sig_loc  :: SrcSpan       -- Location of the type signature-      }--  | PartialSig     -- A partial type signature (i.e. includes one or more-                   -- wildcards). In this case it doesn't make sense to give-                   -- the polymorphic Id, because we are going to /infer/ its-                   -- type, so we can't make the polymorphic Id ab-initio-      { psig_name  :: Name   -- Name of the function; used when report wildcards-      , psig_hs_ty :: LHsSigWcType GhcRn  -- The original partial signature in-                                          -- HsSyn form-      , sig_ctxt   :: UserTypeCtxt-      , sig_loc    :: SrcSpan            -- Location of the type signature-      }---{- Note [Complete and partial type signatures]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-A type signature is partial when it contains one or more wildcards-(= type holes).  The wildcard can either be:-* A (type) wildcard occurring in sig_theta or sig_tau. These are-  stored in sig_wcs.-      f :: Bool -> _-      g :: Eq _a => _a -> _a -> Bool-* Or an extra-constraints wildcard, stored in sig_cts:-      h :: (Num a, _) => a -> a--A type signature is a complete type signature when there are no-wildcards in the type signature, i.e. iff sig_wcs is empty and-sig_extra_cts is Nothing.--}--data TcIdSigInst-  = TISI { sig_inst_sig :: TcIdSigInfo--         , sig_inst_skols :: [(Name, TcTyVar)]-               -- Instantiated type and kind variables, TyVarTvs-               -- The Name is the Name that the renamer chose;-               --   but the TcTyVar may come from instantiating-               --   the type and hence have a different unique.-               -- No need to keep track of whether they are truly lexically-               --   scoped because the renamer has named them uniquely-               -- See Note [Binding scoped type variables] in TcSigs-               ---               -- NB: The order of sig_inst_skols is irrelevant-               --     for a CompleteSig, but for a PartialSig see-               --     Note [Quantified varaibles in partial type signatures]--         , sig_inst_theta  :: TcThetaType-               -- Instantiated theta.  In the case of a-               -- PartialSig, sig_theta does not include-               -- the extra-constraints wildcard--         , sig_inst_tau :: TcSigmaType   -- Instantiated tau-               -- See Note [sig_inst_tau may be polymorphic]--         -- Relevant for partial signature only-         , sig_inst_wcs   :: [(Name, TcTyVar)]-               -- Like sig_inst_skols, but for /named/ wildcards (_a etc).-               -- The named wildcards scope over the binding, and hence-               -- their Names may appear in type signatures in the binding--         , sig_inst_wcx   :: Maybe TcType-               -- Extra-constraints wildcard to fill in, if any-               -- If this exists, it is surely of the form (meta_tv |> co)-               -- (where the co might be reflexive). This is filled in-               -- only from the return value of TcHsType.tcAnonWildCardOcc-         }--{- Note [sig_inst_tau may be polymorphic]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Note that "sig_inst_tau" might actually be a polymorphic type,-if the original function had a signature like-   forall a. Eq a => forall b. Ord b => ....-But that's ok: tcMatchesFun (called by tcRhs) can deal with that-It happens, too!  See Note [Polymorphic methods] in TcClassDcl.--Note [Quantified varaibles in partial type signatures]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider-   f :: forall a b. _ -> a -> _ -> b-   f (x,y) p q = q--Then we expect f's final type to be-  f :: forall {x,y}. forall a b. (x,y) -> a -> b -> b--Note that x,y are Inferred, and can't be use for visible type-application (VTA).  But a,b are Specified, and remain Specified-in the final type, so we can use VTA for them.  (Exception: if-it turns out that a's kind mentions b we need to reorder them-with scopedSort.)--The sig_inst_skols of the TISI from a partial signature records-that original order, and is used to get the variables of f's-final type in the correct order.---Note [Wildcards in partial signatures]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The wildcards in psig_wcs may stand for a type mentioning-the universally-quantified tyvars of psig_ty--E.g.  f :: forall a. _ -> a-      f x = x-We get sig_inst_skols = [a]-       sig_inst_tau   = _22 -> a-       sig_inst_wcs   = [_22]-and _22 in the end is unified with the type 'a'--Moreover the kind of a wildcard in sig_inst_wcs may mention-the universally-quantified tyvars sig_inst_skols-e.g.   f :: t a -> t _-Here we get-   sig_inst_skols = [k:*, (t::k ->*), (a::k)]-   sig_inst_tau   = t a -> t _22-   sig_inst_wcs   = [ _22::k ]--}--data TcPatSynInfo-  = TPSI {-        patsig_name           :: Name,-        patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Inferred) and-                                                -- implicitly-bound type vars (Specified)-          -- See Note [The pattern-synonym signature splitting rule] in TcPatSyn-        patsig_univ_bndrs     :: [TyVar],       -- Bound by explicit user forall-        patsig_req            :: TcThetaType,-        patsig_ex_bndrs       :: [TyVar],       -- Bound by explicit user forall-        patsig_prov           :: TcThetaType,-        patsig_body_ty        :: TcSigmaType-    }--instance Outputable TcSigInfo where-  ppr (TcIdSig     idsi) = ppr idsi-  ppr (TcPatSynSig tpsi) = text "TcPatSynInfo" <+> ppr tpsi--instance Outputable TcIdSigInfo where-    ppr (CompleteSig { sig_bndr = bndr })-        = ppr bndr <+> dcolon <+> ppr (idType bndr)-    ppr (PartialSig { psig_name = name, psig_hs_ty = hs_ty })-        = text "psig" <+> ppr name <+> dcolon <+> ppr hs_ty--instance Outputable TcIdSigInst where-    ppr (TISI { sig_inst_sig = sig, sig_inst_skols = skols-              , sig_inst_theta = theta, sig_inst_tau = tau })-        = hang (ppr sig) 2 (vcat [ ppr skols, ppr theta <+> darrow <+> ppr tau ])--instance Outputable TcPatSynInfo where-    ppr (TPSI{ patsig_name = name}) = ppr name--isPartialSig :: TcIdSigInst -> Bool-isPartialSig (TISI { sig_inst_sig = PartialSig {} }) = True-isPartialSig _                                       = False---- | No signature or a partial signature-hasCompleteSig :: TcSigFun -> Name -> Bool-hasCompleteSig sig_fn name-  = case sig_fn name of-      Just (TcIdSig (CompleteSig {})) -> True-      _                               -> False---{--************************************************************************-*                                                                      *-*                       Canonical constraints                          *-*                                                                      *-*   These are the constraints the low-level simplifier works with      *-*                                                                      *-************************************************************************--}---- The syntax of xi (ξ) types:--- xi ::= a | T xis | xis -> xis | ... | forall a. tau--- Two important notes:---      (i) No type families, unless we are under a ForAll---      (ii) Note that xi types can contain unexpanded type synonyms;---           however, the (transitive) expansions of those type synonyms---           will not contain any type functions, unless we are under a ForAll.--- We enforce the structure of Xi types when we flatten (TcCanonical)--type Xi = Type       -- In many comments, "xi" ranges over Xi--type Cts = Bag Ct--data Ct-  -- Atomic canonical constraints-  = CDictCan {  -- e.g.  Num xi-      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]--      cc_class  :: Class,-      cc_tyargs :: [Xi],   -- cc_tyargs are function-free, hence Xi--      cc_pend_sc :: Bool   -- See Note [The superclass story] in TcCanonical-                           -- True <=> (a) cc_class has superclasses-                           --          (b) we have not (yet) added those-                           --              superclasses as Givens-    }--  | CIrredCan {  -- These stand for yet-unusable predicates-      cc_ev    :: CtEvidence,   -- See Note [Ct/evidence invariant]-      cc_insol :: Bool   -- True  <=> definitely an error, can never be solved-                         -- False <=> might be soluble--        -- For the might-be-soluble case, the ctev_pred of the evidence is-        -- of form   (tv xi1 xi2 ... xin)   with a tyvar at the head-        --      or   (tv1 ~ ty2)   where the CTyEqCan  kind invariant fails-        --      or   (F tys ~ ty)  where the CFunEqCan kind invariant fails-        -- See Note [CIrredCan constraints]--        -- The definitely-insoluble case is for things like-        --    Int ~ Bool      tycons don't match-        --    a ~ [a]         occurs check-    }--  | CTyEqCan {  -- tv ~ rhs-       -- Invariants:-       --   * See Note [Applying the inert substitution] in TcFlatten-       --   * tv not in tvs(rhs)   (occurs check)-       --   * If tv is a TauTv, then rhs has no foralls-       --       (this avoids substituting a forall for the tyvar in other types)-       --   * tcTypeKind ty `tcEqKind` tcTypeKind tv; Note [Ct kind invariant]-       --   * rhs may have at most one top-level cast-       --   * rhs (perhaps under the one cast) is not necessarily function-free,-       --       but it has no top-level function.-       --     E.g. a ~ [F b]  is fine-       --     but  a ~ F b    is not-       --   * If the equality is representational, rhs has no top-level newtype-       --     See Note [No top-level newtypes on RHS of representational-       --     equalities] in TcCanonical-       --   * If rhs (perhaps under the cast) is also a tv, then it is oriented-       --     to give best chance of-       --     unification happening; eg if rhs is touchable then lhs is too-      cc_ev     :: CtEvidence, -- See Note [Ct/evidence invariant]-      cc_tyvar  :: TcTyVar,-      cc_rhs    :: TcType,     -- Not necessarily function-free (hence not Xi)-                               -- See invariants above--      cc_eq_rel :: EqRel       -- INVARIANT: cc_eq_rel = ctEvEqRel cc_ev-    }--  | CFunEqCan {  -- F xis ~ fsk-       -- Invariants:-       --   * isTypeFamilyTyCon cc_fun-       --   * tcTypeKind (F xis) = tyVarKind fsk; Note [Ct kind invariant]-       --   * always Nominal role-      cc_ev     :: CtEvidence,  -- See Note [Ct/evidence invariant]-      cc_fun    :: TyCon,       -- A type function--      cc_tyargs :: [Xi],        -- cc_tyargs are function-free (hence Xi)-        -- Either under-saturated or exactly saturated-        --    *never* over-saturated (because if so-        --    we should have decomposed)--      cc_fsk    :: TcTyVar  -- [G]  always a FlatSkolTv-                            -- [W], [WD], or [D] always a FlatMetaTv-        -- See Note [The flattening story] in TcFlatten-    }--  | CNonCanonical {        -- See Note [NonCanonical Semantics] in TcSMonad-      cc_ev  :: CtEvidence-    }--  | CHoleCan {             -- See Note [Hole constraints]-       -- Treated as an "insoluble" constraint-       -- See Note [Insoluble constraints]-      cc_ev   :: CtEvidence,-      cc_hole :: Hole-    }--  | CQuantCan QCInst       -- A quantified constraint-      -- NB: I expect to make more of the cases in Ct-      --     look like this, with the payload in an-      --     auxiliary type---------------data QCInst  -- A much simplified version of ClsInst-             -- See Note [Quantified constraints] in TcCanonical-  = QCI { qci_ev   :: CtEvidence -- Always of type forall tvs. context => ty-                                 -- Always Given-        , qci_tvs  :: [TcTyVar]  -- The tvs-        , qci_pred :: TcPredType -- The ty-        , qci_pend_sc :: Bool    -- Same as cc_pend_sc flag in CDictCan-                                 -- Invariant: True => qci_pred is a ClassPred-    }--instance Outputable QCInst where-  ppr (QCI { qci_ev = ev }) = ppr ev----------------- | An expression or type hole-data Hole = ExprHole UnboundVar-            -- ^ Either an out-of-scope variable or a "true" hole in an-            -- expression (TypedHoles)-          | TypeHole OccName-            -- ^ A hole in a type (PartialTypeSignatures)--instance Outputable Hole where-  ppr (ExprHole ub)  = ppr ub-  ppr (TypeHole occ) = text "TypeHole" <> parens (ppr occ)--holeOcc :: Hole -> OccName-holeOcc (ExprHole uv)  = unboundVarOcc uv-holeOcc (TypeHole occ) = occ--{- Note [Hole constraints]-~~~~~~~~~~~~~~~~~~~~~~~~~~-CHoleCan constraints are used for two kinds of holes,-distinguished by cc_hole:--  * For holes in expressions (including variables not in scope)-    e.g.   f x = g _ x--  * For holes in type signatures-    e.g.   f :: _ -> _-           f x = [x,True]--Note [CIrredCan constraints]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-CIrredCan constraints are used for constraints that are "stuck"-   - we can't solve them (yet)-   - we can't use them to solve other constraints-   - but they may become soluble if we substitute for some-     of the type variables in the constraint--Example 1:  (c Int), where c :: * -> Constraint.  We can't do anything-            with this yet, but if later c := Num, *then* we can solve it--Example 2:  a ~ b, where a :: *, b :: k, where k is a kind variable-            We don't want to use this to substitute 'b' for 'a', in case-            'k' is subsequently unifed with (say) *->*, because then-            we'd have ill-kinded types floating about.  Rather we want-            to defer using the equality altogether until 'k' get resolved.--Note [Ct/evidence invariant]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-If  ct :: Ct, then extra fields of 'ct' cache precisely the ctev_pred field-of (cc_ev ct), and is fully rewritten wrt the substitution.   Eg for CDictCan,-   ctev_pred (cc_ev ct) = (cc_class ct) (cc_tyargs ct)-This holds by construction; look at the unique place where CDictCan is-built (in TcCanonical).--In contrast, the type of the evidence *term* (ctev_dest / ctev_evar) in-the evidence may *not* be fully zonked; we are careful not to look at it-during constraint solving. See Note [Evidence field of CtEvidence].--Note [Ct kind invariant]-~~~~~~~~~~~~~~~~~~~~~~~~-CTyEqCan and CFunEqCan both require that the kind of the lhs matches the kind-of the rhs. This is necessary because both constraints are used for substitutions-during solving. If the kinds differed, then the substitution would take a well-kinded-type to an ill-kinded one.---}--mkNonCanonical :: CtEvidence -> Ct-mkNonCanonical ev = CNonCanonical { cc_ev = ev }--mkNonCanonicalCt :: Ct -> Ct-mkNonCanonicalCt ct = CNonCanonical { cc_ev = cc_ev ct }--mkIrredCt :: CtEvidence -> Ct-mkIrredCt ev = CIrredCan { cc_ev = ev, cc_insol = False }--mkInsolubleCt :: CtEvidence -> Ct-mkInsolubleCt ev = CIrredCan { cc_ev = ev, cc_insol = True }--mkGivens :: CtLoc -> [EvId] -> [Ct]-mkGivens loc ev_ids-  = map mk ev_ids-  where-    mk ev_id = mkNonCanonical (CtGiven { ctev_evar = ev_id-                                       , ctev_pred = evVarPred ev_id-                                       , ctev_loc = loc })--ctEvidence :: Ct -> CtEvidence-ctEvidence (CQuantCan (QCI { qci_ev = ev })) = ev-ctEvidence ct = cc_ev ct--ctLoc :: Ct -> CtLoc-ctLoc = ctEvLoc . ctEvidence--setCtLoc :: Ct -> CtLoc -> Ct-setCtLoc ct loc = ct { cc_ev = (cc_ev ct) { ctev_loc = loc } }--ctOrigin :: Ct -> CtOrigin-ctOrigin = ctLocOrigin . ctLoc--ctPred :: Ct -> PredType--- See Note [Ct/evidence invariant]-ctPred ct = ctEvPred (ctEvidence ct)--ctEvId :: Ct -> EvVar--- The evidence Id for this Ct-ctEvId ct = ctEvEvId (ctEvidence ct)---- | Makes a new equality predicate with the same role as the given--- evidence.-mkTcEqPredLikeEv :: CtEvidence -> TcType -> TcType -> TcType-mkTcEqPredLikeEv ev-  = case predTypeEqRel pred of-      NomEq  -> mkPrimEqPred-      ReprEq -> mkReprPrimEqPred-  where-    pred = ctEvPred ev---- | Get the flavour of the given 'Ct'-ctFlavour :: Ct -> CtFlavour-ctFlavour = ctEvFlavour . ctEvidence---- | Get the equality relation for the given 'Ct'-ctEqRel :: Ct -> EqRel-ctEqRel = ctEvEqRel . ctEvidence--instance Outputable Ct where-  ppr ct = ppr (ctEvidence ct) <+> parens pp_sort-    where-      pp_sort = case ct of-         CTyEqCan {}      -> text "CTyEqCan"-         CFunEqCan {}     -> text "CFunEqCan"-         CNonCanonical {} -> text "CNonCanonical"-         CDictCan { cc_pend_sc = pend_sc }-            | pend_sc   -> text "CDictCan(psc)"-            | otherwise -> text "CDictCan"-         CIrredCan { cc_insol = insol }-            | insol     -> text "CIrredCan(insol)"-            | otherwise -> text "CIrredCan(sol)"-         CHoleCan { cc_hole = hole } -> text "CHoleCan:" <+> ppr hole-         CQuantCan (QCI { qci_pend_sc = pend_sc })-            | pend_sc   -> text "CQuantCan(psc)"-            | otherwise -> text "CQuantCan"--{--************************************************************************-*                                                                      *-        Simple functions over evidence variables-*                                                                      *-************************************************************************--}------------------ Getting free tyvars ----------------------------- | Returns free variables of constraints as a non-deterministic set-tyCoVarsOfCt :: Ct -> TcTyCoVarSet-tyCoVarsOfCt = fvVarSet . tyCoFVsOfCt---- | Returns free variables of constraints as a deterministically ordered.--- list. See Note [Deterministic FV] in FV.-tyCoVarsOfCtList :: Ct -> [TcTyCoVar]-tyCoVarsOfCtList = fvVarList . tyCoFVsOfCt---- | Returns free variables of constraints as a composable FV computation.--- See Note [Deterministic FV] in FV.-tyCoFVsOfCt :: Ct -> FV-tyCoFVsOfCt (CTyEqCan { cc_tyvar = tv, cc_rhs = xi })-  = tyCoFVsOfType xi `unionFV` FV.unitFV tv-                     `unionFV` tyCoFVsOfType (tyVarKind tv)-tyCoFVsOfCt (CFunEqCan { cc_tyargs = tys, cc_fsk = fsk })-  = tyCoFVsOfTypes tys `unionFV` FV.unitFV fsk-                       `unionFV` tyCoFVsOfType (tyVarKind fsk)-tyCoFVsOfCt (CDictCan { cc_tyargs = tys }) = tyCoFVsOfTypes tys-tyCoFVsOfCt ct = tyCoFVsOfType (ctPred ct)---- | Returns free variables of a bag of constraints as a non-deterministic--- set. See Note [Deterministic FV] in FV.-tyCoVarsOfCts :: Cts -> TcTyCoVarSet-tyCoVarsOfCts = fvVarSet . tyCoFVsOfCts---- | Returns free variables of a bag of constraints as a deterministically--- odered list. See Note [Deterministic FV] in FV.-tyCoVarsOfCtsList :: Cts -> [TcTyCoVar]-tyCoVarsOfCtsList = fvVarList . tyCoFVsOfCts---- | Returns free variables of a bag of constraints as a composable FV--- computation. See Note [Deterministic FV] in FV.-tyCoFVsOfCts :: Cts -> FV-tyCoFVsOfCts = foldr (unionFV . tyCoFVsOfCt) emptyFV---- | Returns free variables of WantedConstraints as a non-deterministic--- set. See Note [Deterministic FV] in FV.-tyCoVarsOfWC :: WantedConstraints -> TyCoVarSet--- Only called on *zonked* things, hence no need to worry about flatten-skolems-tyCoVarsOfWC = fvVarSet . tyCoFVsOfWC---- | Returns free variables of WantedConstraints as a deterministically--- ordered list. See Note [Deterministic FV] in FV.-tyCoVarsOfWCList :: WantedConstraints -> [TyCoVar]--- Only called on *zonked* things, hence no need to worry about flatten-skolems-tyCoVarsOfWCList = fvVarList . tyCoFVsOfWC---- | Returns free variables of WantedConstraints as a composable FV--- computation. See Note [Deterministic FV] in FV.-tyCoFVsOfWC :: WantedConstraints -> FV--- Only called on *zonked* things, hence no need to worry about flatten-skolems-tyCoFVsOfWC (WC { wc_simple = simple, wc_impl = implic })-  = tyCoFVsOfCts simple `unionFV`-    tyCoFVsOfBag tyCoFVsOfImplic implic---- | Returns free variables of Implication as a composable FV computation.--- See Note [Deterministic FV] in FV.-tyCoFVsOfImplic :: Implication -> FV--- Only called on *zonked* things, hence no need to worry about flatten-skolems-tyCoFVsOfImplic (Implic { ic_skols = skols-                        , ic_given = givens-                        , ic_wanted = wanted })-  | isEmptyWC wanted-  = emptyFV-  | otherwise-  = tyCoFVsVarBndrs skols  $-    tyCoFVsVarBndrs givens $-    tyCoFVsOfWC wanted--tyCoFVsOfBag :: (a -> FV) -> Bag a -> FV-tyCoFVsOfBag tvs_of = foldr (unionFV . tvs_of) emptyFV------------------------------dropDerivedWC :: WantedConstraints -> WantedConstraints--- See Note [Dropping derived constraints]-dropDerivedWC wc@(WC { wc_simple = simples })-  = wc { wc_simple = dropDerivedSimples simples }-    -- The wc_impl implications are already (recursively) filtered-----------------------------dropDerivedSimples :: Cts -> Cts--- Drop all Derived constraints, but make [W] back into [WD],--- so that if we re-simplify these constraints we will get all--- the right derived constraints re-generated.  Forgetting this--- step led to #12936-dropDerivedSimples simples = mapMaybeBag dropDerivedCt simples--dropDerivedCt :: Ct -> Maybe Ct-dropDerivedCt ct-  = case ctEvFlavour ev of-      Wanted WOnly -> Just (ct' { cc_ev = ev_wd })-      Wanted _     -> Just ct'-      _ | isDroppableCt ct -> Nothing-        | otherwise        -> Just ct-  where-    ev    = ctEvidence ct-    ev_wd = ev { ctev_nosh = WDeriv }-    ct'   = setPendingScDict ct -- See Note [Resetting cc_pend_sc]--{- Note [Resetting cc_pend_sc]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-When we discard Derived constraints, in dropDerivedSimples, we must-set the cc_pend_sc flag to True, so that if we re-process this-CDictCan we will re-generate its derived superclasses. Otherwise-we might miss some fundeps.  #13662 showed this up.--See Note [The superclass story] in TcCanonical.--}--isDroppableCt :: Ct -> Bool-isDroppableCt ct-  = isDerived ev && not keep_deriv-    -- Drop only derived constraints, and then only if they-    -- obey Note [Dropping derived constraints]-  where-    ev   = ctEvidence ct-    loc  = ctEvLoc ev-    orig = ctLocOrigin loc--    keep_deriv-      = case ct of-          CHoleCan {} -> True-          CIrredCan { cc_insol = insoluble }-                      -> keep_eq insoluble-          _           -> keep_eq False--    keep_eq definitely_insoluble-       | isGivenOrigin orig    -- Arising only from givens-       = definitely_insoluble  -- Keep only definitely insoluble-       | otherwise-       = case orig of-           KindEqOrigin {} -> True    -- See Note [Dropping derived constraints]--           -- See Note [Dropping derived constraints]-           -- For fundeps, drop wanted/wanted interactions-           FunDepOrigin2 {} -> True   -- Top-level/Wanted-           FunDepOrigin1 _ loc1 _ loc2-             | g1 || g2  -> True  -- Given/Wanted errors: keep all-             | otherwise -> False -- Wanted/Wanted errors: discard-             where-               g1 = isGivenLoc loc1-               g2 = isGivenLoc loc2--           _ -> False--arisesFromGivens :: Ct -> Bool-arisesFromGivens ct-  = case ctEvidence ct of-      CtGiven {}                   -> True-      CtWanted {}                  -> False-      CtDerived { ctev_loc = loc } -> isGivenLoc loc--isGivenLoc :: CtLoc -> Bool-isGivenLoc loc = isGivenOrigin (ctLocOrigin loc)--isGivenOrigin :: CtOrigin -> Bool-isGivenOrigin (GivenOrigin {})          = True-isGivenOrigin (FunDepOrigin1 _ l1 _ l2) = isGivenLoc l1 && isGivenLoc l2-isGivenOrigin (FunDepOrigin2 _ o1 _ _)  = isGivenOrigin o1-isGivenOrigin _                         = False--{- Note [Dropping derived constraints]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-In general we discard derived constraints at the end of constraint solving;-see dropDerivedWC.  For example-- * Superclasses: if we have an unsolved [W] (Ord a), we don't want to-   complain about an unsolved [D] (Eq a) as well.-- * If we have [W] a ~ Int, [W] a ~ Bool, improvement will generate-   [D] Int ~ Bool, and we don't want to report that because it's-   incomprehensible. That is why we don't rewrite wanteds with wanteds!-- * We might float out some Wanteds from an implication, leaving behind-   their insoluble Deriveds. For example:--   forall a[2]. [W] alpha[1] ~ Int-                [W] alpha[1] ~ Bool-                [D] Int ~ Bool--   The Derived is insoluble, but we very much want to drop it when floating-   out.--But (tiresomely) we do keep *some* Derived constraints:-- * Type holes are derived constraints, because they have no evidence-   and we want to keep them, so we get the error report-- * Insoluble kind equalities (e.g. [D] * ~ (* -> *)), with-   KindEqOrigin, may arise from a type equality a ~ Int#, say.  See-   Note [Equalities with incompatible kinds] in TcCanonical.-   Keeping these around produces better error messages, in practice.-   E.g., test case dependent/should_fail/T11471-- * We keep most derived equalities arising from functional dependencies-      - Given/Given interactions (subset of FunDepOrigin1):-        The definitely-insoluble ones reflect unreachable code.--        Others not-definitely-insoluble ones like [D] a ~ Int do not-        reflect unreachable code; indeed if fundeps generated proofs, it'd-        be a useful equality.  See #14763.   So we discard them.--      - Given/Wanted interacGiven or Wanted interacting with an-        instance declaration (FunDepOrigin2)--      - Given/Wanted interactions (FunDepOrigin1); see #9612--      - But for Wanted/Wanted interactions we do /not/ want to report an-        error (#13506).  Consider [W] C Int Int, [W] C Int Bool, with-        a fundep on class C.  We don't want to report an insoluble Int~Bool;-        c.f. "wanteds do not rewrite wanteds".--To distinguish these cases we use the CtOrigin.--NB: we keep *all* derived insolubles under some circumstances:--  * They are looked at by simplifyInfer, to decide whether to-    generalise.  Example: [W] a ~ Int, [W] a ~ Bool-    We get [D] Int ~ Bool, and indeed the constraints are insoluble,-    and we want simplifyInfer to see that, even though we don't-    ultimately want to generate an (inexplicable) error message from it---************************************************************************-*                                                                      *-                    CtEvidence-         The "flavor" of a canonical constraint-*                                                                      *-************************************************************************--}--isWantedCt :: Ct -> Bool-isWantedCt = isWanted . ctEvidence--isGivenCt :: Ct -> Bool-isGivenCt = isGiven . ctEvidence--isDerivedCt :: Ct -> Bool-isDerivedCt = isDerived . ctEvidence--isCTyEqCan :: Ct -> Bool-isCTyEqCan (CTyEqCan {})  = True-isCTyEqCan (CFunEqCan {}) = False-isCTyEqCan _              = False--isCDictCan_Maybe :: Ct -> Maybe Class-isCDictCan_Maybe (CDictCan {cc_class = cls })  = Just cls-isCDictCan_Maybe _              = Nothing--isCFunEqCan_maybe :: Ct -> Maybe (TyCon, [Type])-isCFunEqCan_maybe (CFunEqCan { cc_fun = tc, cc_tyargs = xis }) = Just (tc, xis)-isCFunEqCan_maybe _ = Nothing--isCFunEqCan :: Ct -> Bool-isCFunEqCan (CFunEqCan {}) = True-isCFunEqCan _ = False--isCNonCanonical :: Ct -> Bool-isCNonCanonical (CNonCanonical {}) = True-isCNonCanonical _ = False--isHoleCt:: Ct -> Bool-isHoleCt (CHoleCan {}) = True-isHoleCt _ = False--isOutOfScopeCt :: Ct -> Bool--- We treat expression holes representing out-of-scope variables a bit--- differently when it comes to error reporting-isOutOfScopeCt (CHoleCan { cc_hole = ExprHole (OutOfScope {}) }) = True-isOutOfScopeCt _ = False--isExprHoleCt :: Ct -> Bool-isExprHoleCt (CHoleCan { cc_hole = ExprHole {} }) = True-isExprHoleCt _ = False--isTypeHoleCt :: Ct -> Bool-isTypeHoleCt (CHoleCan { cc_hole = TypeHole {} }) = True-isTypeHoleCt _ = False---{- Note [Custom type errors in constraints]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--When GHC reports a type-error about an unsolved-constraint, we check-to see if the constraint contains any custom-type errors, and if so-we report them.  Here are some examples of constraints containing type-errors:--TypeError msg           -- The actual constraint is a type error--TypError msg ~ Int      -- Some type was supposed to be Int, but ended up-                        -- being a type error instead--Eq (TypeError msg)      -- A class constraint is stuck due to a type error--F (TypeError msg) ~ a   -- A type function failed to evaluate due to a type err--It is also possible to have constraints where the type error is nested deeper,-for example see #11990, and also:--Eq (F (TypeError msg))  -- Here the type error is nested under a type-function-                        -- call, which failed to evaluate because of it,-                        -- and so the `Eq` constraint was unsolved.-                        -- This may happen when one function calls another-                        -- and the called function produced a custom type error.--}---- | A constraint is considered to be a custom type error, if it contains--- custom type errors anywhere in it.--- See Note [Custom type errors in constraints]-getUserTypeErrorMsg :: Ct -> Maybe Type-getUserTypeErrorMsg ct = findUserTypeError (ctPred ct)-  where-  findUserTypeError t = msum ( userTypeError_maybe t-                             : map findUserTypeError (subTys t)-                             )--  subTys t            = case splitAppTys t of-                          (t,[]) ->-                            case splitTyConApp_maybe t of-                              Nothing     -> []-                              Just (_,ts) -> ts-                          (t,ts) -> t : ts-----isUserTypeErrorCt :: Ct -> Bool-isUserTypeErrorCt ct = case getUserTypeErrorMsg ct of-                         Just _ -> True-                         _      -> False--isPendingScDict :: Ct -> Maybe Ct--- Says whether this is a CDictCan with cc_pend_sc is True,--- AND if so flips the flag-isPendingScDict ct@(CDictCan { cc_pend_sc = True })-                  = Just (ct { cc_pend_sc = False })-isPendingScDict _ = Nothing--isPendingScInst :: QCInst -> Maybe QCInst--- Same as isPrendinScDict, but for QCInsts-isPendingScInst qci@(QCI { qci_pend_sc = True })-                  = Just (qci { qci_pend_sc = False })-isPendingScInst _ = Nothing--setPendingScDict :: Ct -> Ct--- Set the cc_pend_sc flag to True-setPendingScDict ct@(CDictCan { cc_pend_sc = False })-                    = ct { cc_pend_sc = True }-setPendingScDict ct = ct--superClassesMightHelp :: WantedConstraints -> Bool--- ^ True if taking superclasses of givens, or of wanteds (to perhaps--- expose more equalities or functional dependencies) might help to--- solve this constraint.  See Note [When superclasses help]-superClassesMightHelp (WC { wc_simple = simples, wc_impl = implics })-  = anyBag might_help_ct simples || anyBag might_help_implic implics-  where-    might_help_implic ic-       | IC_Unsolved <- ic_status ic = superClassesMightHelp (ic_wanted ic)-       | otherwise                   = False--    might_help_ct ct = isWantedCt ct && not (is_ip ct)--    is_ip (CDictCan { cc_class = cls }) = isIPClass cls-    is_ip _                             = False--getPendingWantedScs :: Cts -> ([Ct], Cts)-getPendingWantedScs simples-  = mapAccumBagL get [] simples-  where-    get acc ct | Just ct' <- isPendingScDict ct-               = (ct':acc, ct')-               | otherwise-               = (acc,     ct)--{- Note [When superclasses help]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-First read Note [The superclass story] in TcCanonical.--We expand superclasses and iterate only if there is at unsolved wanted-for which expansion of superclasses (e.g. from given constraints)-might actually help. The function superClassesMightHelp tells if-doing this superclass expansion might help solve this constraint.-Note that--  * We look inside implications; maybe it'll help to expand the Givens-    at level 2 to help solve an unsolved Wanted buried inside an-    implication.  E.g.-        forall a. Ord a => forall b. [W] Eq a--  * Superclasses help only for Wanted constraints.  Derived constraints-    are not really "unsolved" and we certainly don't want them to-    trigger superclass expansion. This was a good part of the loop-    in  #11523--  * Even for Wanted constraints, we say "no" for implicit parameters.-    we have [W] ?x::ty, expanding superclasses won't help:-      - Superclasses can't be implicit parameters-      - If we have a [G] ?x:ty2, then we'll have another unsolved-        [D] ty ~ ty2 (from the functional dependency)-        which will trigger superclass expansion.--    It's a bit of a special case, but it's easy to do.  The runtime cost-    is low because the unsolved set is usually empty anyway (errors-    aside), and the first non-imlicit-parameter will terminate the search.--    The special case is worth it (#11480, comment:2) because it-    applies to CallStack constraints, which aren't type errors. If we have-       f :: (C a) => blah-       f x = ...undefined...-    we'll get a CallStack constraint.  If that's the only unsolved-    constraint it'll eventually be solved by defaulting.  So we don't-    want to emit warnings about hitting the simplifier's iteration-    limit.  A CallStack constraint really isn't an unsolved-    constraint; it can always be solved by defaulting.--}--singleCt :: Ct -> Cts-singleCt = unitBag--andCts :: Cts -> Cts -> Cts-andCts = unionBags--listToCts :: [Ct] -> Cts-listToCts = listToBag--ctsElts :: Cts -> [Ct]-ctsElts = bagToList--consCts :: Ct -> Cts -> Cts-consCts = consBag--snocCts :: Cts -> Ct -> Cts-snocCts = snocBag--extendCtsList :: Cts -> [Ct] -> Cts-extendCtsList cts xs | null xs   = cts-                     | otherwise = cts `unionBags` listToBag xs--andManyCts :: [Cts] -> Cts-andManyCts = unionManyBags--emptyCts :: Cts-emptyCts = emptyBag--isEmptyCts :: Cts -> Bool-isEmptyCts = isEmptyBag--pprCts :: Cts -> SDoc-pprCts cts = vcat (map ppr (bagToList cts))--{--************************************************************************-*                                                                      *-                Wanted constraints-     These are forced to be in TcRnTypes because-           TcLclEnv mentions WantedConstraints-           WantedConstraint mentions CtLoc-           CtLoc mentions ErrCtxt-           ErrCtxt mentions TcM-*                                                                      *-v%************************************************************************--}--data WantedConstraints-  = WC { wc_simple :: Cts              -- Unsolved constraints, all wanted-       , wc_impl   :: Bag Implication-    }--emptyWC :: WantedConstraints-emptyWC = WC { wc_simple = emptyBag, wc_impl = emptyBag }--mkSimpleWC :: [CtEvidence] -> WantedConstraints-mkSimpleWC cts-  = WC { wc_simple = listToBag (map mkNonCanonical cts)-       , wc_impl = emptyBag }--mkImplicWC :: Bag Implication -> WantedConstraints-mkImplicWC implic-  = WC { wc_simple = emptyBag, wc_impl = implic }--isEmptyWC :: WantedConstraints -> Bool-isEmptyWC (WC { wc_simple = f, wc_impl = i })-  = isEmptyBag f && isEmptyBag i----- | Checks whether a the given wanted constraints are solved, i.e.--- that there are no simple constraints left and all the implications--- are solved.-isSolvedWC :: WantedConstraints -> Bool-isSolvedWC WC {wc_simple = wc_simple, wc_impl = wc_impl} =-  isEmptyBag wc_simple && allBag (isSolvedStatus . ic_status) wc_impl--andWC :: WantedConstraints -> WantedConstraints -> WantedConstraints-andWC (WC { wc_simple = f1, wc_impl = i1 })-      (WC { wc_simple = f2, wc_impl = i2 })-  = WC { wc_simple = f1 `unionBags` f2-       , wc_impl   = i1 `unionBags` i2 }--unionsWC :: [WantedConstraints] -> WantedConstraints-unionsWC = foldr andWC emptyWC--addSimples :: WantedConstraints -> Bag Ct -> WantedConstraints-addSimples wc cts-  = wc { wc_simple = wc_simple wc `unionBags` cts }-    -- Consider: Put the new constraints at the front, so they get solved first--addImplics :: WantedConstraints -> Bag Implication -> WantedConstraints-addImplics wc implic = wc { wc_impl = wc_impl wc `unionBags` implic }--addInsols :: WantedConstraints -> Bag Ct -> WantedConstraints-addInsols wc cts-  = wc { wc_simple = wc_simple wc `unionBags` cts }--insolublesOnly :: WantedConstraints -> WantedConstraints--- Keep only the definitely-insoluble constraints-insolublesOnly (WC { wc_simple = simples, wc_impl = implics })-  = WC { wc_simple = filterBag insolubleCt simples-       , wc_impl   = mapBag implic_insols_only implics }-  where-    implic_insols_only implic-      = implic { ic_wanted = insolublesOnly (ic_wanted implic) }--isSolvedStatus :: ImplicStatus -> Bool-isSolvedStatus (IC_Solved {}) = True-isSolvedStatus _              = False--isInsolubleStatus :: ImplicStatus -> Bool-isInsolubleStatus IC_Insoluble    = True-isInsolubleStatus IC_BadTelescope = True-isInsolubleStatus _               = False--insolubleImplic :: Implication -> Bool-insolubleImplic ic = isInsolubleStatus (ic_status ic)--insolubleWC :: WantedConstraints -> Bool-insolubleWC (WC { wc_impl = implics, wc_simple = simples })-  =  anyBag insolubleCt simples-  || anyBag insolubleImplic implics--insolubleCt :: Ct -> Bool--- Definitely insoluble, in particular /excluding/ type-hole constraints--- Namely: a) an equality constraint---         b) that is insoluble---         c) and does not arise from a Given-insolubleCt ct-  | isHoleCt ct            = isOutOfScopeCt ct  -- See Note [Insoluble holes]-  | not (insolubleEqCt ct) = False-  | arisesFromGivens ct    = False              -- See Note [Given insolubles]-  | otherwise              = True--insolubleEqCt :: Ct -> Bool--- Returns True of /equality/ constraints--- that are /definitely/ insoluble--- It won't detect some definite errors like---       F a ~ T (F a)--- where F is a type family, which actually has an occurs check------ The function is tuned for application /after/ constraint solving---       i.e. assuming canonicalisation has been done--- E.g.  It'll reply True  for     a ~ [a]---               but False for   [a] ~ a--- and---                   True for  Int ~ F a Int---               but False for  Maybe Int ~ F a Int Int---               (where F is an arity-1 type function)-insolubleEqCt (CIrredCan { cc_insol = insol }) = insol-insolubleEqCt _                                = False--instance Outputable WantedConstraints where-  ppr (WC {wc_simple = s, wc_impl = i})-   = text "WC" <+> braces (vcat-        [ ppr_bag (text "wc_simple") s-        , ppr_bag (text "wc_impl") i ])--ppr_bag :: Outputable a => SDoc -> Bag a -> SDoc-ppr_bag doc bag- | isEmptyBag bag = empty- | otherwise      = hang (doc <+> equals)-                       2 (foldr (($$) . ppr) empty bag)--{- Note [Given insolubles]-~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider (#14325, comment:)-    class (a~b) => C a b--    foo :: C a c => a -> c-    foo x = x--    hm3 :: C (f b) b => b -> f b-    hm3 x = foo x--In the RHS of hm3, from the [G] C (f b) b we get the insoluble-[G] f b ~# b.  Then we also get an unsolved [W] C b (f b).-Residual implication looks like-    forall b. C (f b) b => [G] f b ~# b-                           [W] C f (f b)--We do /not/ want to set the implication status to IC_Insoluble,-because that'll suppress reports of [W] C b (f b).  But we-may not report the insoluble [G] f b ~# b either (see Note [Given errors]-in TcErrors), so we may fail to report anything at all!  Yikes.--The same applies to Derived constraints that /arise from/ Givens.-E.g.   f :: (C Int [a]) => blah-where a fundep means we get-       [D] Int ~ [a]-By the same reasoning we must not suppress other errors (#15767)--Bottom line: insolubleWC (called in TcSimplify.setImplicationStatus)-             should ignore givens even if they are insoluble.--Note [Insoluble holes]-~~~~~~~~~~~~~~~~~~~~~~-Hole constraints that ARE NOT treated as truly insoluble:-  a) type holes, arising from PartialTypeSignatures,-  b) "true" expression holes arising from TypedHoles--An "expression hole" or "type hole" constraint isn't really an error-at all; it's a report saying "_ :: Int" here.  But an out-of-scope-variable masquerading as expression holes IS treated as truly-insoluble, so that it trumps other errors during error reporting.-Yuk!--************************************************************************-*                                                                      *-                Implication constraints-*                                                                      *-************************************************************************--}--data Implication-  = Implic {   -- Invariants for a tree of implications:-               -- see TcType Note [TcLevel and untouchable type variables]--      ic_tclvl :: TcLevel,       -- TcLevel of unification variables-                                 -- allocated /inside/ this implication--      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-                                   -- See Note [Checking telescopes]--      ic_given  :: [EvVar],      -- Given evidence variables-                                 --   (order does not matter)-                                 -- See Invariant (GivenInv) in TcType--      ic_no_eqs :: Bool,         -- True  <=> ic_givens have no equalities, for sure-                                 -- False <=> ic_givens might have equalities--      ic_env   :: Env TcGblEnv TcLclEnv,-                                 -- Records the Env at the time of creation.-                                 ---                                 -- This is primarly needed for the enclosed-                                 -- TcLclEnv, which gives the source location-                                 -- and error context for the implication, and-                                 -- hence for all the given evidence variables.-                                 ---                                 -- The enclosed DynFlags also influences error-                                 -- reporting. See Note [Avoid-                                 -- -Winaccessible-code when deriving] in-                                 -- TcInstDcls.--      ic_wanted :: WantedConstraints,  -- The wanteds-                                       -- See Invariang (WantedInf) in TcType--      ic_binds  :: EvBindsVar,    -- Points to the place to fill in the-                                  -- abstraction and bindings.--      -- The ic_need fields keep track of which Given evidence-      -- is used by this implication or its children-      -- NB: including stuff used by nested implications that have since-      --     been discarded-      ic_need_inner :: VarSet,    -- Includes all used Given evidence-      ic_need_outer :: VarSet,    -- Includes only the free Given evidence-                                  --  i.e. ic_need_inner after deleting-                                  --       (a) givens (b) binders of ic_binds--      ic_status   :: ImplicStatus-    }---- | Create a new 'Implication' with as many sensible defaults for its fields--- as possible. Note that the 'ic_tclvl', 'ic_binds', and 'ic_info' fields do--- /not/ have sensible defaults, so they are initialized with lazy thunks that--- will 'panic' if forced, so one should take care to initialize these fields--- after creation.------ This is monadic purely to look up the 'Env', which is used to initialize--- 'ic_env'.-newImplication :: TcM Implication-newImplication-  = do env <- getEnv-       return (implicationPrototype { ic_env = env })--implicationPrototype :: Implication-implicationPrototype-   = Implic { -- These fields must be initialised-              ic_tclvl      = panic "newImplic:tclvl"-            , ic_binds      = panic "newImplic:binds"-            , ic_info       = panic "newImplic:info"-            , ic_env        = panic "newImplic:env"--              -- The rest have sensible default values-            , ic_skols      = []-            , ic_telescope  = Nothing-            , ic_given      = []-            , ic_wanted     = emptyWC-            , ic_no_eqs     = False-            , ic_status     = IC_Unsolved-            , ic_need_inner = emptyVarSet-            , ic_need_outer = emptyVarSet }---- | Retrieve the enclosed 'TcLclEnv' from an 'Implication'.-implicLclEnv :: Implication -> TcLclEnv-implicLclEnv = env_lcl . ic_env---- | Retrieve the enclosed 'DynFlags' from an 'Implication'.-implicDynFlags :: Implication -> DynFlags-implicDynFlags = hsc_dflags . env_top . ic_env--data ImplicStatus-  = IC_Solved     -- All wanteds in the tree are solved, all the way down-       { ics_dead :: [EvVar] }  -- Subset of ic_given that are not needed-         -- See Note [Tracking redundant constraints] in TcSimplify--  | IC_Insoluble  -- At least one insoluble constraint in the tree--  | IC_BadTelescope  -- solved, but the skolems in the telescope are out of-                     -- dependency order--  | IC_Unsolved   -- Neither of the above; might go either way--instance Outputable Implication where-  ppr (Implic { ic_tclvl = tclvl, ic_skols = skols-              , ic_given = given, ic_no_eqs = no_eqs-              , ic_wanted = wanted, ic_status = status-              , ic_binds = binds-              , ic_need_inner = need_in, ic_need_outer = need_out-              , ic_info = info })-   = hang (text "Implic" <+> lbrace)-        2 (sep [ text "TcLevel =" <+> ppr tclvl-               , text "Skolems =" <+> pprTyVars skols-               , text "No-eqs =" <+> ppr no_eqs-               , text "Status =" <+> ppr status-               , hang (text "Given =")  2 (pprEvVars given)-               , hang (text "Wanted =") 2 (ppr wanted)-               , text "Binds =" <+> ppr binds-               , whenPprDebug (text "Needed inner =" <+> ppr need_in)-               , whenPprDebug (text "Needed outer =" <+> ppr need_out)-               , pprSkolInfo info ] <+> rbrace)--instance Outputable ImplicStatus where-  ppr IC_Insoluble    = text "Insoluble"-  ppr IC_BadTelescope = text "Bad telescope"-  ppr IC_Unsolved     = text "Unsolved"-  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-ic_binds in nested implications.--  * Main purpose: if one of the ic_givens is not mentioned in here, it-    is redundant.--  * solveImplication may drop an implication altogether if it has no-    remaining 'wanteds'. But we still track the free vars of its-    evidence binds, even though it has now disappeared.--Note [Shadowing in a constraint]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We assume NO SHADOWING in a constraint.  Specifically- * The unification variables are all implicitly quantified at top-   level, and are all unique- * The skolem variables bound in ic_skols are all freah when the-   implication is created.-So we can safely substitute. For example, if we have-   forall a.  a~Int => ...(forall b. ...a...)...-we can push the (a~Int) constraint inwards in the "givens" without-worrying that 'b' might clash.--Note [Skolems in an implication]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-The skolems in an implication are not there to perform a skolem escape-check.  That happens because all the environment variables are in the-untouchables, and therefore cannot be unified with anything at all,-let alone the skolems.--Instead, ic_skols is used only when considering floating a constraint-outside the implication in TcSimplify.floatEqualities or-TcSimplify.approximateImplications--Note [Insoluble constraints]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Some of the errors that we get during canonicalization are best-reported when all constraints have been simplified as much as-possible. For instance, assume that during simplification the-following constraints arise:-- [Wanted]   F alpha ~  uf1- [Wanted]   beta ~ uf1 beta--When canonicalizing the wanted (beta ~ uf1 beta), if we eagerly fail-we will simply see a message:-    'Can't construct the infinite type  beta ~ uf1 beta'-and the user has no idea what the uf1 variable is.--Instead our plan is that we will NOT fail immediately, but:-    (1) Record the "frozen" error in the ic_insols field-    (2) Isolate the offending constraint from the rest of the inerts-    (3) Keep on simplifying/canonicalizing--At the end, we will hopefully have substituted uf1 := F alpha, and we-will be able to report a more informative error:-    'Can't construct the infinite type beta ~ F alpha beta'--Insoluble constraints *do* include Derived constraints. For example,-a functional dependency might give rise to [D] Int ~ Bool, and we must-report that.  If insolubles did not contain Deriveds, reportErrors would-never see it.---************************************************************************-*                                                                      *-            Pretty printing-*                                                                      *-************************************************************************--}--pprEvVars :: [EvVar] -> SDoc    -- Print with their types-pprEvVars ev_vars = vcat (map pprEvVarWithType ev_vars)--pprEvVarTheta :: [EvVar] -> SDoc-pprEvVarTheta ev_vars = pprTheta (map evVarPred ev_vars)--pprEvVarWithType :: EvVar -> SDoc-pprEvVarWithType v = ppr v <+> dcolon <+> pprType (evVarPred v)------ | Wraps the given type with the constraints (via ic_given) in the given--- implication, according to the variables mentioned (via ic_skols)--- in the implication, but taking care to only wrap those variables--- that are mentioned in the type or the implication.-wrapTypeWithImplication :: Type -> Implication -> Type-wrapTypeWithImplication ty impl = wrapType ty mentioned_skols givens-    where givens = map idType $ ic_given impl-          skols = ic_skols impl-          freeVars = fvVarSet $ tyCoFVsOfTypes (ty:givens)-          mentioned_skols = filter (`elemVarSet` freeVars) skols--wrapType :: Type -> [TyVar] -> [PredType] -> Type-wrapType ty skols givens = mkSpecForAllTys skols $ mkPhiTy givens ty---{--************************************************************************-*                                                                      *-            CtEvidence-*                                                                      *-************************************************************************--Note [Evidence field of CtEvidence]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-During constraint solving we never look at the type of ctev_evar/ctev_dest;-instead we look at the ctev_pred field.  The evtm/evar field-may be un-zonked.--Note [Bind new Givens immediately]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-For Givens we make new EvVars and bind them immediately. Two main reasons:-  * Gain sharing.  E.g. suppose we start with g :: C a b, where-       class D a => C a b-       class (E a, F a) => D a-    If we generate all g's superclasses as separate EvTerms we might-    get    selD1 (selC1 g) :: E a-           selD2 (selC1 g) :: F a-           selC1 g :: D a-    which we could do more economically as:-           g1 :: D a = selC1 g-           g2 :: E a = selD1 g1-           g3 :: F a = selD2 g1--  * For *coercion* evidence we *must* bind each given:-      class (a~b) => C a b where ....-      f :: C a b => ....-    Then in f's Givens we have g:(C a b) and the superclass sc(g,0):a~b.-    But that superclass selector can't (yet) appear in a coercion-    (see evTermCoercion), so the easy thing is to bind it to an Id.--So a Given has EvVar inside it rather than (as previously) an EvTerm.---}---- | A place for type-checking evidence to go after it is generated.--- Wanted equalities are always HoleDest; other wanteds are always--- EvVarDest.-data TcEvDest-  = EvVarDest EvVar         -- ^ bind this var to the evidence-              -- EvVarDest is always used for non-type-equalities-              -- e.g. class constraints--  | HoleDest  CoercionHole  -- ^ fill in this hole with the evidence-              -- HoleDest is always used for type-equalities-              -- See Note [Coercion holes] in TyCoRep--data CtEvidence-  = CtGiven    -- Truly given, not depending on subgoals-      { ctev_pred :: TcPredType      -- See Note [Ct/evidence invariant]-      , ctev_evar :: EvVar           -- See Note [Evidence field of CtEvidence]-      , ctev_loc  :: CtLoc }---  | CtWanted   -- Wanted goal-      { ctev_pred :: TcPredType     -- See Note [Ct/evidence invariant]-      , ctev_dest :: TcEvDest-      , ctev_nosh :: ShadowInfo     -- See Note [Constraint flavours]-      , ctev_loc  :: CtLoc }--  | CtDerived  -- A goal that we don't really have to solve and can't-               -- immediately rewrite anything other than a derived-               -- (there's no evidence!) but if we do manage to solve-               -- it may help in solving other goals.-      { ctev_pred :: TcPredType-      , ctev_loc  :: CtLoc }--ctEvPred :: CtEvidence -> TcPredType--- The predicate of a flavor-ctEvPred = ctev_pred--ctEvLoc :: CtEvidence -> CtLoc-ctEvLoc = ctev_loc--ctEvOrigin :: CtEvidence -> CtOrigin-ctEvOrigin = ctLocOrigin . ctEvLoc---- | Get the equality relation relevant for a 'CtEvidence'-ctEvEqRel :: CtEvidence -> EqRel-ctEvEqRel = predTypeEqRel . ctEvPred---- | Get the role relevant for a 'CtEvidence'-ctEvRole :: CtEvidence -> Role-ctEvRole = eqRelRole . ctEvEqRel--ctEvTerm :: CtEvidence -> EvTerm-ctEvTerm ev = EvExpr (ctEvExpr ev)--ctEvExpr :: CtEvidence -> EvExpr-ctEvExpr ev@(CtWanted { ctev_dest = HoleDest _ })-            = Coercion $ ctEvCoercion ev-ctEvExpr ev = evId (ctEvEvId ev)--ctEvCoercion :: HasDebugCallStack => CtEvidence -> Coercion-ctEvCoercion (CtGiven { ctev_evar = ev_id })-  = mkTcCoVarCo ev_id-ctEvCoercion (CtWanted { ctev_dest = dest })-  | HoleDest hole <- dest-  = -- ctEvCoercion is only called on type equalities-    -- and they always have HoleDests-    mkHoleCo hole-ctEvCoercion ev-  = pprPanic "ctEvCoercion" (ppr ev)--ctEvEvId :: CtEvidence -> EvVar-ctEvEvId (CtWanted { ctev_dest = EvVarDest ev }) = ev-ctEvEvId (CtWanted { ctev_dest = HoleDest h })   = coHoleCoVar h-ctEvEvId (CtGiven  { ctev_evar = ev })           = ev-ctEvEvId ctev@(CtDerived {}) = pprPanic "ctEvId:" (ppr ctev)--instance Outputable TcEvDest where-  ppr (HoleDest h)   = text "hole" <> ppr h-  ppr (EvVarDest ev) = ppr ev--instance Outputable CtEvidence where-  ppr ev = ppr (ctEvFlavour ev)-           <+> pp_ev-           <+> braces (ppr (ctl_depth (ctEvLoc ev))) <> dcolon-                  -- Show the sub-goal depth too-           <+> ppr (ctEvPred ev)-    where-      pp_ev = case ev of-             CtGiven { ctev_evar = v } -> ppr v-             CtWanted {ctev_dest = d } -> ppr d-             CtDerived {}              -> text "_"--isWanted :: CtEvidence -> Bool-isWanted (CtWanted {}) = True-isWanted _ = False--isGiven :: CtEvidence -> Bool-isGiven (CtGiven {})  = True-isGiven _ = False--isDerived :: CtEvidence -> Bool-isDerived (CtDerived {}) = True-isDerived _              = False--{--%************************************************************************-%*                                                                      *-            CtFlavour-%*                                                                      *-%************************************************************************--Note [Constraint flavours]-~~~~~~~~~~~~~~~~~~~~~~~~~~-Constraints come in four flavours:--* [G] Given: we have evidence--* [W] Wanted WOnly: we want evidence--* [D] Derived: any solution must satisfy this constraint, but-      we don't need evidence for it.  Examples include:-        - superclasses of [W] class constraints-        - equalities arising from functional dependencies-          or injectivity--* [WD] Wanted WDeriv: a single constraint that represents-                      both [W] and [D]-  We keep them paired as one both for efficiency, and because-  when we have a finite map  F tys -> CFunEqCan, it's inconvenient-  to have two CFunEqCans in the range--The ctev_nosh field of a Wanted distinguishes between [W] and [WD]--Wanted constraints are born as [WD], but are split into [W] and its-"shadow" [D] in TcSMonad.maybeEmitShadow.--See Note [The improvement story and derived shadows] in TcSMonad--}--data CtFlavour  -- See Note [Constraint flavours]-  = Given-  | Wanted ShadowInfo-  | Derived-  deriving Eq--data ShadowInfo-  = WDeriv   -- [WD] This Wanted constraint has no Derived shadow,-             -- so it behaves like a pair of a Wanted and a Derived-  | WOnly    -- [W] It has a separate derived shadow-             -- See Note [Derived shadows]-  deriving( Eq )--isGivenOrWDeriv :: CtFlavour -> Bool-isGivenOrWDeriv Given           = True-isGivenOrWDeriv (Wanted WDeriv) = True-isGivenOrWDeriv _               = False--instance Outputable CtFlavour where-  ppr Given           = text "[G]"-  ppr (Wanted WDeriv) = text "[WD]"-  ppr (Wanted WOnly)  = text "[W]"-  ppr Derived         = text "[D]"--ctEvFlavour :: CtEvidence -> CtFlavour-ctEvFlavour (CtWanted { ctev_nosh = nosh }) = Wanted nosh-ctEvFlavour (CtGiven {})                    = Given-ctEvFlavour (CtDerived {})                  = Derived---- | Whether or not one 'Ct' can rewrite another is determined by its--- flavour and its equality relation. See also--- Note [Flavours with roles] in TcSMonad-type CtFlavourRole = (CtFlavour, EqRel)---- | Extract the flavour, role, and boxity from a 'CtEvidence'-ctEvFlavourRole :: CtEvidence -> CtFlavourRole-ctEvFlavourRole ev = (ctEvFlavour ev, ctEvEqRel ev)---- | Extract the flavour and role from a 'Ct'-ctFlavourRole :: Ct -> CtFlavourRole--- Uses short-cuts to role for special cases-ctFlavourRole (CDictCan { cc_ev = ev })-  = (ctEvFlavour ev, NomEq)-ctFlavourRole (CTyEqCan { cc_ev = ev, cc_eq_rel = eq_rel })-  = (ctEvFlavour ev, eq_rel)-ctFlavourRole (CFunEqCan { cc_ev = ev })-  = (ctEvFlavour ev, NomEq)-ctFlavourRole (CHoleCan { cc_ev = ev })-  = (ctEvFlavour ev, NomEq)  -- NomEq: CHoleCans can be rewritten by-                             -- by nominal equalities but empahatically-                             -- not by representational equalities-ctFlavourRole ct-  = ctEvFlavourRole (ctEvidence ct)--{- Note [eqCanRewrite]-~~~~~~~~~~~~~~~~~~~~~~-(eqCanRewrite ct1 ct2) holds if the constraint ct1 (a CTyEqCan of form-tv ~ ty) can be used to rewrite ct2.  It must satisfy the properties of-a can-rewrite relation, see Definition [Can-rewrite relation] in-TcSMonad.--With the solver handling Coercible constraints like equality constraints,-the rewrite conditions must take role into account, never allowing-a representational equality to rewrite a nominal one.--Note [Wanteds do not rewrite Wanteds]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We don't allow Wanteds to rewrite Wanteds, because that can give rise-to very confusing type error messages.  A good example is #8450.-Here's another-   f :: a -> Bool-   f x = ( [x,'c'], [x,True] ) `seq` True-Here we get-  [W] a ~ Char-  [W] a ~ Bool-but we do not want to complain about Bool ~ Char!--Note [Deriveds do rewrite Deriveds]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-However we DO allow Deriveds to rewrite Deriveds, because that's how-improvement works; see Note [The improvement story] in TcInteract.--However, for now at least I'm only letting (Derived,NomEq) rewrite-(Derived,NomEq) and not doing anything for ReprEq.  If we have-    eqCanRewriteFR (Derived, NomEq) (Derived, _)  = True-then we lose property R2 of Definition [Can-rewrite relation]-in TcSMonad-  R2.  If f1 >= f, and f2 >= f,-       then either f1 >= f2 or f2 >= f1-Consider f1 = (Given, ReprEq)-         f2 = (Derived, NomEq)-          f = (Derived, ReprEq)--I thought maybe we could never get Derived ReprEq constraints, but-we can; straight from the Wanteds during improvement. And from a Derived-ReprEq we could conceivably get a Derived NomEq improvement (by decomposing-a type constructor with Nomninal role), and hence unify.--}--eqCanRewrite :: EqRel -> EqRel -> Bool-eqCanRewrite NomEq  _      = True-eqCanRewrite ReprEq ReprEq = True-eqCanRewrite ReprEq NomEq  = False--eqCanRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool--- Can fr1 actually rewrite fr2?--- Very important function!--- See Note [eqCanRewrite]--- See Note [Wanteds do not rewrite Wanteds]--- See Note [Deriveds do rewrite Deriveds]-eqCanRewriteFR (Given,         r1)    (_,       r2)    = eqCanRewrite r1 r2-eqCanRewriteFR (Wanted WDeriv, NomEq) (Derived, NomEq) = True-eqCanRewriteFR (Derived,       NomEq) (Derived, NomEq) = True-eqCanRewriteFR _                      _                = False--eqMayRewriteFR :: CtFlavourRole -> CtFlavourRole -> Bool--- Is it /possible/ that fr1 can rewrite fr2?--- This is used when deciding which inerts to kick out,--- at which time a [WD] inert may be split into [W] and [D]-eqMayRewriteFR (Wanted WDeriv, NomEq) (Wanted WDeriv, NomEq) = True-eqMayRewriteFR (Derived,       NomEq) (Wanted WDeriv, NomEq) = True-eqMayRewriteFR fr1 fr2 = eqCanRewriteFR fr1 fr2--------------------{- Note [funEqCanDischarge]-~~~~~~~~~~~~~~~~~~~~~~~~~~~-Suppose we have two CFunEqCans with the same LHS:-    (x1:F ts ~ f1) `funEqCanDischarge` (x2:F ts ~ f2)-Can we drop x2 in favour of x1, either unifying-f2 (if it's a flatten meta-var) or adding a new Given-(f1 ~ f2), if x2 is a Given?--Answer: yes if funEqCanDischarge is true.--}--funEqCanDischarge-  :: CtEvidence -> CtEvidence-  -> ( SwapFlag   -- NotSwapped => lhs can discharge rhs-                  -- Swapped    => rhs can discharge lhs-     , Bool)      -- True <=> upgrade non-discharded one-                  --          from [W] to [WD]--- See Note [funEqCanDischarge]-funEqCanDischarge ev1 ev2-  = ASSERT2( ctEvEqRel ev1 == NomEq, ppr ev1 )-    ASSERT2( ctEvEqRel ev2 == NomEq, ppr ev2 )-    -- CFunEqCans are all Nominal, hence asserts-    funEqCanDischargeF (ctEvFlavour ev1) (ctEvFlavour ev2)--funEqCanDischargeF :: CtFlavour -> CtFlavour -> (SwapFlag, Bool)-funEqCanDischargeF Given           _               = (NotSwapped, False)-funEqCanDischargeF _               Given           = (IsSwapped,  False)-funEqCanDischargeF (Wanted WDeriv) _               = (NotSwapped, False)-funEqCanDischargeF _               (Wanted WDeriv) = (IsSwapped,  True)-funEqCanDischargeF (Wanted WOnly)  (Wanted WOnly)  = (NotSwapped, False)-funEqCanDischargeF (Wanted WOnly)  Derived         = (NotSwapped, True)-funEqCanDischargeF Derived         (Wanted WOnly)  = (IsSwapped,  True)-funEqCanDischargeF Derived         Derived         = (NotSwapped, False)---{- Note [eqCanDischarge]-~~~~~~~~~~~~~~~~~~~~~~~~-Suppose we have two identical CTyEqCan equality constraints-(i.e. both LHS and RHS are the same)-      (x1:a~t) `eqCanDischarge` (xs:a~t)-Can we just drop x2 in favour of x1?--Answer: yes if eqCanDischarge is true.--Note that we do /not/ allow Wanted to discharge Derived.-We must keep both.  Why?  Because the Derived may rewrite-other Deriveds in the model whereas the Wanted cannot.--However a Wanted can certainly discharge an identical Wanted.  So-eqCanDischarge does /not/ define a can-rewrite relation in the-sense of Definition [Can-rewrite relation] in TcSMonad.--We /do/ say that a [W] can discharge a [WD].  In evidence terms it-certainly can, and the /caller/ arranges that the otherwise-lost [D]-is spat out as a new Derived.  -}--eqCanDischargeFR :: CtFlavourRole -> CtFlavourRole -> Bool--- See Note [eqCanDischarge]-eqCanDischargeFR (f1,r1) (f2, r2) =  eqCanRewrite r1 r2-                                  && eqCanDischargeF f1 f2--eqCanDischargeF :: CtFlavour -> CtFlavour -> Bool-eqCanDischargeF Given   _                  = True-eqCanDischargeF (Wanted _)      (Wanted _) = True-eqCanDischargeF (Wanted WDeriv) Derived    = True-eqCanDischargeF Derived         Derived    = True-eqCanDischargeF _               _          = False---{--************************************************************************-*                                                                      *-            SubGoalDepth-*                                                                      *-************************************************************************--Note [SubGoalDepth]-~~~~~~~~~~~~~~~~~~~-The 'SubGoalDepth' takes care of stopping the constraint solver from looping.--The counter starts at zero and increases. It includes dictionary constraints,-equality simplification, and type family reduction. (Why combine these? Because-it's actually quite easy to mistake one for another, in sufficiently involved-scenarios, like ConstraintKinds.)--The flag -fcontext-stack=n (not very well named!) fixes the maximium-level.--* The counter includes the depth of type class instance declarations.  Example:-     [W] d{7} : Eq [Int]-  That is d's dictionary-constraint depth is 7.  If we use the instance-     $dfEqList :: Eq a => Eq [a]-  to simplify it, we get-     d{7} = $dfEqList d'{8}-  where d'{8} : Eq Int, and d' has depth 8.--  For civilised (decidable) instance declarations, each increase of-  depth removes a type constructor from the type, so the depth never-  gets big; i.e. is bounded by the structural depth of the type.--* The counter also increments when resolving-equalities involving type functions. Example:-  Assume we have a wanted at depth 7:-    [W] d{7} : F () ~ a-  If there is a type function equation "F () = Int", this would be rewritten to-    [W] d{8} : Int ~ a-  and remembered as having depth 8.--  Again, without UndecidableInstances, this counter is bounded, but without it-  can resolve things ad infinitum. Hence there is a maximum level.--* Lastly, every time an equality is rewritten, the counter increases. Again,-  rewriting an equality constraint normally makes progress, but it's possible-  the "progress" is just the reduction of an infinitely-reducing type family.-  Hence we need to track the rewrites.--When compiling a program requires a greater depth, then GHC recommends turning-off this check entirely by setting -freduction-depth=0. This is because the-exact number that works is highly variable, and is likely to change even between-minor releases. Because this check is solely to prevent infinite compilation-times, it seems safe to disable it when a user has ascertained that their program-doesn't loop at the type level.---}---- | See Note [SubGoalDepth]-newtype SubGoalDepth = SubGoalDepth Int-  deriving (Eq, Ord, Outputable)--initialSubGoalDepth :: SubGoalDepth-initialSubGoalDepth = SubGoalDepth 0--bumpSubGoalDepth :: SubGoalDepth -> SubGoalDepth-bumpSubGoalDepth (SubGoalDepth n) = SubGoalDepth (n + 1)--maxSubGoalDepth :: SubGoalDepth -> SubGoalDepth -> SubGoalDepth-maxSubGoalDepth (SubGoalDepth n) (SubGoalDepth m) = SubGoalDepth (n `max` m)--subGoalDepthExceeded :: DynFlags -> SubGoalDepth -> Bool-subGoalDepthExceeded dflags (SubGoalDepth d)-  = mkIntWithInf d > reductionDepth dflags--{--************************************************************************-*                                                                      *-            CtLoc-*                                                                      *-************************************************************************--The 'CtLoc' gives information about where a constraint came from.-This is important for decent error message reporting because-dictionaries don't appear in the original source code.-type will evolve...---}--data CtLoc = CtLoc { ctl_origin :: CtOrigin-                   , ctl_env    :: TcLclEnv-                   , ctl_t_or_k :: Maybe TypeOrKind  -- OK if we're not sure-                   , ctl_depth  :: !SubGoalDepth }--  -- The TcLclEnv includes particularly-  --    source location:  tcl_loc   :: RealSrcSpan-  --    context:          tcl_ctxt  :: [ErrCtxt]-  --    binder stack:     tcl_bndrs :: TcBinderStack-  --    level:            tcl_tclvl :: TcLevel--mkKindLoc :: TcType -> TcType   -- original *types* being compared-          -> CtLoc -> CtLoc-mkKindLoc s1 s2 loc = setCtLocOrigin (toKindLoc loc)-                        (KindEqOrigin s1 (Just s2) (ctLocOrigin loc)-                                      (ctLocTypeOrKind_maybe loc))---- | Take a CtLoc and moves it to the kind level-toKindLoc :: CtLoc -> CtLoc-toKindLoc loc = loc { ctl_t_or_k = Just KindLevel }--mkGivenLoc :: TcLevel -> SkolemInfo -> TcLclEnv -> CtLoc-mkGivenLoc tclvl skol_info env-  = CtLoc { ctl_origin = GivenOrigin skol_info-          , ctl_env    = env { tcl_tclvl = tclvl }-          , ctl_t_or_k = Nothing    -- this only matters for error msgs-          , ctl_depth  = initialSubGoalDepth }--ctLocEnv :: CtLoc -> TcLclEnv-ctLocEnv = ctl_env--ctLocLevel :: CtLoc -> TcLevel-ctLocLevel loc = tcl_tclvl (ctLocEnv loc)--ctLocDepth :: CtLoc -> SubGoalDepth-ctLocDepth = ctl_depth--ctLocOrigin :: CtLoc -> CtOrigin-ctLocOrigin = ctl_origin--ctLocSpan :: CtLoc -> RealSrcSpan-ctLocSpan (CtLoc { ctl_env = lcl}) = tcl_loc lcl--ctLocTypeOrKind_maybe :: CtLoc -> Maybe TypeOrKind-ctLocTypeOrKind_maybe = ctl_t_or_k--setCtLocSpan :: CtLoc -> RealSrcSpan -> CtLoc-setCtLocSpan ctl@(CtLoc { ctl_env = lcl }) loc = setCtLocEnv ctl (lcl { tcl_loc = loc })--bumpCtLocDepth :: CtLoc -> CtLoc-bumpCtLocDepth loc@(CtLoc { ctl_depth = d }) = loc { ctl_depth = bumpSubGoalDepth d }--setCtLocOrigin :: CtLoc -> CtOrigin -> CtLoc-setCtLocOrigin ctl orig = ctl { ctl_origin = orig }--updateCtLocOrigin :: CtLoc -> (CtOrigin -> CtOrigin) -> CtLoc-updateCtLocOrigin ctl@(CtLoc { ctl_origin = orig }) upd-  = ctl { ctl_origin = upd orig }--setCtLocEnv :: CtLoc -> TcLclEnv -> CtLoc-setCtLocEnv ctl env = ctl { ctl_env = env }--pushErrCtxt :: CtOrigin -> ErrCtxt -> CtLoc -> CtLoc-pushErrCtxt o err loc@(CtLoc { ctl_env = lcl })-  = loc { ctl_origin = o, ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }--pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc -> CtLoc--- Just add information w/o updating the origin!-pushErrCtxtSameOrigin err loc@(CtLoc { ctl_env = lcl })-  = loc { ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }--{--************************************************************************-*                                                                      *-                SkolemInfo-*                                                                      *-************************************************************************--}---- SkolemInfo gives the origin of *given* constraints---   a) type variables are skolemised---   b) an implication constraint is generated-data SkolemInfo-  = SigSkol -- A skolem that is created by instantiating-            -- a programmer-supplied type signature-            -- Location of the binding site is on the TyVar-            -- See Note [SigSkol SkolemInfo]-       UserTypeCtxt        -- What sort of signature-       TcType              -- Original type signature (before skolemisation)-       [(Name,TcTyVar)]    -- Maps the original name of the skolemised tyvar-                           -- to its instantiated version--  | SigTypeSkol UserTypeCtxt-                 -- like SigSkol, but when we're kind-checking the *type*-                 -- hence, we have less info--  | ForAllSkol SDoc     -- Bound by a user-written "forall".--  | DerivSkol Type      -- Bound by a 'deriving' clause;-                        -- the type is the instance we are trying to derive--  | InstSkol            -- Bound at an instance decl-  | InstSC TypeSize     -- A "given" constraint obtained by superclass selection.-                        -- If (C ty1 .. tyn) is the largest class from-                        --    which we made a superclass selection in the chain,-                        --    then TypeSize = sizeTypes [ty1, .., tyn]-                        -- See Note [Solving superclass constraints] in TcInstDcls--  | FamInstSkol         -- Bound at a family instance decl-  | PatSkol             -- An existential type variable bound by a pattern for-      ConLike           -- a data constructor with an existential type.-      (HsMatchContext Name)-             -- e.g.   data T = forall a. Eq a => MkT a-             --        f (MkT x) = ...-             -- The pattern MkT x will allocate an existential type-             -- variable for 'a'.--  | ArrowSkol           -- An arrow form (see TcArrows)--  | IPSkol [HsIPName]   -- Binding site of an implicit parameter--  | RuleSkol RuleName   -- The LHS of a RULE--  | InferSkol [(Name,TcType)]-                        -- We have inferred a type for these (mutually-recursivive)-                        -- polymorphic Ids, and are now checking that their RHS-                        -- constraints are satisfied.--  | BracketSkol         -- Template Haskell bracket--  | UnifyForAllSkol     -- We are unifying two for-all types-       TcType           -- The instantiated type *inside* the forall--  | TyConSkol TyConFlavour Name  -- bound in a type declaration of the given flavour--  | DataConSkol Name    -- bound as an existential in a Haskell98 datacon decl or-                        -- as any variable in a GADT datacon decl--  | ReifySkol           -- Bound during Template Haskell reification--  | QuantCtxtSkol       -- Quantified context, e.g.-                        --   f :: forall c. (forall a. c a => c [a]) => blah--  | UnkSkol             -- Unhelpful info (until I improve it)--instance Outputable SkolemInfo where-  ppr = pprSkolInfo--pprSkolInfo :: SkolemInfo -> SDoc--- Complete the sentence "is a rigid type variable bound by..."-pprSkolInfo (SigSkol cx ty _) = pprSigSkolInfo cx ty-pprSkolInfo (SigTypeSkol cx)  = pprUserTypeCtxt cx-pprSkolInfo (ForAllSkol doc)  = quotes doc-pprSkolInfo (IPSkol ips)      = text "the implicit-parameter binding" <> plural ips <+> text "for"-                                 <+> pprWithCommas ppr ips-pprSkolInfo (DerivSkol pred)  = text "the deriving clause for" <+> quotes (ppr pred)-pprSkolInfo InstSkol          = text "the instance declaration"-pprSkolInfo (InstSC n)        = text "the instance declaration" <> whenPprDebug (parens (ppr n))-pprSkolInfo FamInstSkol       = text "a family instance declaration"-pprSkolInfo BracketSkol       = text "a Template Haskell bracket"-pprSkolInfo (RuleSkol name)   = text "the RULE" <+> pprRuleName name-pprSkolInfo ArrowSkol         = text "an arrow form"-pprSkolInfo (PatSkol cl mc)   = sep [ pprPatSkolInfo cl-                                    , text "in" <+> pprMatchContext mc ]-pprSkolInfo (InferSkol ids)   = hang (text "the inferred type" <> plural ids <+> text "of")-                                   2 (vcat [ ppr name <+> dcolon <+> ppr ty-                                                   | (name,ty) <- ids ])-pprSkolInfo (UnifyForAllSkol ty) = text "the type" <+> ppr ty-pprSkolInfo (TyConSkol flav name) = text "the" <+> ppr flav <+> text "declaration for" <+> quotes (ppr name)-pprSkolInfo (DataConSkol name)= text "the data constructor" <+> quotes (ppr name)-pprSkolInfo ReifySkol         = text "the type being reified"--pprSkolInfo (QuantCtxtSkol {}) = text "a quantified context"---- UnkSkol--- For type variables the others are dealt with by pprSkolTvBinding.--- For Insts, these cases should not happen-pprSkolInfo UnkSkol = WARN( True, text "pprSkolInfo: UnkSkol" ) text "UnkSkol"--pprSigSkolInfo :: UserTypeCtxt -> TcType -> SDoc--- The type is already tidied-pprSigSkolInfo ctxt ty-  = case ctxt of-       FunSigCtxt f _ -> vcat [ text "the type signature for:"-                              , nest 2 (pprPrefixOcc f <+> dcolon <+> ppr ty) ]-       PatSynCtxt {}  -> pprUserTypeCtxt ctxt  -- See Note [Skolem info for pattern synonyms]-       _              -> vcat [ pprUserTypeCtxt ctxt <> colon-                              , nest 2 (ppr ty) ]--pprPatSkolInfo :: ConLike -> SDoc-pprPatSkolInfo (RealDataCon dc)-  = sep [ text "a pattern with constructor:"-        , nest 2 $ ppr dc <+> dcolon-          <+> pprType (dataConUserType dc) <> comma ]-          -- pprType prints forall's regardless of -fprint-explicit-foralls-          -- which is what we want here, since we might be saying-          -- type variable 't' is bound by ...--pprPatSkolInfo (PatSynCon ps)-  = sep [ text "a pattern with pattern synonym:"-        , nest 2 $ ppr ps <+> dcolon-                   <+> pprPatSynType ps <> comma ]--{- Note [Skolem info for pattern synonyms]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-For pattern synonym SkolemInfo we have-   SigSkol (PatSynCtxt p) ty _-but the type 'ty' is not very helpful.  The full pattern-synonym type-has the provided and required pieces, which it is inconvenient to-record and display here. So we simply don't display the type at all,-contenting outselves with just the name of the pattern synonym, which-is fine.  We could do more, but it doesn't seem worth it.--Note [SigSkol SkolemInfo]-~~~~~~~~~~~~~~~~~~~~~~~~~-Suppose we (deeply) skolemise a type-   f :: forall a. a -> forall b. b -> a-Then we'll instantiate [a :-> a', b :-> b'], and with the instantiated-      a' -> b' -> a.-But when, in an error message, we report that "b is a rigid type-variable bound by the type signature for f", we want to show the foralls-in the right place.  So we proceed as follows:--* In SigSkol we record-    - the original signature forall a. a -> forall b. b -> a-    - the instantiation mapping [a :-> a', b :-> b']--* Then when tidying in TcMType.tidySkolemInfo, we first tidy a' to-  whatever it tidies to, say a''; and then we walk over the type-  replacing the binder a by the tidied version a'', to give-       forall a''. a'' -> forall b''. b'' -> a''-  We need to do this under function arrows, to match what deeplySkolemise-  does.--* Typically a'' will have a nice pretty name like "a", but the point is-  that the foral-bound variables of the signature we report line up with-  the instantiated skolems lying  around in other types.---************************************************************************-*                                                                      *-            CtOrigin-*                                                                      *-************************************************************************--}--data CtOrigin-  = GivenOrigin SkolemInfo--  -- All the others are for *wanted* constraints-  | OccurrenceOf Name              -- Occurrence of an overloaded identifier-  | OccurrenceOfRecSel RdrName     -- Occurrence of a record selector-  | AppOrigin                      -- An application of some kind--  | SpecPragOrigin UserTypeCtxt    -- Specialisation pragma for-                                   -- function or instance--  | TypeEqOrigin { uo_actual   :: TcType-                 , uo_expected :: TcType-                 , uo_thing    :: Maybe SDoc-                       -- ^ The thing that has type "actual"-                 , uo_visible  :: Bool-                       -- ^ Is at least one of the three elements above visible?-                       -- (Errors from the polymorphic subsumption check are considered-                       -- visible.) Only used for prioritizing error messages.-                 }--  | KindEqOrigin  -- See Note [Equalities with incompatible kinds] in TcCanonical.-      TcType (Maybe TcType)     -- A kind equality arising from unifying these two types-      CtOrigin                  -- originally arising from this-      (Maybe TypeOrKind)        -- the level of the eq this arises from--  | IPOccOrigin  HsIPName       -- Occurrence of an implicit parameter-  | OverLabelOrigin FastString  -- Occurrence of an overloaded label--  | LiteralOrigin (HsOverLit GhcRn)     -- Occurrence of a literal-  | NegateOrigin                        -- Occurrence of syntactic negation--  | ArithSeqOrigin (ArithSeqInfo GhcRn) -- [x..], [x..y] etc-  | AssocFamPatOrigin   -- When matching the patterns of an associated-                        -- family instance with that of its parent class-  | SectionOrigin-  | TupleOrigin         -- (..,..)-  | ExprSigOrigin       -- e :: ty-  | PatSigOrigin        -- p :: ty-  | PatOrigin           -- Instantiating a polytyped pattern at a constructor-  | ProvCtxtOrigin      -- The "provided" context of a pattern synonym signature-        (PatSynBind GhcRn GhcRn) -- Information about the pattern synonym, in-                                 -- particular the name and the right-hand side-  | RecordUpdOrigin-  | ViewPatOrigin--  | ScOrigin TypeSize   -- Typechecking superclasses of an instance declaration-                        -- If the instance head is C ty1 .. tyn-                        --    then TypeSize = sizeTypes [ty1, .., tyn]-                        -- See Note [Solving superclass constraints] in TcInstDcls--  | DerivClauseOrigin   -- Typechecking a deriving clause (as opposed to-                        -- standalone deriving).-  | DerivOriginDC DataCon Int Bool-      -- Checking constraints arising from this data con and field index. The-      -- Bool argument in DerivOriginDC and DerivOriginCoerce is True if-      -- standalong deriving (with a wildcard constraint) is being used. This-      -- is used to inform error messages on how to recommended fixes (e.g., if-      -- the argument is True, then don't recommend "use standalone deriving",-      -- but rather "fill in the wildcard constraint yourself").-      -- See Note [Inferring the instance context] in TcDerivInfer-  | DerivOriginCoerce Id Type Type Bool-                        -- DerivOriginCoerce id ty1 ty2: Trying to coerce class method `id` from-                        -- `ty1` to `ty2`.-  | StandAloneDerivOrigin -- Typechecking stand-alone deriving. Useful for-                          -- constraints coming from a wildcard constraint,-                          -- e.g., deriving instance _ => Eq (Foo a)-                          -- See Note [Inferring the instance context]-                          -- in TcDerivInfer-  | DefaultOrigin       -- Typechecking a default decl-  | DoOrigin            -- Arising from a do expression-  | DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in-                             -- a do expression-  | MCompOrigin         -- Arising from a monad comprehension-  | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a-                                -- monad comprehension-  | IfOrigin            -- Arising from an if statement-  | ProcOrigin          -- Arising from a proc expression-  | AnnOrigin           -- An annotation--  | FunDepOrigin1       -- A functional dependency from combining-        PredType CtLoc      -- This constraint arising from ...-        PredType CtLoc      -- and this constraint arising from ...--  | FunDepOrigin2       -- A functional dependency from combining-        PredType CtOrigin   -- This constraint arising from ...-        PredType SrcSpan    -- and this top-level instance-        -- We only need a CtOrigin on the first, because the location-        -- is pinned on the entire error message--  | HoleOrigin-  | UnboundOccurrenceOf OccName-  | ListOrigin          -- An overloaded list-  | StaticOrigin        -- A static form-  | FailablePattern (LPat GhcTcId) -- A failable pattern in do-notation for the-                                   -- MonadFail Proposal (MFP). Obsolete when-                                   -- actual desugaring to MonadFail.fail is-                                   -- live.-  | Shouldn'tHappenOrigin String-                            -- the user should never see this one,-                            -- unless ImpredicativeTypes is on, where all-                            -- bets are off-  | InstProvidedOrigin Module ClsInst-        -- Skolem variable arose when we were testing if an instance-        -- is solvable or not.---- | Flag to see whether we're type-checking terms or kind-checking types-data TypeOrKind = TypeLevel | KindLevel-  deriving Eq--instance Outputable TypeOrKind where-  ppr TypeLevel = text "TypeLevel"-  ppr KindLevel = text "KindLevel"--isTypeLevel :: TypeOrKind -> Bool-isTypeLevel TypeLevel = True-isTypeLevel KindLevel = False--isKindLevel :: TypeOrKind -> Bool-isKindLevel TypeLevel = False-isKindLevel KindLevel = True---- An origin is visible if the place where the constraint arises is manifest--- in user code. Currently, all origins are visible except for invisible--- TypeEqOrigins. This is used when choosing which error of--- several to report-isVisibleOrigin :: CtOrigin -> Bool-isVisibleOrigin (TypeEqOrigin { uo_visible = vis }) = vis-isVisibleOrigin (KindEqOrigin _ _ sub_orig _)       = isVisibleOrigin sub_orig-isVisibleOrigin _                                   = True---- Converts a visible origin to an invisible one, if possible. Currently,--- this works only for TypeEqOrigin-toInvisibleOrigin :: CtOrigin -> CtOrigin-toInvisibleOrigin orig@(TypeEqOrigin {}) = orig { uo_visible = False }-toInvisibleOrigin orig                   = orig--instance Outputable CtOrigin where-  ppr = pprCtOrigin--ctoHerald :: SDoc-ctoHerald = text "arising from"---- | Extract a suitable CtOrigin from a HsExpr-lexprCtOrigin :: LHsExpr GhcRn -> CtOrigin-lexprCtOrigin (L _ e) = exprCtOrigin e--exprCtOrigin :: HsExpr GhcRn -> CtOrigin-exprCtOrigin (HsVar _ (L _ name)) = OccurrenceOf name-exprCtOrigin (HsUnboundVar _ uv)  = UnboundOccurrenceOf (unboundVarOcc uv)-exprCtOrigin (HsConLikeOut {})    = panic "exprCtOrigin HsConLikeOut"-exprCtOrigin (HsRecFld _ f)    = OccurrenceOfRecSel (rdrNameAmbiguousFieldOcc f)-exprCtOrigin (HsOverLabel _ _ l)  = OverLabelOrigin l-exprCtOrigin (HsIPVar _ ip)       = IPOccOrigin ip-exprCtOrigin (HsOverLit _ lit)    = LiteralOrigin lit-exprCtOrigin (HsLit {})           = Shouldn'tHappenOrigin "concrete literal"-exprCtOrigin (HsLam _ matches)    = matchesCtOrigin matches-exprCtOrigin (HsLamCase _ ms)     = matchesCtOrigin ms-exprCtOrigin (HsApp _ e1 _)       = lexprCtOrigin e1-exprCtOrigin (HsAppType _ e1 _)   = lexprCtOrigin e1-exprCtOrigin (OpApp _ _ op _)     = lexprCtOrigin op-exprCtOrigin (NegApp _ e _)       = lexprCtOrigin e-exprCtOrigin (HsPar _ e)          = lexprCtOrigin e-exprCtOrigin (SectionL _ _ _)     = SectionOrigin-exprCtOrigin (SectionR _ _ _)     = SectionOrigin-exprCtOrigin (ExplicitTuple {})   = Shouldn'tHappenOrigin "explicit tuple"-exprCtOrigin ExplicitSum{}        = Shouldn'tHappenOrigin "explicit sum"-exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches-exprCtOrigin (HsIf _ (Just syn) _ _ _) = exprCtOrigin (syn_expr syn)-exprCtOrigin (HsIf {})           = Shouldn'tHappenOrigin "if expression"-exprCtOrigin (HsMultiIf _ rhs)   = lGRHSCtOrigin rhs-exprCtOrigin (HsLet _ _ e)       = lexprCtOrigin e-exprCtOrigin (HsDo {})           = DoOrigin-exprCtOrigin (ExplicitList {})   = Shouldn'tHappenOrigin "list"-exprCtOrigin (RecordCon {})      = Shouldn'tHappenOrigin "record construction"-exprCtOrigin (RecordUpd {})      = Shouldn'tHappenOrigin "record update"-exprCtOrigin (ExprWithTySig {})  = ExprSigOrigin-exprCtOrigin (ArithSeq {})       = Shouldn'tHappenOrigin "arithmetic sequence"-exprCtOrigin (HsSCC _ _ _ e)     = lexprCtOrigin e-exprCtOrigin (HsCoreAnn _ _ _ e) = lexprCtOrigin e-exprCtOrigin (HsBracket {})      = Shouldn'tHappenOrigin "TH bracket"-exprCtOrigin (HsRnBracketOut {})= Shouldn'tHappenOrigin "HsRnBracketOut"-exprCtOrigin (HsTcBracketOut {})= panic "exprCtOrigin HsTcBracketOut"-exprCtOrigin (HsSpliceE {})      = Shouldn'tHappenOrigin "TH splice"-exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc"-exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"-exprCtOrigin (HsTick _ _ e)           = lexprCtOrigin e-exprCtOrigin (HsBinTick _ _ _ e)      = lexprCtOrigin e-exprCtOrigin (HsTickPragma _ _ _ _ e) = lexprCtOrigin e-exprCtOrigin (HsWrap {})        = panic "exprCtOrigin HsWrap"-exprCtOrigin (XExpr nec)        = noExtCon nec---- | Extract a suitable CtOrigin from a MatchGroup-matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin-matchesCtOrigin (MG { mg_alts = alts })-  | L _ [L _ match] <- alts-  , Match { m_grhss = grhss } <- match-  = grhssCtOrigin grhss--  | otherwise-  = Shouldn'tHappenOrigin "multi-way match"-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 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 nec)] = noExtCon nec-lGRHSCtOrigin _ = Shouldn'tHappenOrigin "multi-way GRHS"--pprCtLoc :: CtLoc -> SDoc--- "arising from ... at ..."--- Not an instance of Outputable because of the "arising from" prefix-pprCtLoc (CtLoc { ctl_origin = o, ctl_env = lcl})-  = sep [ pprCtOrigin o-        , text "at" <+> ppr (tcl_loc lcl)]--pprCtOrigin :: CtOrigin -> SDoc--- "arising from ..."--- Not an instance of Outputable because of the "arising from" prefix-pprCtOrigin (GivenOrigin sk) = ctoHerald <+> ppr sk--pprCtOrigin (SpecPragOrigin ctxt)-  = case ctxt of-       FunSigCtxt n _ -> text "a SPECIALISE pragma for" <+> quotes (ppr n)-       SpecInstCtxt   -> text "a SPECIALISE INSTANCE pragma"-       _              -> text "a SPECIALISE pragma"  -- Never happens I think--pprCtOrigin (FunDepOrigin1 pred1 loc1 pred2 loc2)-  = hang (ctoHerald <+> text "a functional dependency between constraints:")-       2 (vcat [ hang (quotes (ppr pred1)) 2 (pprCtLoc loc1)-               , hang (quotes (ppr pred2)) 2 (pprCtLoc loc2) ])--pprCtOrigin (FunDepOrigin2 pred1 orig1 pred2 loc2)-  = hang (ctoHerald <+> text "a functional dependency between:")-       2 (vcat [ hang (text "constraint" <+> quotes (ppr pred1))-                    2 (pprCtOrigin orig1 )-               , hang (text "instance" <+> quotes (ppr pred2))-                    2 (text "at" <+> ppr loc2) ])--pprCtOrigin (KindEqOrigin t1 (Just t2) _ _)-  = hang (ctoHerald <+> text "a kind equality arising from")-       2 (sep [ppr t1, char '~', ppr t2])--pprCtOrigin AssocFamPatOrigin-  = text "when matching a family LHS with its class instance head"--pprCtOrigin (KindEqOrigin t1 Nothing _ _)-  = hang (ctoHerald <+> text "a kind equality when matching")-       2 (ppr t1)--pprCtOrigin (UnboundOccurrenceOf name)-  = ctoHerald <+> text "an undeclared identifier" <+> quotes (ppr name)--pprCtOrigin (DerivOriginDC dc n _)-  = hang (ctoHerald <+> text "the" <+> speakNth n-          <+> text "field of" <+> quotes (ppr dc))-       2 (parens (text "type" <+> quotes (ppr ty)))-  where-    ty = dataConOrigArgTys dc !! (n-1)--pprCtOrigin (DerivOriginCoerce meth ty1 ty2 _)-  = hang (ctoHerald <+> text "the coercion of the method" <+> quotes (ppr meth))-       2 (sep [ text "from type" <+> quotes (ppr ty1)-              , nest 2 $ text "to type" <+> quotes (ppr ty2) ])--pprCtOrigin (DoPatOrigin pat)-    = ctoHerald <+> text "a do statement"-      $$-      text "with the failable pattern" <+> quotes (ppr pat)--pprCtOrigin (MCompPatOrigin pat)-    = ctoHerald <+> hsep [ text "the failable pattern"-           , quotes (ppr pat)-           , text "in a statement in a monad comprehension" ]-pprCtOrigin (FailablePattern pat)-    = ctoHerald <+> text "the failable pattern" <+> quotes (ppr pat)-      $$-      text "(this will become an error in a future GHC release)"--pprCtOrigin (Shouldn'tHappenOrigin note)-  = sdocWithDynFlags $ \dflags ->-    if xopt LangExt.ImpredicativeTypes dflags-    then text "a situation created by impredicative types"-    else-    vcat [ text "<< This should not appear in error messages. If you see this"-         , text "in an error message, please report a bug mentioning" <+> quotes (text note) <+> text "at"-         , text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>" ]--pprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) })-  = hang (ctoHerald <+> text "the \"provided\" constraints claimed by")-       2 (text "the signature of" <+> quotes (ppr name))--pprCtOrigin (InstProvidedOrigin mod cls_inst)-  = vcat [ text "arising when attempting to show that"-         , ppr cls_inst-         , text "is provided by" <+> quotes (ppr mod)]--pprCtOrigin simple_origin-  = ctoHerald <+> pprCtO simple_origin---- | Short one-liners-pprCtO :: CtOrigin -> SDoc-pprCtO (OccurrenceOf name)   = hsep [text "a use of", quotes (ppr name)]-pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)]-pprCtO AppOrigin             = text "an application"-pprCtO (IPOccOrigin name)    = hsep [text "a use of implicit parameter", quotes (ppr name)]-pprCtO (OverLabelOrigin l)   = hsep [text "the overloaded label"-                                    ,quotes (char '#' <> ppr l)]-pprCtO RecordUpdOrigin       = text "a record update"-pprCtO ExprSigOrigin         = text "an expression type signature"-pprCtO PatSigOrigin          = text "a pattern type signature"-pprCtO PatOrigin             = text "a pattern"-pprCtO ViewPatOrigin         = text "a view pattern"-pprCtO IfOrigin              = text "an if expression"-pprCtO (LiteralOrigin lit)   = hsep [text "the literal", quotes (ppr lit)]-pprCtO (ArithSeqOrigin seq)  = hsep [text "the arithmetic sequence", quotes (ppr seq)]-pprCtO SectionOrigin         = text "an operator section"-pprCtO AssocFamPatOrigin     = text "the LHS of a famly instance"-pprCtO TupleOrigin           = text "a tuple"-pprCtO NegateOrigin          = text "a use of syntactic negation"-pprCtO (ScOrigin n)          = text "the superclasses of an instance declaration"-                               <> whenPprDebug (parens (ppr n))-pprCtO DerivClauseOrigin     = text "the 'deriving' clause of a data type declaration"-pprCtO StandAloneDerivOrigin = text "a 'deriving' declaration"-pprCtO DefaultOrigin         = text "a 'default' declaration"-pprCtO DoOrigin              = text "a do statement"-pprCtO MCompOrigin           = text "a statement in a monad comprehension"-pprCtO ProcOrigin            = text "a proc expression"-pprCtO (TypeEqOrigin t1 t2 _ _)= text "a type equality" <+> sep [ppr t1, char '~', ppr t2]-pprCtO AnnOrigin             = text "an annotation"-pprCtO HoleOrigin            = text "a use of" <+> quotes (text "_")-pprCtO ListOrigin            = text "an overloaded list"-pprCtO StaticOrigin          = text "a static form"-pprCtO _                     = panic "pprCtOrigin"+        setLclEnvTcLevel, getLclEnvTcLevel,+        setLclEnvLoc, getLclEnvLoc,+        IfGblEnv(..), IfLclEnv(..),+        tcVisibleOrphanMods,++        -- Frontend types (shouldn't really be here)+        FrontendResult(..),++        -- Renamer types+        ErrCtxt, RecFieldEnv, pushErrCtxt, pushErrCtxtSameOrigin,+        ImportAvails(..), emptyImportAvails, plusImportAvails,+        WhereFrom(..), mkModDeps, modDepsElts,++        -- Typechecker types+        TcTypeEnv, TcBinderStack, TcBinder(..),+        TcTyThing(..), PromotionErr(..),+        IdBindingInfo(..), ClosedTypeId, RhsNames,+        IsGroupClosed(..),+        SelfBootInfo(..),+        pprTcTyThingCategory, pprPECategory, CompleteMatch(..),++        -- Desugaring types+        DsM, DsLclEnv(..), DsGblEnv(..),+        DsMetaEnv, DsMetaVal(..), CompleteMatchMap,+        mkCompleteMatchMap, extendCompleteMatchMap,++        -- Template Haskell+        ThStage(..), SpliceType(..), PendingStuff(..),+        topStage, topAnnStage, topSpliceStage,+        ThLevel, impLevel, outerLevel, thLevel,+        ForeignSrcLang(..),++        -- Arrows+        ArrowCtxt(..),++        -- TcSigInfo+        TcSigFun, TcSigInfo(..), TcIdSigInfo(..),+        TcIdSigInst(..), TcPatSynInfo(..),+        isPartialSig, hasCompleteSig,++        -- Misc other types+        TcId, TcIdSet,+        NameShape(..),+        removeBindingShadowing,++        -- Constraint solver plugins+        TcPlugin(..), TcPluginResult(..), TcPluginSolver,+        TcPluginM, runTcPluginM, unsafeTcPluginTcM,+        getEvBindsTcPluginM,++        -- Role annotations+        RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,+        lookupRoleAnnot, getRoleAnnots+  ) where++#include "HsVersions.h"++import GhcPrelude++import GHC.Hs+import HscTypes+import TcEvidence+import Type+import TyCon    ( TyCon, tyConKind )+import PatSyn   ( PatSyn )+import Id       ( idType, idName )+import FieldLabel ( FieldLabel )+import TcType+import Constraint+import TcOrigin+import Annotations+import InstEnv+import FamInstEnv+import {-# SOURCE #-} GHC.HsToCore.PmCheck.Types (Delta)+import IOEnv+import RdrName+import Name+import NameEnv+import NameSet+import Avail+import Var+import VarEnv+import Module+import SrcLoc+import VarSet+import ErrUtils+import UniqFM+import UniqSupply+import BasicTypes+import Bag+import DynFlags+import Outputable+import ListSetOps+import Fingerprint+import Util+import PrelNames ( isUnboundName )+import CostCentreState++import Control.Monad (ap)+import qualified Control.Monad.Fail as MonadFail+import Data.Set      ( Set )+import qualified Data.Set as S++import Data.List ( sort )+import Data.Map ( Map )+import Data.Dynamic  ( Dynamic )+import Data.Typeable ( TypeRep )+import Data.Maybe    ( mapMaybe )+import GHCi.Message+import GHCi.RemoteTypes++import {-# SOURCE #-} TcHoleFitTypes ( HoleFitPlugin )++import qualified Language.Haskell.TH as TH++-- | A 'NameShape' is a substitution on 'Name's that can be used+-- to refine the identities of a hole while we are renaming interfaces+-- (see 'RnModIface').  Specifically, a 'NameShape' for+-- 'ns_module_name' @A@, defines a mapping from @{A.T}@+-- (for some 'OccName' @T@) to some arbitrary other 'Name'.+--+-- The most intruiging thing about a 'NameShape', however, is+-- how it's constructed.  A 'NameShape' is *implied* by the+-- exported 'AvailInfo's of the implementor of an interface:+-- if an implementor of signature @<H>@ exports @M.T@, you implicitly+-- define a substitution from @{H.T}@ to @M.T@.  So a 'NameShape'+-- is computed from the list of 'AvailInfo's that are exported+-- by the implementation of a module, or successively merged+-- together by the export lists of signatures which are joining+-- together.+--+-- It's not the most obvious way to go about doing this, but it+-- does seem to work!+--+-- NB: Can't boot this and put it in NameShape because then we+-- start pulling in too many DynFlags things.+data NameShape = NameShape {+        ns_mod_name :: ModuleName,+        ns_exports :: [AvailInfo],+        ns_map :: OccEnv Name+    }+++{-+************************************************************************+*                                                                      *+               Standard monad definition for TcRn+    All the combinators for the monad can be found in TcRnMonad+*                                                                      *+************************************************************************++The monad itself has to be defined here, because it is mentioned by ErrCtxt+-}++type TcRnIf a b = IOEnv (Env a b)+type TcRn       = TcRnIf TcGblEnv TcLclEnv    -- Type inference+type IfM lcl    = TcRnIf IfGblEnv lcl         -- Iface stuff+type IfG        = IfM ()                      --    Top level+type IfL        = IfM IfLclEnv                --    Nested+type DsM        = TcRnIf DsGblEnv DsLclEnv    -- Desugaring++-- TcRn is the type-checking and renaming monad: the main monad that+-- most type-checking takes place in.  The global environment is+-- 'TcGblEnv', which tracks all of the top-level type-checking+-- information we've accumulated while checking a module, while the+-- local environment is 'TcLclEnv', which tracks local information as+-- we move inside expressions.++-- | Historical "renaming monad" (now it's just 'TcRn').+type RnM  = TcRn++-- | Historical "type-checking monad" (now it's just 'TcRn').+type TcM  = TcRn++-- We 'stack' these envs through the Reader like monad infrastructure+-- as we move into an expression (although the change is focused in+-- the lcl type).+data Env gbl lcl+  = Env {+        env_top  :: !HscEnv, -- Top-level stuff that never changes+                             -- Includes all info about imported things+                             -- BangPattern is to fix leak, see #15111++        env_us   :: {-# UNPACK #-} !(IORef UniqSupply),+                             -- Unique supply for local variables++        env_gbl  :: gbl,     -- Info about things defined at the top level+                             -- of the module being compiled++        env_lcl  :: lcl      -- Nested stuff; changes as we go into+    }++instance ContainsDynFlags (Env gbl lcl) where+    extractDynFlags env = hsc_dflags (env_top env)++instance ContainsModule gbl => ContainsModule (Env gbl lcl) where+    extractModule env = extractModule (env_gbl env)+++{-+************************************************************************+*                                                                      *+                The interface environments+              Used when dealing with IfaceDecls+*                                                                      *+************************************************************************+-}++data IfGblEnv+  = IfGblEnv {+        -- Some information about where this environment came from;+        -- useful for debugging.+        if_doc :: SDoc,+        -- The type environment for the module being compiled,+        -- in case the interface refers back to it via a reference that+        -- was originally a hi-boot file.+        -- We need the module name so we can test when it's appropriate+        -- to look in this env.+        -- See Note [Tying the knot] in TcIface+        if_rec_types :: Maybe (Module, IfG TypeEnv)+                -- Allows a read effect, so it can be in a mutable+                -- variable; c.f. handling the external package type env+                -- Nothing => interactive stuff, no loops possible+    }++data IfLclEnv+  = IfLclEnv {+        -- The module for the current IfaceDecl+        -- So if we see   f = \x -> x+        -- it means M.f = \x -> x, where M is the if_mod+        -- NB: This is a semantic module, see+        -- Note [Identity versus semantic module]+        if_mod :: Module,++        -- Whether or not the IfaceDecl came from a boot+        -- file or not; we'll use this to choose between+        -- NoUnfolding and BootUnfolding+        if_boot :: Bool,++        -- The field is used only for error reporting+        -- if (say) there's a Lint error in it+        if_loc :: SDoc,+                -- Where the interface came from:+                --      .hi file, or GHCi state, or ext core+                -- plus which bit is currently being examined++        if_nsubst :: Maybe NameShape,++        -- This field is used to make sure "implicit" declarations+        -- (anything that cannot be exported in mi_exports) get+        -- wired up correctly in typecheckIfacesForMerging.  Most+        -- of the time it's @Nothing@.  See Note [Resolving never-exported Names in TcIface]+        -- in TcIface.+        if_implicits_env :: Maybe TypeEnv,++        if_tv_env  :: FastStringEnv TyVar,     -- Nested tyvar bindings+        if_id_env  :: FastStringEnv Id         -- Nested id binding+    }++{-+************************************************************************+*                                                                      *+                Desugarer monad+*                                                                      *+************************************************************************++Now the mondo monad magic (yes, @DsM@ is a silly name)---carry around+a @UniqueSupply@ and some annotations, which+presumably include source-file location information:+-}++data DsGblEnv+        = DsGblEnv+        { ds_mod          :: Module             -- For SCC profiling+        , ds_fam_inst_env :: FamInstEnv         -- Like tcg_fam_inst_env+        , ds_unqual  :: PrintUnqualified+        , ds_msgs    :: IORef Messages          -- Warning messages+        , ds_if_env  :: (IfGblEnv, IfLclEnv)    -- Used for looking up global,+                                                -- possibly-imported things+        , ds_complete_matches :: CompleteMatchMap+           -- Additional complete pattern matches+        , ds_cc_st   :: IORef CostCentreState+           -- Tracking indices for cost centre annotations+        }++instance ContainsModule DsGblEnv where+    extractModule = ds_mod++data DsLclEnv = DsLclEnv {+        dsl_meta    :: DsMetaEnv,        -- Template Haskell bindings+        dsl_loc     :: RealSrcSpan,      -- To put in pattern-matching error msgs++        -- See Note [Note [Type and Term Equality Propagation] in Check.hs+        -- The oracle state Delta is augmented as we walk inwards,+        -- through each pattern match in turn+        dsl_delta   :: Delta+     }++-- Inside [| |] brackets, the desugarer looks+-- up variables in the DsMetaEnv+type DsMetaEnv = NameEnv DsMetaVal++data DsMetaVal+   = DsBound Id         -- Bound by a pattern inside the [| |].+                        -- Will be dynamically alpha renamed.+                        -- The Id has type THSyntax.Var++   | DsSplice (HsExpr GhcTc) -- These bindings are introduced by+                             -- the PendingSplices on a HsBracketOut+++{-+************************************************************************+*                                                                      *+                Global typechecker environment+*                                                                      *+************************************************************************+-}++-- | 'FrontendResult' describes the result of running the+-- frontend of a Haskell module.  Usually, you'll get+-- a 'FrontendTypecheck', since running the frontend involves+-- typechecking a program, but for an hs-boot merge you'll+-- just get a ModIface, since no actual typechecking occurred.+--+-- This data type really should be in HscTypes, but it needs+-- to have a TcGblEnv which is only defined here.+data FrontendResult+        = FrontendTypecheck TcGblEnv++-- Note [Identity versus semantic module]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- When typechecking an hsig file, it is convenient to keep track+-- of two different "this module" identifiers:+--+--      - The IDENTITY module is simply thisPackage + the module+--        name; i.e. it uniquely *identifies* the interface file+--        we're compiling.  For example, p[A=<A>]:A is an+--        identity module identifying the requirement named A+--        from library p.+--+--      - The SEMANTIC module, which is the actual module that+--        this signature is intended to represent (e.g. if+--        we have a identity module p[A=base:Data.IORef]:A,+--        then the semantic module is base:Data.IORef)+--+-- Which one should you use?+--+--      - In the desugarer and later phases of compilation,+--        identity and semantic modules coincide, since we never compile+--        signatures (we just generate blank object files for+--        hsig files.)+--+--        A corrolary of this is that the following invariant holds at any point+--        past desugaring,+--+--            if I have a Module, this_mod, in hand representing the module+--            currently being compiled,+--            then moduleUnitId this_mod == thisPackage dflags+--+--      - For any code involving Names, we want semantic modules.+--        See lookupIfaceTop in IfaceEnv, mkIface and addFingerprints+--        in MkIface, and tcLookupGlobal in TcEnv+--+--      - When reading interfaces, we want the identity module to+--        identify the specific interface we want (such interfaces+--        should never be loaded into the EPS).  However, if a+--        hole module <A> is requested, we look for A.hi+--        in the home library we are compiling.  (See LoadIface.)+--        Similarly, in RnNames we check for self-imports using+--        identity modules, to allow signatures to import their implementor.+--+--      - For recompilation avoidance, you want the identity module,+--        since that will actually say the specific interface you+--        want to track (and recompile if it changes)++-- | 'TcGblEnv' describes the top-level of the module at the+-- point at which the typechecker is finished work.+-- It is this structure that is handed on to the desugarer+-- For state that needs to be updated during the typechecking+-- phase and returned at end, use a 'TcRef' (= 'IORef').+data TcGblEnv+  = TcGblEnv {+        tcg_mod     :: Module,         -- ^ Module being compiled+        tcg_semantic_mod :: Module,    -- ^ If a signature, the backing module+            -- See also Note [Identity versus semantic module]+        tcg_src     :: HscSource,+          -- ^ What kind of module (regular Haskell, hs-boot, hsig)++        tcg_rdr_env :: GlobalRdrEnv,   -- ^ Top level envt; used during renaming+        tcg_default :: Maybe [Type],+          -- ^ Types used for defaulting. @Nothing@ => no @default@ decl++        tcg_fix_env   :: FixityEnv,     -- ^ Just for things in this module+        tcg_field_env :: RecFieldEnv,   -- ^ Just for things in this module+                                        -- See Note [The interactive package] in HscTypes++        tcg_type_env :: TypeEnv,+          -- ^ Global type env for the module we are compiling now.  All+          -- TyCons and Classes (for this module) end up in here right away,+          -- along with their derived constructors, selectors.+          --+          -- (Ids defined in this module start in the local envt, though they+          --  move to the global envt during zonking)+          --+          -- NB: for what "things in this module" means, see+          -- Note [The interactive package] in HscTypes++        tcg_type_env_var :: TcRef TypeEnv,+                -- Used only to initialise the interface-file+                -- typechecker in initIfaceTcRn, so that it can see stuff+                -- bound in this module when dealing with hi-boot recursions+                -- Updated at intervals (e.g. after dealing with types and classes)++        tcg_inst_env     :: !InstEnv,+          -- ^ Instance envt for all /home-package/ modules;+          -- Includes the dfuns in tcg_insts+          -- NB. BangPattern is to fix a leak, see #15111+        tcg_fam_inst_env :: !FamInstEnv, -- ^ Ditto for family instances+          -- NB. BangPattern is to fix a leak, see #15111+        tcg_ann_env      :: AnnEnv,     -- ^ And for annotations++                -- Now a bunch of things about this module that are simply+                -- accumulated, but never consulted until the end.+                -- Nevertheless, it's convenient to accumulate them along+                -- with the rest of the info from this module.+        tcg_exports :: [AvailInfo],     -- ^ What is exported+        tcg_imports :: ImportAvails,+          -- ^ Information about what was imported from where, including+          -- things bound in this module. Also store Safe Haskell info+          -- here about transitive trusted package requirements.+          --+          -- There are not many uses of this field, so you can grep for+          -- all them.+          --+          -- The ImportAvails records information about the following+          -- things:+          --+          --    1. All of the modules you directly imported (tcRnImports)+          --    2. The orphans (only!) of all imported modules in a GHCi+          --       session (runTcInteractive)+          --    3. The module that instantiated a signature+          --    4. Each of the signatures that merged in+          --+          -- It is used in the following ways:+          --    - imp_orphs is used to determine what orphan modules should be+          --      visible in the context (tcVisibleOrphanMods)+          --    - imp_finsts is used to determine what family instances should+          --      be visible (tcExtendLocalFamInstEnv)+          --    - To resolve the meaning of the export list of a module+          --      (tcRnExports)+          --    - imp_mods is used to compute usage info (mkIfaceTc, deSugar)+          --    - imp_trust_own_pkg is used for Safe Haskell in interfaces+          --      (mkIfaceTc, as well as in HscMain)+          --    - To create the Dependencies field in interface (mkDependencies)++          -- These three fields track unused bindings and imports+          -- See Note [Tracking unused binding and imports]+        tcg_dus       :: DefUses,+        tcg_used_gres :: TcRef [GlobalRdrElt],+        tcg_keep      :: TcRef NameSet,++        tcg_th_used :: TcRef Bool,+          -- ^ @True@ <=> Template Haskell syntax used.+          --+          -- We need this so that we can generate a dependency on the+          -- Template Haskell package, because the desugarer is going+          -- to emit loads of references to TH symbols.  The reference+          -- is implicit rather than explicit, so we have to zap a+          -- mutable variable.++        tcg_th_splice_used :: TcRef Bool,+          -- ^ @True@ <=> A Template Haskell splice was used.+          --+          -- Splices disable recompilation avoidance (see #481)++        tcg_dfun_n  :: TcRef OccSet,+          -- ^ Allows us to choose unique DFun names.++        tcg_merged :: [(Module, Fingerprint)],+          -- ^ The requirements we merged with; we always have to recompile+          -- if any of these changed.++        -- The next fields accumulate the payload of the module+        -- The binds, rules and foreign-decl fields are collected+        -- initially in un-zonked form and are finally zonked in tcRnSrcDecls++        tcg_rn_exports :: Maybe [(Located (IE GhcRn), Avails)],+                -- Nothing <=> no explicit export list+                -- Is always Nothing if we don't want to retain renamed+                -- exports.+                -- If present contains each renamed export list item+                -- together with its exported names.++        tcg_rn_imports :: [LImportDecl GhcRn],+                -- Keep the renamed imports regardless.  They are not+                -- voluminous and are needed if you want to report unused imports++        tcg_rn_decls :: Maybe (HsGroup GhcRn),+          -- ^ Renamed decls, maybe.  @Nothing@ <=> Don't retain renamed+          -- decls.++        tcg_dependent_files :: TcRef [FilePath], -- ^ dependencies from addDependentFile++        tcg_th_topdecls :: TcRef [LHsDecl GhcPs],+        -- ^ Top-level declarations from addTopDecls++        tcg_th_foreign_files :: TcRef [(ForeignSrcLang, FilePath)],+        -- ^ Foreign files emitted from TH.++        tcg_th_topnames :: TcRef NameSet,+        -- ^ Exact names bound in top-level declarations in tcg_th_topdecls++        tcg_th_modfinalizers :: TcRef [(TcLclEnv, ThModFinalizers)],+        -- ^ Template Haskell module finalizers.+        --+        -- They can use particular local environments.++        tcg_th_coreplugins :: TcRef [String],+        -- ^ Core plugins added by Template Haskell code.++        tcg_th_state :: TcRef (Map TypeRep Dynamic),+        tcg_th_remote_state :: TcRef (Maybe (ForeignRef (IORef QState))),+        -- ^ Template Haskell state++        tcg_ev_binds  :: Bag EvBind,        -- Top-level evidence bindings++        -- Things defined in this module, or (in GHCi)+        -- in the declarations for a single GHCi command.+        -- For the latter, see Note [The interactive package] in HscTypes+        tcg_tr_module :: Maybe Id,   -- Id for $trModule :: GHC.Types.Module+                                             -- for which every module has a top-level defn+                                             -- except in GHCi in which case we have Nothing+        tcg_binds     :: LHsBinds GhcTc,     -- Value bindings in this module+        tcg_sigs      :: NameSet,            -- ...Top-level names that *lack* a signature+        tcg_imp_specs :: [LTcSpecPrag],      -- ...SPECIALISE prags for imported Ids+        tcg_warns     :: Warnings,           -- ...Warnings and deprecations+        tcg_anns      :: [Annotation],       -- ...Annotations+        tcg_tcs       :: [TyCon],            -- ...TyCons and Classes+        tcg_insts     :: [ClsInst],          -- ...Instances+        tcg_fam_insts :: [FamInst],          -- ...Family instances+        tcg_rules     :: [LRuleDecl GhcTc],  -- ...Rules+        tcg_fords     :: [LForeignDecl GhcTc], -- ...Foreign import & exports+        tcg_patsyns   :: [PatSyn],            -- ...Pattern synonyms++        tcg_doc_hdr   :: Maybe LHsDocString, -- ^ Maybe Haddock header docs+        tcg_hpc       :: !AnyHpcUsage,       -- ^ @True@ if any part of the+                                             --  prog uses hpc instrumentation.+           -- NB. BangPattern is to fix a leak, see #15111++        tcg_self_boot :: SelfBootInfo,       -- ^ Whether this module has a+                                             -- corresponding hi-boot file++        tcg_main      :: Maybe Name,         -- ^ The Name of the main+                                             -- function, if this module is+                                             -- the main module.++        tcg_safeInfer :: TcRef (Bool, WarningMessages),+        -- ^ Has the typechecker inferred this module as -XSafe (Safe Haskell)+        -- See Note [Safe Haskell Overlapping Instances Implementation],+        -- although this is used for more than just that failure case.++        tcg_tc_plugins :: [TcPluginSolver],+        -- ^ A list of user-defined plugins for the constraint solver.+        tcg_hf_plugins :: [HoleFitPlugin],+        -- ^ A list of user-defined plugins for hole fit suggestions.++        tcg_top_loc :: RealSrcSpan,+        -- ^ The RealSrcSpan this module came from++        tcg_static_wc :: TcRef WantedConstraints,+          -- ^ Wanted constraints of static forms.+        -- See Note [Constraints in static forms].+        tcg_complete_matches :: [CompleteMatch],++        -- ^ Tracking indices for cost centre annotations+        tcg_cc_st   :: TcRef CostCentreState+    }++-- NB: topModIdentity, not topModSemantic!+-- Definition sites of orphan identities will be identity modules, not semantic+-- modules.++-- Note [Constraints in static forms]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+--+-- When a static form produces constraints like+--+-- f :: StaticPtr (Bool -> String)+-- f = static show+--+-- we collect them in tcg_static_wc and resolve them at the end+-- of type checking. They need to be resolved separately because+-- we don't want to resolve them in the context of the enclosing+-- expression. Consider+--+-- g :: Show a => StaticPtr (a -> String)+-- g = static show+--+-- If the @Show a0@ constraint that the body of the static form produces was+-- resolved in the context of the enclosing expression, then the body of the+-- static form wouldn't be closed because the Show dictionary would come from+-- g's context instead of coming from the top level.++tcVisibleOrphanMods :: TcGblEnv -> ModuleSet+tcVisibleOrphanMods tcg_env+    = mkModuleSet (tcg_mod tcg_env : imp_orphs (tcg_imports tcg_env))++instance ContainsModule TcGblEnv where+    extractModule env = tcg_semantic_mod env++type RecFieldEnv = NameEnv [FieldLabel]+        -- Maps a constructor name *in this module*+        -- to the fields for that constructor.+        -- This is used when dealing with ".." notation in record+        -- construction and pattern matching.+        -- The FieldEnv deals *only* with constructors defined in *this*+        -- module.  For imported modules, we get the same info from the+        -- TypeEnv++data SelfBootInfo+  = NoSelfBoot    -- No corresponding hi-boot file+  | SelfBoot+       { sb_mds :: ModDetails   -- There was a hi-boot file,+       , sb_tcs :: NameSet }    -- defining these TyCons,+-- What is sb_tcs used for?  See Note [Extra dependencies from .hs-boot files]+-- in RnSource+++{- Note [Tracking unused binding and imports]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+We gather three sorts of usage information++ * tcg_dus :: DefUses (defs/uses)+      Records what is defined in this module and what is used.++      Records *defined* Names (local, top-level)+          and *used*    Names (local or imported)++      Used (a) to report "defined but not used"+               (see RnNames.reportUnusedNames)+           (b) to generate version-tracking usage info in interface+               files (see MkIface.mkUsedNames)+   This usage info is mainly gathered by the renamer's+   gathering of free-variables++ * tcg_used_gres :: TcRef [GlobalRdrElt]+      Records occurrences of imported entities.++      Used only to report unused import declarations++      Records each *occurrence* an *imported* (not locally-defined) entity.+      The occurrence is recorded by keeping a GlobalRdrElt for it.+      These is not the GRE that is in the GlobalRdrEnv; rather it+      is recorded *after* the filtering done by pickGREs.  So it reflect+      /how that occurrence is in scope/.   See Note [GRE filtering] in+      RdrName.++  * tcg_keep :: TcRef NameSet+      Records names of the type constructors, data constructors, and Ids that+      are used by the constraint solver.++      The typechecker may use find that some imported or+      locally-defined things are used, even though they+      do not appear to be mentioned in the source code:++      (a) The to/from functions for generic data types++      (b) Top-level variables appearing free in the RHS of an+          orphan rule++      (c) Top-level variables appearing free in a TH bracket+          See Note [Keeping things alive for Template Haskell]+          in RnSplice++      (d) The data constructor of a newtype that is used+          to solve a Coercible instance (e.g. #10347). Example+              module T10347 (N, mkN) where+                import Data.Coerce+                newtype N a = MkN Int+                mkN :: Int -> N a+                mkN = coerce++          Then we wish to record `MkN` as used, since it is (morally)+          used to perform the coercion in `mkN`. To do so, the+          Coercible solver updates tcg_keep's TcRef whenever it+          encounters a use of `coerce` that crosses newtype boundaries.++      The tcg_keep field is used in two distinct ways:++      * Desugar.addExportFlagsAndRules.  Where things like (a-c) are locally+        defined, we should give them an an Exported flag, so that the+        simplifier does not discard them as dead code, and so that they are+        exposed in the interface file (but not to export to the user).++      * RnNames.reportUnusedNames.  Where newtype data constructors like (d)+        are imported, we don't want to report them as unused.+++************************************************************************+*                                                                      *+                The local typechecker environment+*                                                                      *+************************************************************************++Note [The Global-Env/Local-Env story]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+During type checking, we keep in the tcg_type_env+        * All types and classes+        * All Ids derived from types and classes (constructors, selectors)++At the end of type checking, we zonk the local bindings,+and as we do so we add to the tcg_type_env+        * Locally defined top-level Ids++Why?  Because they are now Ids not TcIds.  This final GlobalEnv is+        a) fed back (via the knot) to typechecking the+           unfoldings of interface signatures+        b) used in the ModDetails of this module+-}++data TcLclEnv           -- Changes as we move inside an expression+                        -- Discarded after typecheck/rename; not passed on to desugarer+  = TcLclEnv {+        tcl_loc        :: RealSrcSpan,     -- Source span+        tcl_ctxt       :: [ErrCtxt],       -- Error context, innermost on top+        tcl_tclvl      :: TcLevel,         -- Birthplace for new unification variables++        tcl_th_ctxt    :: ThStage,         -- Template Haskell context+        tcl_th_bndrs   :: ThBindEnv,       -- and binder info+            -- The ThBindEnv records the TH binding level of in-scope Names+            -- defined in this module (not imported)+            -- We can't put this info in the TypeEnv because it's needed+            -- (and extended) in the renamer, for untyed splices++        tcl_arrow_ctxt :: ArrowCtxt,       -- Arrow-notation context++        tcl_rdr :: LocalRdrEnv,         -- Local name envt+                -- Maintained during renaming, of course, but also during+                -- type checking, solely so that when renaming a Template-Haskell+                -- splice we have the right environment for the renamer.+                --+                --   Does *not* include global name envt; may shadow it+                --   Includes both ordinary variables and type variables;+                --   they are kept distinct because tyvar have a different+                --   occurrence constructor (Name.TvOcc)+                -- We still need the unsullied global name env so that+                --   we can look up record field names++        tcl_env  :: TcTypeEnv,    -- The local type environment:+                                  -- Ids and TyVars defined in this module++        tcl_bndrs :: TcBinderStack,   -- Used for reporting relevant bindings,+                                      -- and for tidying types++        tcl_lie  :: TcRef WantedConstraints,    -- Place to accumulate type constraints+        tcl_errs :: TcRef Messages              -- Place to accumulate errors+    }++setLclEnvTcLevel :: TcLclEnv -> TcLevel -> TcLclEnv+setLclEnvTcLevel env lvl = env { tcl_tclvl = lvl }++getLclEnvTcLevel :: TcLclEnv -> TcLevel+getLclEnvTcLevel = tcl_tclvl++setLclEnvLoc :: TcLclEnv -> RealSrcSpan -> TcLclEnv+setLclEnvLoc env loc = env { tcl_loc = loc }++getLclEnvLoc :: TcLclEnv -> RealSrcSpan+getLclEnvLoc = tcl_loc++type ErrCtxt = (Bool, TidyEnv -> TcM (TidyEnv, MsgDoc))+        -- Monadic so that we have a chance+        -- to deal with bound type variables just before error+        -- message construction++        -- Bool:  True <=> this is a landmark context; do not+        --                 discard it when trimming for display++-- These are here to avoid module loops: one might expect them+-- in Constraint, but they refer to ErrCtxt which refers to TcM.+-- Easier to just keep these definitions here, alongside TcM.+pushErrCtxt :: CtOrigin -> ErrCtxt -> CtLoc -> CtLoc+pushErrCtxt o err loc@(CtLoc { ctl_env = lcl })+  = loc { ctl_origin = o, ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }++pushErrCtxtSameOrigin :: ErrCtxt -> CtLoc -> CtLoc+-- Just add information w/o updating the origin!+pushErrCtxtSameOrigin err loc@(CtLoc { ctl_env = lcl })+  = loc { ctl_env = lcl { tcl_ctxt = err : tcl_ctxt lcl } }++type TcTypeEnv = NameEnv TcTyThing++type ThBindEnv = NameEnv (TopLevelFlag, ThLevel)+   -- Domain = all Ids bound in this module (ie not imported)+   -- The TopLevelFlag tells if the binding is syntactically top level.+   -- We need to know this, because the cross-stage persistence story allows+   -- cross-stage at arbitrary types if the Id is bound at top level.+   --+   -- Nota bene: a ThLevel of 'outerLevel' is *not* the same as being+   -- bound at top level!  See Note [Template Haskell levels] in TcSplice++{- Note [Given Insts]+   ~~~~~~~~~~~~~~~~~~+Because of GADTs, we have to pass inwards the Insts provided by type signatures+and existential contexts. Consider+        data T a where { T1 :: b -> b -> T [b] }+        f :: Eq a => T a -> Bool+        f (T1 x y) = [x]==[y]++The constructor T1 binds an existential variable 'b', and we need Eq [b].+Well, we have it, because Eq a refines to Eq [b], but we can only spot that if we+pass it inwards.++-}++-- | Type alias for 'IORef'; the convention is we'll use this for mutable+-- bits of data in 'TcGblEnv' which are updated during typechecking and+-- returned at the end.+type TcRef a     = IORef a+-- ToDo: when should I refer to it as a 'TcId' instead of an 'Id'?+type TcId        = Id+type TcIdSet     = IdSet++---------------------------+-- The TcBinderStack+---------------------------++type TcBinderStack = [TcBinder]+   -- This is a stack of locally-bound ids and tyvars,+   --   innermost on top+   -- Used only in error reporting (relevantBindings in TcError),+   --   and in tidying+   -- We can't use the tcl_env type environment, because it doesn't+   --   keep track of the nesting order++data TcBinder+  = TcIdBndr+       TcId+       TopLevelFlag    -- Tells whether the binding is syntactically top-level+                       -- (The monomorphic Ids for a recursive group count+                       --  as not-top-level for this purpose.)++  | TcIdBndr_ExpType  -- Variant that allows the type to be specified as+                      -- an ExpType+       Name+       ExpType+       TopLevelFlag++  | TcTvBndr          -- e.g.   case x of P (y::a) -> blah+       Name           -- We bind the lexical name "a" to the type of y,+       TyVar          -- which might be an utterly different (perhaps+                      -- existential) tyvar++instance Outputable TcBinder where+   ppr (TcIdBndr id top_lvl)           = ppr id <> brackets (ppr top_lvl)+   ppr (TcIdBndr_ExpType id _ top_lvl) = ppr id <> brackets (ppr top_lvl)+   ppr (TcTvBndr name tv)              = ppr name <+> ppr tv++instance HasOccName TcBinder where+    occName (TcIdBndr id _)             = occName (idName id)+    occName (TcIdBndr_ExpType name _ _) = occName name+    occName (TcTvBndr name _)           = occName name++-- fixes #12177+-- Builds up a list of bindings whose OccName has not been seen before+-- i.e., If    ys  = removeBindingShadowing xs+-- then+--  - ys is obtained from xs by deleting some elements+--  - ys has no duplicate OccNames+--  - The first duplicated OccName in xs is retained in ys+-- Overloaded so that it can be used for both GlobalRdrElt in typed-hole+-- substitutions and TcBinder when looking for relevant bindings.+removeBindingShadowing :: HasOccName a => [a] -> [a]+removeBindingShadowing bindings = reverse $ fst $ foldl+    (\(bindingAcc, seenNames) binding ->+    if occName binding `elemOccSet` seenNames -- if we've seen it+        then (bindingAcc, seenNames)              -- skip it+        else (binding:bindingAcc, extendOccSet seenNames (occName binding)))+    ([], emptyOccSet) bindings++---------------------------+-- Template Haskell stages and levels+---------------------------++data SpliceType = Typed | Untyped++data ThStage    -- See Note [Template Haskell state diagram] in TcSplice+  = Splice SpliceType -- Inside a top-level splice+                      -- This code will be run *at compile time*;+                      --   the result replaces the splice+                      -- Binding level = 0++  | RunSplice (TcRef [ForeignRef (TH.Q ())])+      -- Set when running a splice, i.e. NOT when renaming or typechecking the+      -- Haskell code for the splice. See Note [RunSplice ThLevel].+      --+      -- Contains a list of mod finalizers collected while executing the splice.+      --+      -- 'addModFinalizer' inserts finalizers here, and from here they are taken+      -- to construct an @HsSpliced@ annotation for untyped splices. See Note+      -- [Delaying modFinalizers in untyped splices] in "RnSplice".+      --+      -- For typed splices, the typechecker takes finalizers from here and+      -- inserts them in the list of finalizers in the global environment.+      --+      -- See Note [Collecting modFinalizers in typed splices] in "TcSplice".++  | Comp        -- Ordinary Haskell code+                -- Binding level = 1++  | Brack                       -- Inside brackets+      ThStage                   --   Enclosing stage+      PendingStuff++data PendingStuff+  = RnPendingUntyped              -- Renaming the inside of an *untyped* bracket+      (TcRef [PendingRnSplice])   -- Pending splices in here++  | RnPendingTyped                -- Renaming the inside of a *typed* bracket++  | TcPending                     -- Typechecking the inside of a typed bracket+      (TcRef [PendingTcSplice])   --   Accumulate pending splices here+      (TcRef WantedConstraints)   --     and type constraints here++topStage, topAnnStage, topSpliceStage :: ThStage+topStage       = Comp+topAnnStage    = Splice Untyped+topSpliceStage = Splice Untyped++instance Outputable ThStage where+   ppr (Splice _)    = text "Splice"+   ppr (RunSplice _) = text "RunSplice"+   ppr Comp          = text "Comp"+   ppr (Brack s _)   = text "Brack" <> parens (ppr s)++type ThLevel = Int+    -- NB: see Note [Template Haskell levels] in TcSplice+    -- Incremented when going inside a bracket,+    -- decremented when going inside a splice+    -- NB: ThLevel is one greater than the 'n' in Fig 2 of the+    --     original "Template meta-programming for Haskell" paper++impLevel, outerLevel :: ThLevel+impLevel = 0    -- Imported things; they can be used inside a top level splice+outerLevel = 1  -- Things defined outside brackets++thLevel :: ThStage -> ThLevel+thLevel (Splice _)    = 0+thLevel (RunSplice _) =+    -- See Note [RunSplice ThLevel].+    panic "thLevel: called when running a splice"+thLevel Comp          = 1+thLevel (Brack s _)   = thLevel s + 1++{- Node [RunSplice ThLevel]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The 'RunSplice' stage is set when executing a splice, and only when running a+splice. In particular it is not set when the splice is renamed or typechecked.++'RunSplice' is needed to provide a reference where 'addModFinalizer' can insert+the finalizer (see Note [Delaying modFinalizers in untyped splices]), and+'addModFinalizer' runs when doing Q things. Therefore, It doesn't make sense to+set 'RunSplice' when renaming or typechecking the splice, where 'Splice',+'Brack' or 'Comp' are used instead.++-}++---------------------------+-- Arrow-notation context+---------------------------++{- Note [Escaping the arrow scope]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In arrow notation, a variable bound by a proc (or enclosed let/kappa)+is not in scope to the left of an arrow tail (-<) or the head of (|..|).+For example++        proc x -> (e1 -< e2)++Here, x is not in scope in e1, but it is in scope in e2.  This can get+a bit complicated:++        let x = 3 in+        proc y -> (proc z -> e1) -< e2++Here, x and z are in scope in e1, but y is not.++We implement this by+recording the environment when passing a proc (using newArrowScope),+and returning to that (using escapeArrowScope) on the left of -< and the+head of (|..|).++All this can be dealt with by the *renamer*. But the type checker needs+to be involved too.  Example (arrowfail001)+  class Foo a where foo :: a -> ()+  data Bar = forall a. Foo a => Bar a+  get :: Bar -> ()+  get = proc x -> case x of Bar a -> foo -< a+Here the call of 'foo' gives rise to a (Foo a) constraint that should not+be captured by the pattern match on 'Bar'.  Rather it should join the+constraints from further out.  So we must capture the constraint bag+from further out in the ArrowCtxt that we push inwards.+-}++data ArrowCtxt   -- Note [Escaping the arrow scope]+  = NoArrowCtxt+  | ArrowCtxt LocalRdrEnv (TcRef WantedConstraints)+++---------------------------+-- TcTyThing+---------------------------++-- | A typecheckable thing available in a local context.  Could be+-- 'AGlobal' 'TyThing', but also lexically scoped variables, etc.+-- See 'TcEnv' for how to retrieve a 'TyThing' given a 'Name'.+data TcTyThing+  = AGlobal TyThing             -- Used only in the return type of a lookup++  | ATcId           -- Ids defined in this module; may not be fully zonked+      { tct_id   :: TcId+      , tct_info :: IdBindingInfo   -- See Note [Meaning of IdBindingInfo]+      }++  | ATyVar  Name TcTyVar   -- See Note [Type variables in the type environment]++  | ATcTyCon TyCon   -- Used temporarily, during kind checking, for the+                     -- tycons and clases in this recursive group+                     -- The TyCon is always a TcTyCon.  Its kind+                     -- can be a mono-kind or a poly-kind; in TcTyClsDcls see+                     -- Note [Type checking recursive type and class declarations]++  | APromotionErr PromotionErr++data PromotionErr+  = TyConPE          -- TyCon used in a kind before we are ready+                     --     data T :: T -> * where ...+  | ClassPE          -- Ditto Class++  | FamDataConPE     -- Data constructor for a data family+                     -- See Note [AFamDataCon: not promoting data family constructors]+                     -- in TcEnv.+  | ConstrainedDataConPE PredType+                     -- Data constructor with a non-equality context+                     -- See Note [Don't promote data constructors with+                     --           non-equality contexts] in TcHsType+  | PatSynPE         -- Pattern synonyms+                     -- See Note [Don't promote pattern synonyms] in TcEnv++  | RecDataConPE     -- Data constructor in a recursive loop+                     -- See Note [Recursion and promoting data constructors] in TcTyClsDecls+  | NoDataKindsTC    -- -XDataKinds not enabled (for a tycon)+  | NoDataKindsDC    -- -XDataKinds not enabled (for a datacon)++instance Outputable TcTyThing where     -- Debugging only+   ppr (AGlobal g)      = ppr g+   ppr elt@(ATcId {})   = text "Identifier" <>+                          brackets (ppr (tct_id elt) <> dcolon+                                 <> ppr (varType (tct_id elt)) <> comma+                                 <+> ppr (tct_info elt))+   ppr (ATyVar n tv)    = text "Type variable" <+> quotes (ppr n) <+> equals <+> ppr tv+                            <+> dcolon <+> ppr (varType tv)+   ppr (ATcTyCon tc)    = text "ATcTyCon" <+> ppr tc <+> dcolon <+> ppr (tyConKind tc)+   ppr (APromotionErr err) = text "APromotionErr" <+> ppr err++-- | IdBindingInfo describes how an Id is bound.+--+-- It is used for the following purposes:+-- a) for static forms in TcExpr.checkClosedInStaticForm and+-- b) to figure out when a nested binding can be generalised,+--    in TcBinds.decideGeneralisationPlan.+--+data IdBindingInfo -- See Note [Meaning of IdBindingInfo and ClosedTypeId]+    = NotLetBound+    | ClosedLet+    | NonClosedLet+         RhsNames        -- Used for (static e) checks only+         ClosedTypeId    -- Used for generalisation checks+                         -- and for (static e) checks++-- | IsGroupClosed describes a group of mutually-recursive bindings+data IsGroupClosed+  = IsGroupClosed+      (NameEnv RhsNames)  -- Free var info for the RHS of each binding in the goup+                          -- Used only for (static e) checks++      ClosedTypeId        -- True <=> all the free vars of the group are+                          --          imported or ClosedLet or+                          --          NonClosedLet with ClosedTypeId=True.+                          --          In particular, no tyvars, no NotLetBound++type RhsNames = NameSet   -- Names of variables, mentioned on the RHS of+                          -- a definition, that are not Global or ClosedLet++type ClosedTypeId = Bool+  -- See Note [Meaning of IdBindingInfo and ClosedTypeId]++{- Note [Meaning of IdBindingInfo]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+NotLetBound means that+  the Id is not let-bound (e.g. it is bound in a+  lambda-abstraction or in a case pattern)++ClosedLet means that+   - The Id is let-bound,+   - Any free term variables are also Global or ClosedLet+   - Its type has no free variables (NB: a top-level binding subject+     to the MR might have free vars in its type)+   These ClosedLets can definitely be floated to top level; and we+   may need to do so for static forms.++   Property:   ClosedLet+             is equivalent to+               NonClosedLet emptyNameSet True++(NonClosedLet (fvs::RhsNames) (cl::ClosedTypeId)) means that+   - The Id is let-bound++   - The fvs::RhsNames contains the free names of the RHS,+     excluding Global and ClosedLet ones.++   - For the ClosedTypeId field see Note [Bindings with closed types]++For (static e) to be valid, we need for every 'x' free in 'e',+that x's binding is floatable to the top level.  Specifically:+   * x's RhsNames must be empty+   * x's type has no free variables+See Note [Grand plan for static forms] in StaticPtrTable.hs.+This test is made in TcExpr.checkClosedInStaticForm.+Actually knowing x's RhsNames (rather than just its emptiness+or otherwise) is just so we can produce better error messages++Note [Bindings with closed types: ClosedTypeId]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider++  f x = let g ys = map not ys+        in ...++Can we generalise 'g' under the OutsideIn algorithm?  Yes,+because all g's free variables are top-level; that is they themselves+have no free type variables, and it is the type variables in the+environment that makes things tricky for OutsideIn generalisation.++Here's the invariant:+   If an Id has ClosedTypeId=True (in its IdBindingInfo), then+   the Id's type is /definitely/ closed (has no free type variables).+   Specifically,+       a) The Id's acutal type is closed (has no free tyvars)+       b) Either the Id has a (closed) user-supplied type signature+          or all its free variables are Global/ClosedLet+             or NonClosedLet with ClosedTypeId=True.+          In particular, none are NotLetBound.++Why is (b) needed?   Consider+    \x. (x :: Int, let y = x+1 in ...)+Initially x::alpha.  If we happen to typecheck the 'let' before the+(x::Int), y's type will have a free tyvar; but if the other way round+it won't.  So we treat any let-bound variable with a free+non-let-bound variable as not ClosedTypeId, regardless of what the+free vars of its type actually are.++But if it has a signature, all is well:+   \x. ...(let { y::Int; y = x+1 } in+           let { v = y+2 } in ...)...+Here the signature on 'v' makes 'y' a ClosedTypeId, so we can+generalise 'v'.++Note that:++  * A top-level binding may not have ClosedTypeId=True, if it suffers+    from the MR++  * A nested binding may be closed (eg 'g' in the example we started+    with). Indeed, that's the point; whether a function is defined at+    top level or nested is orthogonal to the question of whether or+    not it is closed.++  * A binding may be non-closed because it mentions a lexically scoped+    *type variable*  Eg+        f :: forall a. blah+        f x = let g y = ...(y::a)...++Under OutsideIn we are free to generalise an Id all of whose free+variables have ClosedTypeId=True (or imported).  This is an extension+compared to the JFP paper on OutsideIn, which used "top-level" as a+proxy for "closed".  (It's not a good proxy anyway -- the MR can make+a top-level binding with a free type variable.)++Note [Type variables in the type environment]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The type environment has a binding for each lexically-scoped+type variable that is in scope.  For example++  f :: forall a. a -> a+  f x = (x :: a)++  g1 :: [a] -> a+  g1 (ys :: [b]) = head ys :: b++  g2 :: [Int] -> Int+  g2 (ys :: [c]) = head ys :: c++* The forall'd variable 'a' in the signature scopes over f's RHS.++* The pattern-bound type variable 'b' in 'g1' scopes over g1's+  RHS; note that it is bound to a skolem 'a' which is not itself+  lexically in scope.++* The pattern-bound type variable 'c' in 'g2' is bound to+  Int; that is, pattern-bound type variables can stand for+  arbitrary types. (see+    GHC proposal #128 "Allow ScopedTypeVariables to refer to types"+    https://github.com/ghc-proposals/ghc-proposals/pull/128,+  and the paper+    "Type variables in patterns", Haskell Symposium 2018.+++This is implemented by the constructor+   ATyVar Name TcTyVar+in the type environment.++* The Name is the name of the original, lexically scoped type+  variable++* The TcTyVar is sometimes a skolem (like in 'f'), and sometimes+  a unification variable (like in 'g1', 'g2').  We never zonk the+  type environment so in the latter case it always stays as a+  unification variable, although that variable may be later+  unified with a type (such as Int in 'g2').+-}++instance Outputable IdBindingInfo where+  ppr NotLetBound = text "NotLetBound"+  ppr ClosedLet = text "TopLevelLet"+  ppr (NonClosedLet fvs closed_type) =+    text "TopLevelLet" <+> ppr fvs <+> ppr closed_type++instance Outputable PromotionErr where+  ppr ClassPE                     = text "ClassPE"+  ppr TyConPE                     = text "TyConPE"+  ppr PatSynPE                    = text "PatSynPE"+  ppr FamDataConPE                = text "FamDataConPE"+  ppr (ConstrainedDataConPE pred) = text "ConstrainedDataConPE"+                                      <+> parens (ppr pred)+  ppr RecDataConPE                = text "RecDataConPE"+  ppr NoDataKindsTC               = text "NoDataKindsTC"+  ppr NoDataKindsDC               = text "NoDataKindsDC"++pprTcTyThingCategory :: TcTyThing -> SDoc+pprTcTyThingCategory (AGlobal thing)    = pprTyThingCategory thing+pprTcTyThingCategory (ATyVar {})        = text "Type variable"+pprTcTyThingCategory (ATcId {})         = text "Local identifier"+pprTcTyThingCategory (ATcTyCon {})     = text "Local tycon"+pprTcTyThingCategory (APromotionErr pe) = pprPECategory pe++pprPECategory :: PromotionErr -> SDoc+pprPECategory ClassPE                = text "Class"+pprPECategory TyConPE                = text "Type constructor"+pprPECategory PatSynPE               = text "Pattern synonym"+pprPECategory FamDataConPE           = text "Data constructor"+pprPECategory ConstrainedDataConPE{} = text "Data constructor"+pprPECategory RecDataConPE           = text "Data constructor"+pprPECategory NoDataKindsTC          = text "Type constructor"+pprPECategory NoDataKindsDC          = text "Data constructor"++{-+************************************************************************+*                                                                      *+        Operations over ImportAvails+*                                                                      *+************************************************************************+-}++-- | 'ImportAvails' summarises what was imported from where, irrespective of+-- whether the imported things are actually used or not.  It is used:+--+--  * when processing the export list,+--+--  * when constructing usage info for the interface file,+--+--  * to identify the list of directly imported modules for initialisation+--    purposes and for optimised overlap checking of family instances,+--+--  * when figuring out what things are really unused+--+data ImportAvails+   = ImportAvails {+        imp_mods :: ImportedMods,+          --      = ModuleEnv [ImportedModsVal],+          -- ^ Domain is all directly-imported modules+          --+          -- See the documentation on ImportedModsVal in HscTypes for the+          -- meaning of the fields.+          --+          -- We need a full ModuleEnv rather than a ModuleNameEnv here,+          -- because we might be importing modules of the same name from+          -- different packages. (currently not the case, but might be in the+          -- future).++        imp_dep_mods :: ModuleNameEnv (ModuleName, IsBootInterface),+          -- ^ Home-package modules needed by the module being compiled+          --+          -- It doesn't matter whether any of these dependencies+          -- are actually /used/ when compiling the module; they+          -- are listed if they are below it at all.  For+          -- example, suppose M imports A which imports X.  Then+          -- compiling M might not need to consult X.hi, but X+          -- is still listed in M's dependencies.++        imp_dep_pkgs :: Set InstalledUnitId,+          -- ^ Packages needed by the module being compiled, whether directly,+          -- or via other modules in this package, or via modules imported+          -- from other packages.++        imp_trust_pkgs :: Set InstalledUnitId,+          -- ^ This is strictly a subset of imp_dep_pkgs and records the+          -- packages the current module needs to trust for Safe Haskell+          -- compilation to succeed. A package is required to be trusted if+          -- we are dependent on a trustworthy module in that package.+          -- While perhaps making imp_dep_pkgs a tuple of (UnitId, Bool)+          -- where True for the bool indicates the package is required to be+          -- trusted is the more logical  design, doing so complicates a lot+          -- of code not concerned with Safe Haskell.+          -- See Note [RnNames . Tracking Trust Transitively]++        imp_trust_own_pkg :: Bool,+          -- ^ Do we require that our own package is trusted?+          -- This is to handle efficiently the case where a Safe module imports+          -- a Trustworthy module that resides in the same package as it.+          -- See Note [RnNames . Trust Own Package]++        imp_orphs :: [Module],+          -- ^ Orphan modules below us in the import tree (and maybe including+          -- us for imported modules)++        imp_finsts :: [Module]+          -- ^ Family instance modules below us in the import tree (and maybe+          -- including us for imported modules)+      }++mkModDeps :: [(ModuleName, IsBootInterface)]+          -> ModuleNameEnv (ModuleName, IsBootInterface)+mkModDeps deps = foldl' add emptyUFM deps+               where+                 add env elt@(m,_) = addToUFM env m elt++modDepsElts+  :: ModuleNameEnv (ModuleName, IsBootInterface)+  -> [(ModuleName, IsBootInterface)]+modDepsElts = sort . nonDetEltsUFM+  -- It's OK to use nonDetEltsUFM here because sorting by module names+  -- restores determinism++emptyImportAvails :: ImportAvails+emptyImportAvails = ImportAvails { imp_mods          = emptyModuleEnv,+                                   imp_dep_mods      = emptyUFM,+                                   imp_dep_pkgs      = S.empty,+                                   imp_trust_pkgs    = S.empty,+                                   imp_trust_own_pkg = False,+                                   imp_orphs         = [],+                                   imp_finsts        = [] }++-- | Union two ImportAvails+--+-- This function is a key part of Import handling, basically+-- for each import we create a separate ImportAvails structure+-- and then union them all together with this function.+plusImportAvails ::  ImportAvails ->  ImportAvails ->  ImportAvails+plusImportAvails+  (ImportAvails { imp_mods = mods1,+                  imp_dep_mods = dmods1, imp_dep_pkgs = dpkgs1,+                  imp_trust_pkgs = tpkgs1, imp_trust_own_pkg = tself1,+                  imp_orphs = orphs1, imp_finsts = finsts1 })+  (ImportAvails { imp_mods = mods2,+                  imp_dep_mods = dmods2, imp_dep_pkgs = dpkgs2,+                  imp_trust_pkgs = tpkgs2, imp_trust_own_pkg = tself2,+                  imp_orphs = orphs2, imp_finsts = finsts2 })+  = ImportAvails { imp_mods          = plusModuleEnv_C (++) mods1 mods2,+                   imp_dep_mods      = plusUFM_C plus_mod_dep dmods1 dmods2,+                   imp_dep_pkgs      = dpkgs1 `S.union` dpkgs2,+                   imp_trust_pkgs    = tpkgs1 `S.union` tpkgs2,+                   imp_trust_own_pkg = tself1 || tself2,+                   imp_orphs         = orphs1 `unionLists` orphs2,+                   imp_finsts        = finsts1 `unionLists` finsts2 }+  where+    plus_mod_dep r1@(m1, boot1) r2@(m2, boot2)+      | ASSERT2( m1 == m2, (ppr m1 <+> ppr m2) $$ (ppr boot1 <+> ppr boot2) )+        boot1 = r2+      | otherwise = r1+      -- If either side can "see" a non-hi-boot interface, use that+      -- Reusing existing tuples saves 10% of allocations on test+      -- perf/compiler/MultiLayerModules++{-+************************************************************************+*                                                                      *+\subsection{Where from}+*                                                                      *+************************************************************************++The @WhereFrom@ type controls where the renamer looks for an interface file+-}++data WhereFrom+  = ImportByUser IsBootInterface        -- Ordinary user import (perhaps {-# SOURCE #-})+  | ImportBySystem                      -- Non user import.+  | ImportByPlugin                      -- Importing a plugin;+                                        -- See Note [Care with plugin imports] in LoadIface++instance Outputable WhereFrom where+  ppr (ImportByUser is_boot) | is_boot     = text "{- SOURCE -}"+                             | otherwise   = empty+  ppr ImportBySystem                       = text "{- SYSTEM -}"+  ppr ImportByPlugin                       = text "{- PLUGIN -}"+++{- *********************************************************************+*                                                                      *+                Type signatures+*                                                                      *+********************************************************************* -}++-- These data types need to be here only because+-- TcSimplify uses them, and TcSimplify is fairly+-- low down in the module hierarchy++type TcSigFun  = Name -> Maybe TcSigInfo++data TcSigInfo = TcIdSig     TcIdSigInfo+               | TcPatSynSig TcPatSynInfo++data TcIdSigInfo   -- See Note [Complete and partial type signatures]+  = CompleteSig    -- A complete signature with no wildcards,+                   -- so the complete polymorphic type is known.+      { sig_bndr :: TcId          -- The polymorphic Id with that type++      , sig_ctxt :: UserTypeCtxt  -- In the case of type-class default methods,+                                  -- the Name in the FunSigCtxt is not the same+                                  -- as the TcId; the former is 'op', while the+                                  -- latter is '$dmop' or some such++      , sig_loc  :: SrcSpan       -- Location of the type signature+      }++  | PartialSig     -- A partial type signature (i.e. includes one or more+                   -- wildcards). In this case it doesn't make sense to give+                   -- the polymorphic Id, because we are going to /infer/ its+                   -- type, so we can't make the polymorphic Id ab-initio+      { psig_name  :: Name   -- Name of the function; used when report wildcards+      , psig_hs_ty :: LHsSigWcType GhcRn  -- The original partial signature in+                                          -- HsSyn form+      , sig_ctxt   :: UserTypeCtxt+      , sig_loc    :: SrcSpan            -- Location of the type signature+      }+++{- Note [Complete and partial type signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+A type signature is partial when it contains one or more wildcards+(= type holes).  The wildcard can either be:+* A (type) wildcard occurring in sig_theta or sig_tau. These are+  stored in sig_wcs.+      f :: Bool -> _+      g :: Eq _a => _a -> _a -> Bool+* Or an extra-constraints wildcard, stored in sig_cts:+      h :: (Num a, _) => a -> a++A type signature is a complete type signature when there are no+wildcards in the type signature, i.e. iff sig_wcs is empty and+sig_extra_cts is Nothing.+-}++data TcIdSigInst+  = TISI { sig_inst_sig :: TcIdSigInfo++         , sig_inst_skols :: [(Name, TcTyVar)]+               -- Instantiated type and kind variables, TyVarTvs+               -- The Name is the Name that the renamer chose;+               --   but the TcTyVar may come from instantiating+               --   the type and hence have a different unique.+               -- No need to keep track of whether they are truly lexically+               --   scoped because the renamer has named them uniquely+               -- See Note [Binding scoped type variables] in TcSigs+               --+               -- NB: The order of sig_inst_skols is irrelevant+               --     for a CompleteSig, but for a PartialSig see+               --     Note [Quantified varaibles in partial type signatures]++         , sig_inst_theta  :: TcThetaType+               -- Instantiated theta.  In the case of a+               -- PartialSig, sig_theta does not include+               -- the extra-constraints wildcard++         , sig_inst_tau :: TcSigmaType   -- Instantiated tau+               -- See Note [sig_inst_tau may be polymorphic]++         -- Relevant for partial signature only+         , sig_inst_wcs   :: [(Name, TcTyVar)]+               -- Like sig_inst_skols, but for /named/ wildcards (_a etc).+               -- The named wildcards scope over the binding, and hence+               -- their Names may appear in type signatures in the binding++         , sig_inst_wcx   :: Maybe TcType+               -- Extra-constraints wildcard to fill in, if any+               -- If this exists, it is surely of the form (meta_tv |> co)+               -- (where the co might be reflexive). This is filled in+               -- only from the return value of TcHsType.tcAnonWildCardOcc+         }++{- Note [sig_inst_tau may be polymorphic]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Note that "sig_inst_tau" might actually be a polymorphic type,+if the original function had a signature like+   forall a. Eq a => forall b. Ord b => ....+But that's ok: tcMatchesFun (called by tcRhs) can deal with that+It happens, too!  See Note [Polymorphic methods] in TcClassDcl.++Note [Quantified varaibles in partial type signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider+   f :: forall a b. _ -> a -> _ -> b+   f (x,y) p q = q++Then we expect f's final type to be+  f :: forall {x,y}. forall a b. (x,y) -> a -> b -> b++Note that x,y are Inferred, and can't be use for visible type+application (VTA).  But a,b are Specified, and remain Specified+in the final type, so we can use VTA for them.  (Exception: if+it turns out that a's kind mentions b we need to reorder them+with scopedSort.)++The sig_inst_skols of the TISI from a partial signature records+that original order, and is used to get the variables of f's+final type in the correct order.+++Note [Wildcards in partial signatures]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+The wildcards in psig_wcs may stand for a type mentioning+the universally-quantified tyvars of psig_ty++E.g.  f :: forall a. _ -> a+      f x = x+We get sig_inst_skols = [a]+       sig_inst_tau   = _22 -> a+       sig_inst_wcs   = [_22]+and _22 in the end is unified with the type 'a'++Moreover the kind of a wildcard in sig_inst_wcs may mention+the universally-quantified tyvars sig_inst_skols+e.g.   f :: t a -> t _+Here we get+   sig_inst_skols = [k:*, (t::k ->*), (a::k)]+   sig_inst_tau   = t a -> t _22+   sig_inst_wcs   = [ _22::k ]+-}++data TcPatSynInfo+  = TPSI {+        patsig_name           :: Name,+        patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Inferred) and+                                                -- implicitly-bound type vars (Specified)+          -- See Note [The pattern-synonym signature splitting rule] in TcPatSyn+        patsig_univ_bndrs     :: [TyVar],       -- Bound by explicit user forall+        patsig_req            :: TcThetaType,+        patsig_ex_bndrs       :: [TyVar],       -- Bound by explicit user forall+        patsig_prov           :: TcThetaType,+        patsig_body_ty        :: TcSigmaType+    }++instance Outputable TcSigInfo where+  ppr (TcIdSig     idsi) = ppr idsi+  ppr (TcPatSynSig tpsi) = text "TcPatSynInfo" <+> ppr tpsi++instance Outputable TcIdSigInfo where+    ppr (CompleteSig { sig_bndr = bndr })+        = ppr bndr <+> dcolon <+> ppr (idType bndr)+    ppr (PartialSig { psig_name = name, psig_hs_ty = hs_ty })+        = text "psig" <+> ppr name <+> dcolon <+> ppr hs_ty++instance Outputable TcIdSigInst where+    ppr (TISI { sig_inst_sig = sig, sig_inst_skols = skols+              , sig_inst_theta = theta, sig_inst_tau = tau })+        = hang (ppr sig) 2 (vcat [ ppr skols, ppr theta <+> darrow <+> ppr tau ])++instance Outputable TcPatSynInfo where+    ppr (TPSI{ patsig_name = name}) = ppr name++isPartialSig :: TcIdSigInst -> Bool+isPartialSig (TISI { sig_inst_sig = PartialSig {} }) = True+isPartialSig _                                       = False++-- | No signature or a partial signature+hasCompleteSig :: TcSigFun -> Name -> Bool+hasCompleteSig sig_fn name+  = case sig_fn name of+      Just (TcIdSig (CompleteSig {})) -> True+      _                               -> False+  {- Constraint Solver Plugins