Remove NoGhcTc from most places (#18758)

24 files changed, 359 insertions, 173 deletions

diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 9d3e3dcf39..7798e9c6aa 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -253,7 +253,7 @@ type instance XApp           (GhcPass _) = ApiAnnCO
 
 type instance XAppTypeE      GhcPs = SrcSpan -- Where the `@` lives
 type instance XAppTypeE      GhcRn = NoExtField
-type instance XAppTypeE      GhcTc = Type
+type instance XAppTypeE      GhcTc = NoExtField
 
 -- OpApp not present in GhcTc pass; see GHC.Rename.Expr
 -- Note [Handling overloaded and rebindable constructs]
@@ -661,7 +661,7 @@ ppr_infix_expr _ = Nothing
 
 ppr_apps :: (OutputableBndrId p)
          => HsExpr (GhcPass p)
-         -> [Either (LHsExpr (GhcPass p)) (LHsWcType (NoGhcTc (GhcPass p)))]
+         -> [Either (LHsExpr (GhcPass p)) (LHsWcType (GhcPass p))]
          -> SDoc
 ppr_apps (HsApp _ (L _ fun) arg)        args
   = ppr_apps fun (Left arg : args)
diff --git a/compiler/GHC/Hs/Instances.hs b/compiler/GHC/Hs/Instances.hs
index 68b55196ca..ee45252f96 100644
--- a/compiler/GHC/Hs/Instances.hs
+++ b/compiler/GHC/Hs/Instances.hs
@@ -475,6 +475,8 @@ deriving instance Data (HsType GhcPs)
 deriving instance Data (HsType GhcRn)
 deriving instance Data (HsType GhcTc)
 
+deriving instance Data HsTypeTc
+
 -- deriving instance (DataIdLR p p) => Data (HsArrow p)
 deriving instance Data (HsArrow GhcPs)
 deriving instance Data (HsArrow GhcRn)
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index c5cd2ccb78..e13eae4c50 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -145,7 +145,7 @@ type instance XNPlusKPat GhcTc = Type
 
 type instance XSigPat GhcPs = ApiAnn
 type instance XSigPat GhcRn = NoExtField
-type instance XSigPat GhcTc = Type
+type instance XSigPat GhcTc = NoExtField
 
 type instance XXPat GhcPs = NoExtCon
 type instance XXPat GhcRn = NoExtCon
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index 59fcaf9fe1..b65c48d1d2 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -24,9 +24,9 @@ module GHC.Hs.Type (
         Mult, HsScaled(..),
         hsMult, hsScaledThing,
         HsArrow(..), arrowToHsType,
-        hsLinear, hsUnrestricted, isUnrestricted,
+        hsLinear, hsUnrestricted, isUnrestricted, hsTypeTc, hsBndrToBndr,
 
-        HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
+        HsType(..), HsTypeTc(..), HsCoreTy, LHsType, HsKind, LHsKind,
         HsForAllTelescope(..), ApiAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr,
         LHsQTyVars(..),
         HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
@@ -101,7 +101,7 @@ import GHC.Types.Id ( Id )
 import GHC.Types.SourceText
 import GHC.Types.Name( Name, NamedThing(getName) )
 import GHC.Types.Name.Reader ( RdrName )
-import GHC.Types.Var ( VarBndr )
+import GHC.Types.Var ( VarBndr(..) )
 import GHC.Core.TyCo.Rep ( Type(..) )
 import GHC.Builtin.Types( manyDataConName, oneDataConName, mkTupleStr )
 import GHC.Core.Type
@@ -190,7 +190,7 @@ type instance XHsOuterImplicit GhcTc = [TyVar]
 
 type instance XHsOuterExplicit GhcPs _    = ApiAnnForallTy
 type instance XHsOuterExplicit GhcRn _    = NoExtField
-type instance XHsOuterExplicit GhcTc flag = [VarBndr TyVar flag]
+type instance XHsOuterExplicit GhcTc _    = NoExtField
 
 type instance XXHsOuterTyVarBndrs (GhcPass _) = NoExtCon
 
@@ -221,7 +221,7 @@ hsOuterTyVarNames (HsOuterImplicit{hso_ximplicit = imp_tvs}) = imp_tvs
 hsOuterTyVarNames (HsOuterExplicit{hso_bndrs = bndrs})       = hsLTyVarNames bndrs
 
 hsOuterExplicitBndrs :: HsOuterTyVarBndrs flag (GhcPass p)
-                     -> [LHsTyVarBndr flag (NoGhcTc (GhcPass p))]
+                     -> [LHsTyVarBndr flag (GhcPass p)]
 hsOuterExplicitBndrs (HsOuterExplicit{hso_bndrs = bndrs}) = bndrs
 hsOuterExplicitBndrs (HsOuterImplicit{})                  = []
 
@@ -283,47 +283,83 @@ instance NamedThing (HsTyVarBndr flag GhcRn) where
   getName (UserTyVar _ _ v) = unLoc v
   getName (KindedTyVar _ _ v _) = unLoc v
 
-type instance XForAllTy        (GhcPass _) = NoExtField
-type instance XQualTy          (GhcPass _) = NoExtField
-type instance XTyVar           (GhcPass _) = ApiAnn
-type instance XAppTy           (GhcPass _) = NoExtField
-type instance XFunTy           (GhcPass _) = ApiAnn' TrailingAnn -- For the AnnRarrow or AnnLolly
-type instance XListTy          (GhcPass _) = ApiAnn' AnnParen
-type instance XTupleTy         (GhcPass _) = ApiAnn' AnnParen
-type instance XSumTy           (GhcPass _) = ApiAnn' AnnParen
-type instance XOpTy            (GhcPass _) = NoExtField
-type instance XParTy           (GhcPass _) = ApiAnn' AnnParen
-type instance XIParamTy        (GhcPass _) = ApiAnn
-type instance XStarTy          (GhcPass _) = NoExtField
-type instance XKindSig         (GhcPass _) = ApiAnn
-
-type instance XAppKindTy       (GhcPass _) = SrcSpan -- Where the `@` lives
+type instance XForAllTy        GhcPs = NoExtField
+type instance XForAllTy        GhcRn = NoExtField
+type instance XForAllTy        GhcTc = NoExtCon
+type instance XQualTy          GhcPs = NoExtField
+type instance XQualTy          GhcRn = NoExtField
+type instance XQualTy          GhcTc = NoExtCon
+type instance XTyVar           GhcPs = ApiAnn
+type instance XTyVar           GhcRn = ApiAnn
+type instance XTyVar           GhcTc = NoExtCon
+type instance XAppTy           GhcPs = NoExtField
+type instance XAppTy           GhcRn = NoExtField
+type instance XAppTy           GhcTc = NoExtCon
+type instance XFunTy           GhcPs = ApiAnn' TrailingAnn -- For the AnnRarrow or AnnLolly
+type instance XFunTy           GhcRn = ApiAnn' TrailingAnn
+type instance XFunTy           GhcTc = NoExtCon
+type instance XListTy          GhcPs = ApiAnn' AnnParen
+type instance XListTy          GhcRn = ApiAnn' AnnParen
+type instance XListTy          GhcTc = NoExtCon
+type instance XTupleTy         GhcPs = ApiAnn' AnnParen
+type instance XTupleTy         GhcRn = ApiAnn' AnnParen
+type instance XTupleTy         GhcTc = NoExtCon
+type instance XSumTy           GhcPs = ApiAnn' AnnParen
+type instance XSumTy           GhcRn = ApiAnn' AnnParen
+type instance XSumTy           GhcTc = NoExtCon
+type instance XOpTy            GhcPs = NoExtField
+type instance XOpTy            GhcRn = NoExtField
+type instance XOpTy            GhcTc = NoExtCon
+type instance XParTy           GhcPs = ApiAnn' AnnParen
+type instance XParTy           GhcRn = ApiAnn' AnnParen
+type instance XParTy           GhcTc = NoExtCon
+type instance XIParamTy        GhcPs = ApiAnn
+type instance XIParamTy        GhcRn = ApiAnn
+type instance XIParamTy        GhcTc = NoExtCon
+type instance XStarTy          GhcPs = NoExtField
+type instance XStarTy          GhcRn = NoExtField
+type instance XStarTy          GhcTc = NoExtCon
+type instance XKindSig         GhcPs = ApiAnn
+type instance XKindSig         GhcRn = ApiAnn
+type instance XKindSig         GhcTc = NoExtCon
+
+type instance XAppKindTy       GhcPs = SrcSpan -- Where the `@` lives
+type instance XAppKindTy       GhcRn = SrcSpan
+type instance XAppKindTy       GhcTc = NoExtCon
 
 type instance XSpliceTy        GhcPs = NoExtField
 type instance XSpliceTy        GhcRn = NoExtField
-type instance XSpliceTy        GhcTc = Kind
-
-type instance XDocTy           (GhcPass _) = ApiAnn
-type instance XBangTy          (GhcPass _) = ApiAnn
-
+type instance XSpliceTy        GhcTc = NoExtCon
+
+type instance XDocTy           GhcPs = ApiAnn
+type instance XDocTy           GhcRn = ApiAnn
+type instance XDocTy           GhcTc = NoExtCon
+type instance XBangTy          GhcPs = ApiAnn
+type instance XBangTy          GhcRn = ApiAnn
+type instance XBangTy          GhcTc = NoExtCon
 type instance XRecTy           GhcPs = ApiAnn' AnnList
 type instance XRecTy           GhcRn = NoExtField
-type instance XRecTy           GhcTc = NoExtField
+type instance XRecTy           GhcTc = NoExtCon
 
 type instance XExplicitListTy  GhcPs = ApiAnn
 type instance XExplicitListTy  GhcRn = NoExtField
-type instance XExplicitListTy  GhcTc = Kind
+type instance XExplicitListTy  GhcTc = NoExtCon
 
 type instance XExplicitTupleTy GhcPs = ApiAnn
 type instance XExplicitTupleTy GhcRn = NoExtField
-type instance XExplicitTupleTy GhcTc = [Kind]
-
-type instance XTyLit           (GhcPass _) = NoExtField
+type instance XExplicitTupleTy GhcTc = NoExtCon
 
-type instance XWildCardTy      (GhcPass _) = NoExtField
+type instance XTyLit           GhcPs = NoExtField
+type instance XTyLit           GhcRn = NoExtField
+type instance XTyLit           GhcTc = NoExtCon
 
-type instance XXType         (GhcPass _) = HsCoreTy
+type instance XWildCardTy      GhcPs = NoExtField
+type instance XWildCardTy      GhcRn = NoExtField
+type instance XWildCardTy      GhcTc = NoExtCon
 
+type instance XXType         GhcPs = HsCoreTy
+type instance XXType         GhcRn = HsCoreTy
+type instance XXType         GhcTc = HsTypeTc
 
 oneDataConHsTy :: HsType GhcRn
 oneDataConHsTy = HsTyVar noAnn NotPromoted (noLocA oneDataConName)
@@ -335,6 +371,36 @@ isUnrestricted :: HsArrow GhcRn -> Bool
 isUnrestricted (arrowToHsType -> L _ (HsTyVar _ _ (L _ n))) = n == manyDataConName
 isUnrestricted _ = False
 
+hsTypeTc :: HsType GhcTc -> HsTypeTc
+hsTypeTc t = case t of
+  HsForAllTy v _ _ -> noExtCon v
+  HsQualTy v _ _-> noExtCon v
+  HsTyVar v _ _ -> noExtCon v
+  HsAppTy v _ _ -> noExtCon v
+  HsAppKindTy v _ _ -> noExtCon v
+  HsFunTy v _ _ _ -> noExtCon v
+  HsListTy v _ -> noExtCon v
+  HsTupleTy v _ _ -> noExtCon v
+  HsSumTy v _ -> noExtCon v
+  HsOpTy v _ _ _ -> noExtCon v
+  HsParTy v _ -> noExtCon v
+  HsIParamTy v _ _ -> noExtCon v
+  HsKindSig v _ _ -> noExtCon v
+  HsSpliceTy v _ -> noExtCon v
+  HsDocTy v _ _ -> noExtCon v
+  HsBangTy v _ _ -> noExtCon v
+  HsRecTy v _ -> noExtCon v
+  HsExplicitListTy v _ _ -> noExtCon v
+  HsExplicitTupleTy v _ -> noExtCon v
+  HsTyLit v _ -> noExtCon v
+  HsWildCardTy v -> noExtCon v
+  HsStarTy v _ -> noExtCon v
+  XHsType t -> t
+
+hsBndrToBndr :: HsTyVarBndr flag GhcTc -> VarBndr TyVar flag
+hsBndrToBndr (UserTyVar _ flag v) = Bndr (unLoc v) flag
+hsBndrToBndr (KindedTyVar _ flag v _) = Bndr (unLoc v) flag
+
 -- | Convert an arrow into its corresponding multiplicity. In essence this
 -- erases the information of whether the programmer wrote an explicit
 -- multiplicity or a shorthand.
@@ -441,16 +507,16 @@ ignoreParens ty                   = ty
 mkAnonWildCardTy :: HsType GhcPs
 mkAnonWildCardTy = HsWildCardTy noExtField
 
-mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN)
+mkHsOpTy :: (Anno (IdGhcP p) ~ SrcSpanAnnN, XOpTy (GhcPass p) ~ NoExtField)
          => LHsType (GhcPass p) -> LocatedN (IdP (GhcPass p))
          -> LHsType (GhcPass p) -> HsType (GhcPass p)
 mkHsOpTy ty1 op ty2 = HsOpTy noExtField ty1 op ty2
 
-mkHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+mkHsAppTy :: (XAppTy (GhcPass p) ~ NoExtField, XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsPass p) => LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 mkHsAppTy t1 t2
   = addCLocAA t1 t2 (HsAppTy noExtField t1 (parenthesizeHsType appPrec t2))
 
-mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
+mkHsAppTys :: (XAppTy (GhcPass p) ~ NoExtField, XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsPass p) => LHsType (GhcPass p) -> [LHsType (GhcPass p)]
            -> LHsType (GhcPass p)
 mkHsAppTys = foldl' mkHsAppTy
 
@@ -472,8 +538,11 @@ mkHsAppKindTy ext ty k
 -- Breaks up any parens in the result type:
 --      splitHsFunType (a -> (b -> c)) = ([a,b], c)
 -- It returns API Annotations for any parens removed
-splitHsFunType ::
-     LHsType (GhcPass p)
+splitHsFunType 
+  :: ( XFunTy (GhcPass p) ~ ApiAnn' TrailingAnn
+     , XParTy (GhcPass p) ~ ApiAnn' AnnParen
+     )
+  => LHsType (GhcPass p)
   -> ( [AddApiAnn], ApiAnnComments -- The locations of any parens and
                                    -- comments discarded
      , [HsScaled (GhcPass p) (LHsType (GhcPass p))], LHsType (GhcPass p))
@@ -532,17 +601,17 @@ lhsTypeArgSrcSpan arg = case arg of
 -- type (parentheses and all) from them.
 splitLHsPatSynTy ::
      LHsSigType (GhcPass p)
-  -> ( [LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))] -- universals
-     , Maybe (LHsContext (GhcPass p))                       -- required constraints
-     , [LHsTyVarBndr Specificity (GhcPass p)]               -- existentials
-     , Maybe (LHsContext (GhcPass p))                       -- provided constraints
-     , LHsType (GhcPass p))                                 -- body type
+  -> ( [LHsTyVarBndr Specificity (GhcPass p)]           -- universals
+     , Maybe (LHsContext (GhcPass p))                   -- required constraints
+     , [LHsTyVarBndr Specificity (GhcPass p)]           -- existentials
+     , Maybe (LHsContext (GhcPass p))                   -- provided constraints
+     , LHsType (GhcPass p))                             -- body type
 splitLHsPatSynTy ty = (univs, reqs, exis, provs, ty4)
   where
     -- split_sig_ty ::
-    --      LHsSigType (GhcPass p)
-    --   -> ([LHsTyVarBndr Specificity (GhcPass (NoGhcTcPass p))], LHsType (GhcPass p))
-    split_sig_ty (L _ HsSig{sig_bndrs = outer_bndrs, sig_body = body}) =
+    --     LHsSigType (GhcPass p)
+    --  -> ([LHsTyVarBndr Specificity (GhcPass p)], LHsType (GhcPass p))
+    split_sig_ty (L _ (HsSig{sig_bndrs = outer_bndrs, sig_body = body})) =
       case outer_bndrs of
         -- NB: Use ignoreParens here in order to be consistent with the use of
         -- splitLHsForAllTyInvis below, which also looks through parentheses.
@@ -1027,7 +1096,7 @@ ppr_mono_lty :: OutputableBndrId p
              => LHsType (GhcPass p) -> SDoc
 ppr_mono_lty ty = ppr_mono_ty (unLoc ty)
 
-ppr_mono_ty :: (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
+ppr_mono_ty :: forall p. (OutputableBndrId p) => HsType (GhcPass p) -> SDoc
 ppr_mono_ty (HsForAllTy { hst_tele = tele, hst_body = ty })
   = sep [pprHsForAll tele Nothing, ppr_mono_lty ty]
 
@@ -1093,7 +1162,13 @@ ppr_mono_ty (HsDocTy _ ty doc)
   -- we pretty print Haddock comments on types as if they were
   -- postfix operators
 
-ppr_mono_ty (XHsType t) = ppr t
+ppr_mono_ty (XHsType thing) =
+  case ghcPass @p of
+    GhcPs -> ppr thing
+    GhcRn -> ppr thing
+    GhcTc -> ppr thing
+    -- otherwise GHC is not convinced that 'XXType (GhcPass p)' has an Outputable
+
 
 --------------------------
 ppr_fun_ty :: (OutputableBndrId p)
@@ -1108,9 +1183,10 @@ ppr_fun_ty mult ty1 ty2
 --------------------------
 -- | @'hsTypeNeedsParens' p t@ returns 'True' if the type @t@ needs parentheses
 -- under precedence @p@.
-hsTypeNeedsParens :: PprPrec -> HsType (GhcPass p) -> Bool
+hsTypeNeedsParens :: IsPass p => PprPrec -> HsType (GhcPass p) -> Bool
 hsTypeNeedsParens p = go_hs_ty
   where
+    go_hs_ty :: forall p. IsPass p => HsType (GhcPass p) -> Bool
     go_hs_ty (HsForAllTy{})           = p >= funPrec
     go_hs_ty (HsQualTy{})             = p >= funPrec
     go_hs_ty (HsBangTy{})             = p > topPrec
@@ -1145,7 +1221,11 @@ hsTypeNeedsParens p = go_hs_ty
     go_hs_ty (HsOpTy{})               = p >= opPrec
     go_hs_ty (HsParTy{})              = False
     go_hs_ty (HsDocTy _ (L _ t) _)    = go_hs_ty t
-    go_hs_ty (XHsType ty)             = go_core_ty ty
+    go_hs_ty (XHsType ty)             =
+      case ghcPass @p of
+        GhcPs -> go_core_ty ty
+        GhcRn -> go_core_ty ty
+        GhcTc -> let (HsTypeTc _ ty') = ty in go_hs_ty ty'
 
     go_core_ty (TyVarTy{})    = False
     go_core_ty (AppTy{})      = p >= appPrec
@@ -1202,7 +1282,7 @@ lhsTypeHasLeadingPromotionQuote ty
 -- | @'parenthesizeHsType' p ty@ checks if @'hsTypeNeedsParens' p ty@ is
 -- true, and if so, surrounds @ty@ with an 'HsParTy'. Otherwise, it simply
 -- returns @ty@.
-parenthesizeHsType :: PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+parenthesizeHsType :: (XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsPass p) => PprPrec -> LHsType (GhcPass p) -> LHsType (GhcPass p)
 parenthesizeHsType p lty@(L loc ty)
   | hsTypeNeedsParens p ty = L loc (HsParTy noAnn lty)
   | otherwise              = lty
@@ -1211,7 +1291,7 @@ parenthesizeHsType p lty@(L loc ty)
 -- @c@ such that @'hsTypeNeedsParens' p c@ is true, and if so, surrounds @c@
 -- with an 'HsParTy' to form a parenthesized @ctxt@. Otherwise, it simply
 -- returns @ctxt@ unchanged.
-parenthesizeHsContext :: PprPrec
+parenthesizeHsContext :: (XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsPass p) => PprPrec
                       -> LHsContext (GhcPass p) -> LHsContext (GhcPass p)
 parenthesizeHsContext p lctxt@(L loc ctxt) =
   case ctxt of
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index 7e298b8978..3a2e886ddf 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -604,18 +604,28 @@ nlHsCase expr matches
   = noLocA (HsCase noAnn expr (mkMatchGroup Generated (noLocA matches)))
 nlList exprs          = noLocA (ExplicitList noAnn exprs)
 
-nlHsAppTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
-nlHsTyVar :: IsSrcSpanAnn p a
+nlHsAppTy :: (XAppTy (GhcPass p) ~ NoExtField, XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsPass p)
+          => LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+nlHsTyVar :: (XTyVar (GhcPass p) ~ ApiAnn, XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsSrcSpanAnn p a)
           => IdP (GhcPass p)                            -> LHsType (GhcPass p)
-nlHsFunTy :: LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
-nlHsParTy :: LHsType (GhcPass p)                        -> LHsType (GhcPass p)
+nlHsFunTy :: (XFunTy (GhcPass p) ~ ApiAnn' TrailingAnn, XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsPass p)
+          => LHsType (GhcPass p) -> LHsType (GhcPass p) -> LHsType (GhcPass p)
+nlHsParTy :: (XParTy (GhcPass p) ~ ApiAnn' AnnParen)
+          => LHsType (GhcPass p)                        -> LHsType (GhcPass p)
 
 nlHsAppTy f t = noLocA (HsAppTy noExtField f (parenthesizeHsType appPrec t))
 nlHsTyVar x   = noLocA (HsTyVar noAnn NotPromoted (noLocA x))
 nlHsFunTy a b = noLocA (HsFunTy noAnn (HsUnrestrictedArrow NormalSyntax) (parenthesizeHsType funPrec a) b)
 nlHsParTy t   = noLocA (HsParTy noAnn t)
 
-nlHsTyConApp :: IsSrcSpanAnn p a
+nlHsTyConApp :: ( IsSrcSpanAnn p a
+                , XAppTy (GhcPass p) ~ NoExtField
+                , XParTy (GhcPass p) ~ ApiAnn' AnnParen
+                , XOpTy  (GhcPass p) ~ NoExtField
+                , XTyVar (GhcPass p) ~ ApiAnn
+                , XAppKindTy (GhcPass p) ~ SrcSpan
+                , IsPass p
+                )
              => LexicalFixity -> IdP (GhcPass p)
              -> [LHsTypeArg (GhcPass p)] -> LHsType (GhcPass p)
 nlHsTyConApp fixity tycon tys
@@ -625,14 +635,19 @@ nlHsTyConApp fixity tycon tys
   | otherwise
   = foldl' mk_app (nlHsTyVar tycon) tys
   where
-    mk_app :: LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
+    mk_app :: ( XAppTy (GhcPass p) ~ NoExtField
+              , XParTy (GhcPass p) ~ ApiAnn' AnnParen
+              , XOpTy  (GhcPass p) ~ NoExtField
+              , XAppKindTy (GhcPass p) ~ SrcSpan
+              , IsPass p
+              ) => LHsType (GhcPass p) -> LHsTypeArg (GhcPass p) -> LHsType (GhcPass p)
     mk_app fun@(L _ (HsOpTy {})) arg = mk_app (noLocA $ HsParTy noAnn fun) arg
       -- parenthesize things like `(A + B) C`
     mk_app fun (HsValArg ty) = noLocA (HsAppTy noExtField fun (parenthesizeHsType appPrec ty))
     mk_app fun (HsTypeArg _ ki) = noLocA (HsAppKindTy noSrcSpan fun (parenthesizeHsType appPrec ki))
     mk_app fun (HsArgPar _) = noLocA (HsParTy noAnn fun)
 
-nlHsAppKindTy ::
+nlHsAppKindTy :: (XAppKindTy (GhcPass p) ~ SrcSpan, XParTy (GhcPass p) ~ ApiAnn' AnnParen, IsPass p) =>
   LHsType (GhcPass p) -> LHsKind (GhcPass p) -> LHsType (GhcPass p)
 nlHsAppKindTy f k
   = noLocA (HsAppKindTy noSrcSpan f (parenthesizeHsType appPrec k))
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index cdbf54889e..f858736cc1 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -1161,7 +1161,7 @@ dsHsWrapped orig_hs_expr
               go (wrap . wrap') hs_e }
     go wrap (HsConLikeOut _ (RealDataCon dc))
       = go_head wrap (dataConWrapId dc)
-    go wrap (HsAppType ty hs_e _) = go_l (wrap . (\e -> App e (Type ty))) hs_e
+    go wrap (HsAppType _ hs_e ty) = go_l (wrap . (\e -> App e . Type . hsttc_type . hsTypeTc . unLoc . hswc_body $ ty)) hs_e
     go wrap (HsPar _ hs_e)        = go_l wrap hs_e
     go wrap (HsVar _ (L _ var))   = go_head wrap var
     go wrap hs_e                  = do { e <- dsExpr hs_e; return (wrap e) }
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 6f894dfc1a..c4685a7f12 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -802,8 +802,8 @@ class ( IsPass p
       , ToHie (Context (Located (IdGhcP p)))
       , ToHie (RFContext (Located (AmbiguousFieldOcc (GhcPass p))))
       , ToHie (RFContext (Located (FieldOcc (GhcPass p))))
-      , ToHie (TScoped (LHsWcType (GhcPass (NoGhcTcPass p))))
-      , ToHie (TScoped (LHsSigWcType (GhcPass (NoGhcTcPass p))))
+      , ToHie (TScoped (LHsWcType (GhcPass p)))
+      , ToHie (TScoped (LHsSigWcType (GhcPass p)))
       , Anno (IdGhcP p) ~ SrcSpanAnnN
       )
       => HiePass p where
@@ -1029,8 +1029,8 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
           HieRn -> []
 #endif
     where
-      contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsPatSigType (NoGhcTc (GhcPass p))) a (HsRecFields (GhcPass p) a)
-                 -> HsConDetails (TScoped (HsPatSigType (NoGhcTc (GhcPass p)))) (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a)))
+      contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsPatSigType (GhcPass p)) a (HsRecFields (GhcPass p) a)
+                 -> HsConDetails (TScoped (HsPatSigType (GhcPass p))) (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a)))
       contextify (PrefixCon tyargs args) = PrefixCon (tScopes scope argscope tyargs) (patScopes rsp scope pscope args)
         where argscope = foldr combineScopes NoScope $ map mkLScopeA args
       contextify (InfixCon a b) = InfixCon a' b'
@@ -1051,6 +1051,12 @@ instance ToHie (TScoped (HsPatSigType GhcRn)) where
       ]
   -- See Note [Scoping Rules for SigPat]
 
+instance ToHie (TScoped (HsPatSigType GhcTc)) where
+  toHie (TS sc (HsPS (HsPSRn wcs tvs) body@(L span _))) = concatM $
+      [ bindingsOnly $ map (C $ TyVarBind (mkScopeA span) sc) (wcs++tvs)
+      , toHie body
+      ]
+
 instance ( ToHie (LocatedA (body (GhcPass p)))
          , HiePass p
          , AnnoBody p body
@@ -1658,6 +1664,13 @@ instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsSigType GhcRn)))) wh
       ]
     where span = loc a
 
+instance ToHie (TScoped (HsWildCardBndrs GhcTc (LocatedA (HsSigType GhcTc)))) where
+  toHie (TS sc (HsWC names a)) = concatM $
+      [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names
+      , toHie $ TS sc a
+      ]
+    where span = loc a
+
 instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsType GhcRn)))) where
   toHie (TS sc (HsWC names a)) = concatM $
       [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names
@@ -1665,6 +1678,13 @@ instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsType GhcRn)))) where
       ]
     where span = loc a
 
+instance ToHie (TScoped (HsWildCardBndrs GhcTc (LocatedA (HsType GhcTc)))) where
+  toHie (TS sc (HsWC names a)) = concatM $
+      [ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names
+      , toHie a
+      ]
+    where span = loc a
+
 instance ToHie (LocatedA (StandaloneKindSig GhcRn)) where
   toHie (L sp sig) = concatM [makeNodeA sig sp, toHie sig]
 
@@ -1727,6 +1747,11 @@ instance ToHie (TScoped (LocatedA (HsSigType GhcRn))) where
       , toHie body
       ]
 
+instance ToHie (TScoped (LocatedA (HsSigType GhcTc))) where
+  toHie (TS _ (L span t@HsSig{sig_body=body})) = concatM $ makeNodeA t span :
+      [ toHie body
+      ]
+
 -- Check this
 instance Data flag => ToHie (TVScoped (HsOuterTyVarBndrs flag GhcRn)) where
   toHie (TVS tsc sc bndrs) = case bndrs of
@@ -1812,6 +1837,9 @@ instance ToHie (LocatedA (HsType GhcRn)) where
       HsStarTy _ _ -> []
       XHsType _ -> []
 
+instance ToHie (LocatedA (HsType GhcTc)) where
+  toHie (L l t) = concatM $ [makeNode t (locA l), toHie (L l (hsttc_rn . hsTypeTc $ t))]
+
 instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where
   toHie (HsValArg tm) = toHie tm
   toHie (HsTypeArg _ ty) = toHie ty
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 27572b2a65..176401db7f 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -231,7 +231,8 @@ tcHsBootSigs binds sigs
       where
         f (L _ name)
           = do { sigma_ty <- tcHsSigWcType (FunSigCtxt name False) hs_ty
-               ; return (mkVanillaGlobal name sigma_ty) }
+               ; let ty = hsttc_type . hsTypeTc . unLoc . sig_body . unLoc . hswc_body $ sigma_ty
+               ; return (mkVanillaGlobal name ty) }
         -- Notice that we make GlobalIds, not LocalIds
     tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s)
 
@@ -1436,7 +1437,7 @@ lookupMBI name
 -------------------
 tcLhsSigId :: LetBndrSpec -> (Name, TcIdSigInfo) -> TcM MonoBindInfo
 tcLhsSigId no_gen (name, sig)
-  = do { inst_sig <- tcInstSig sig
+  = do { inst_sig <- fst <$> tcInstSig sig
        ; mono_id <- newSigLetBndr no_gen name inst_sig
        ; return (MBI { mbi_poly_name = name
                      , mbi_sig       = Just inst_sig
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index ce5b052a94..ac58163e3b 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -236,7 +236,7 @@ tcFImport :: LForeignDecl GhcRn
 tcFImport (L dloc fo@(ForeignImport { fd_name = L nloc nm, fd_sig_ty = hs_ty
                                     , fd_fi = imp_decl }))
   = setSrcSpanA dloc $ addErrCtxt (foreignDeclCtxt fo)  $
-    do { sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
+    do { sig_ty <- hsttc_type . hsTypeTc . unLoc . sig_body . unLoc <$> tcHsSigType (ForSigCtxt nm) hs_ty
        ; (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty
        ; let
            -- Drop the foralls before inspecting the
@@ -384,7 +384,7 @@ tcFExport :: ForeignDecl GhcRn
 tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spec })
   = addErrCtxt (foreignDeclCtxt fo) $ do
 
-    sig_ty <- tcHsSigType (ForSigCtxt nm) hs_ty
+    sig_ty <- hsttc_type . hsTypeTc . unLoc . sig_body . unLoc <$> tcHsSigType (ForSigCtxt nm) hs_ty
     rhs <- tcCheckPolyExpr (nlHsVar nm) sig_ty
 
     (norm_co, norm_sig_ty, gres) <- normaliseFfiType sig_ty
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 2a442b3fd9..e968ebafef 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -289,8 +289,8 @@ rebuildHsApps fun ctxt (arg : args)
   = case arg of
       EValArg { eva_arg = ValArg arg, eva_ctxt = ctxt' }
         -> rebuildHsApps (HsApp noAnn lfun arg) ctxt' args
-      ETypeArg { eva_hs_ty = hs_ty, eva_ty  = ty, eva_ctxt = ctxt' }
-        -> rebuildHsApps (HsAppType ty lfun hs_ty) ctxt' args
+      ETypeArg { eva_hs_ty = (HsWC names (L loc hs_ty)), eva_ty  = ty, eva_ctxt = ctxt' }
+        -> rebuildHsApps (HsAppType noExtField lfun . HsWC names . L loc . XHsType $ HsTypeTc ty hs_ty) ctxt' args
       EPrag ctxt' p
         -> rebuildHsApps (HsPragE noExtField p lfun) ctxt' args
       EWrap (EPar ctxt')
@@ -592,7 +592,9 @@ tcInferAmbiguousRecSelId lbl args mb_res_ty
   , EValArg { eva_arg = ValArg (L _ arg) } <- arg1
   , Just sig_ty <- obviousSig arg  -- A type sig on the arg disambiguates
   = do { sig_tc_ty <- tcHsSigWcType ExprSigCtxt sig_ty
-       ; finish_ambiguous_selector lbl sig_tc_ty }
+
+       ; finish_ambiguous_selector lbl .
+           hsttc_type . hsTypeTc . unLoc . sig_body . unLoc . hswc_body $ sig_tc_ty }
 
   | Just res_ty <- mb_res_ty
   , Just (arg_ty,_) <- tcSplitFunTy_maybe res_ty
@@ -713,33 +715,40 @@ naughtyRecordSel lbl
 *                                                                      *
 ********************************************************************* -}
 
-tcExprWithSig :: LHsExpr GhcRn -> LHsSigWcType (NoGhcTc GhcRn)
+tcExprWithSig :: LHsExpr GhcRn -> LHsSigWcType GhcRn
               -> TcM (HsExpr GhcTc, TcSigmaType)
 tcExprWithSig expr hs_ty
   = do { sig_info <- checkNoErrs $  -- Avoid error cascade
                      tcUserTypeSig loc hs_ty Nothing
-       ; (expr', poly_ty) <- tcExprSig expr sig_info
-       ; return (ExprWithTySig noExtField expr' hs_ty, poly_ty) }
+       ; (expr', poly_ty, sig_ty) <- tcExprSig expr sig_info
+       ; return (ExprWithTySig noExtField expr' sig_ty, poly_ty) }
   where
     loc = getLocA (dropWildCards hs_ty)
 
-tcExprSig :: LHsExpr GhcRn -> TcIdSigInfo -> TcM (LHsExpr GhcTc, TcType)
-tcExprSig expr (CompleteSig { sig_bndr = poly_id, sig_loc = loc })
+tcExprSig :: LHsExpr GhcRn -> (TcIdSigInfo, Maybe (LHsSigWcType GhcTc))
+          -> TcM (LHsExpr GhcTc, TcType, LHsSigWcType GhcTc)
+tcExprSig expr (sig@(CompleteSig { sig_bndr = poly_id, sig_loc = loc }), mty)
   = setSrcSpan loc $   -- Sets the location for the implication constraint
     do { let poly_ty = idType poly_id
+       ; ty <- case mty of
+          Just ty -> return ty
+          Nothing -> pprPanic "Got no HsSigWcType with CompleteSig" (ppr sig)
        ; (wrap, expr') <- tcSkolemiseScoped ExprSigCtxt poly_ty $ \rho_ty ->
                           tcCheckMonoExprNC expr rho_ty
-       ; return (mkLHsWrap wrap expr', poly_ty) }
+       ; return (mkLHsWrap wrap expr', poly_ty, ty) }
 
-tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
+tcExprSig expr (sig@(PartialSig { psig_name = name, sig_loc = loc }), _)
   = setSrcSpan loc $   -- Sets the location for the implication constraint
-    do { (tclvl, wanted, (expr', sig_inst))
+    do { (tclvl, wanted, (expr', sig_inst, mty))
              <- pushLevelAndCaptureConstraints  $
-                do { sig_inst <- tcInstSig sig
+                do { (sig_inst, ty) <- tcInstSig sig
                    ; expr' <- tcExtendNameTyVarEnv (mapSnd binderVar $ sig_inst_skols sig_inst) $
                               tcExtendNameTyVarEnv (sig_inst_wcs   sig_inst) $
                               tcCheckPolyExprNC expr (sig_inst_tau sig_inst)
-                   ; return (expr', sig_inst) }
+                   ; return (expr', sig_inst, ty) }
+       ; ty <- case mty of
+          Just ty -> return ty
+          Nothing -> pprPanic "tcInstSig returned Nothing for PartialSig" (ppr sig)
        -- See Note [Partial expression signatures]
        ; let tau = sig_inst_tau sig_inst
              infer_mode | null (sig_inst_theta sig_inst)
@@ -768,7 +777,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
                          <.> mkWpTyLams qtvs
                          <.> mkWpLams givens
                          <.> mkWpLet  ev_binds
-       ; return (mkLHsWrap poly_wrap expr', my_sigma) }
+       ; return (mkLHsWrap poly_wrap expr', my_sigma, ty) }
 
 
 {- Note [Partial expression signatures]
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index f7ad3a2af6..3814869bbe 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -31,6 +31,7 @@ module GHC.Tc.Gen.HsType (
             bindImplicitTKBndrs_Q_Tv, bindImplicitTKBndrs_Q_Skol,
         bindExplicitTKBndrs_Tv, bindExplicitTKBndrs_Skol,
             bindExplicitTKBndrs_Q_Tv, bindExplicitTKBndrs_Q_Skol,
+        binderVar', binderVars', binderVarWithF,
 
         bindOuterFamEqnTKBndrs, bindOuterFamEqnTKBndrs_Q_Tv,
         tcOuterTKBndrs, scopedSortOuter,
@@ -362,11 +363,13 @@ pprSigCtxt ctxt hs_ty
   = hang (text "In" <+> pprUserTypeCtxt ctxt <> colon)
        2 (ppr hs_ty)
 
-tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM Type
+tcHsSigWcType :: UserTypeCtxt -> LHsSigWcType GhcRn -> TcM (LHsSigWcType GhcTc)
 -- This one is used when we have a LHsSigWcType, but in
 -- a place where wildcards aren't allowed. The renamer has
 -- already checked this, so we can simply ignore it.
-tcHsSigWcType ctxt sig_ty = tcHsSigType ctxt (dropWildCards sig_ty)
+tcHsSigWcType ctxt sig_ty = do
+  sig_ty' <- tcHsSigType ctxt (dropWildCards sig_ty)
+  return $ HsWC (hswc_ext sig_ty) sig_ty'
 
 kcClassSigType :: [LocatedN Name] -> LHsSigType GhcRn -> TcM ()
 -- This is a special form of tcClassSigType that is used during the
@@ -388,7 +391,7 @@ kcClassSigType names
               tcLHsType hs_ty liftedTypeKind
        ; return () }
 
-tcClassSigType :: [LocatedN Name] -> LHsSigType GhcRn -> TcM Type
+tcClassSigType :: [LocatedN Name] -> LHsSigType GhcRn -> TcM (LHsSigType GhcTc)
 -- Does not do validity checking
 tcClassSigType names sig_ty
   = addSigCtxt sig_ctxt sig_ty $
@@ -415,7 +418,7 @@ tcClassSigType names sig_ty
     sig_ctxt = funsSigCtxt names
     skol_info = SigTypeSkol sig_ctxt
 
-tcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM Type
+tcHsSigType :: UserTypeCtxt -> LHsSigType GhcRn -> TcM (LHsSigType GhcTc)
 -- Does validity checking
 -- See Note [Recipe for checking a signature]
 tcHsSigType ctxt sig_ty
@@ -423,22 +426,23 @@ tcHsSigType ctxt sig_ty
     do { traceTc "tcHsSigType {" (ppr sig_ty)
 
           -- Generalise here: see Note [Kind generalisation]
-       ; (implic, ty) <- tc_lhs_sig_type skol_info sig_ty  (expectedKindInCtxt ctxt)
+       ; (implic, sig_ty') <- tc_lhs_sig_type skol_info sig_ty  (expectedKindInCtxt ctxt)
 
        -- Float out constraints, failing fast if not possible
        -- See Note [Failure in local type signatures] in GHC.Tc.Solver
        ; traceTc "tcHsSigType 2" (ppr implic)
        ; simplifyAndEmitFlatConstraints (mkImplicWC (unitBag implic))
 
+       ; let (L l (HsSig ext bndrs (L l' (XHsType (HsTypeTc ty hs_ty))))) = sig_ty'
        ; ty <- zonkTcType ty
        ; checkValidType ctxt ty
        ; traceTc "end tcHsSigType }" (ppr ty)
-       ; return ty }
+       ; return . L l . HsSig ext bndrs . L l' . XHsType $ HsTypeTc ty hs_ty }
   where
     skol_info = SigTypeSkol ctxt
 
 tc_lhs_sig_type :: SkolemInfo -> LHsSigType GhcRn
-               -> ContextKind -> TcM (Implication, TcType)
+               -> ContextKind -> TcM (Implication, LHsSigType GhcTc)
 -- Kind-checks/desugars an 'LHsSigType',
 --   solve equalities,
 --   and then kind-generalizes.
@@ -468,7 +472,12 @@ tc_lhs_sig_type skol_info (L loc (HsSig { sig_bndrs = hs_outer_bndrs
        -- See Note [Skolem escape in type signatures]
        ; implic <- buildTvImplication skol_info kvs tc_lvl wanted
 
-       ; return (implic, mkInfForAllTys kvs ty1) }
+       ; let
+           (L loc' hs_ty') = hs_ty
+           sig_ty =
+               L loc . HsSig noExtField outer_bndrs 
+             . L loc' . XHsType $ HsTypeTc (mkInfForAllTys kvs ty1) hs_ty'
+       ; return (implic, sig_ty) }
 
 {- Note [Skolem escape in type signatures]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2956,13 +2965,13 @@ tcTKTelescope mode tele thing_inside = case tele of
     -> do { (req_tv_bndrs, thing) <- tcExplicitTKBndrsX skol_mode bndrs thing_inside
             -- req_tv_bndrs :: [VarBndr TyVar ()],
             -- but we want [VarBndr TyVar ArgFlag]
-          ; return (tyVarReqToBinders req_tv_bndrs, thing) }
+          ; return (tyVarReqToBinders . map hsBndrToBndr . map unLoc $ req_tv_bndrs, thing) }
 
   HsForAllInvis { hsf_invis_bndrs = bndrs }
     -> do { (inv_tv_bndrs, thing) <- tcExplicitTKBndrsX skol_mode bndrs thing_inside
             -- inv_tv_bndrs :: [VarBndr TyVar Specificity],
             -- but we want [VarBndr TyVar ArgFlag]
-          ; return (tyVarSpecToBinders inv_tv_bndrs, thing) }
+          ; return (tyVarSpecToBinders . map hsBndrToBndr . map unLoc $ inv_tv_bndrs, thing) }
   where
     skol_mode = smVanilla { sm_clone = False, sm_holes = mode_holes mode }
 
@@ -2982,8 +2991,8 @@ bindOuterTKBndrsX skol_mode outer_bndrs thing_inside
            ; return ( HsOuterImplicit{hso_ximplicit = imp_tvs'}
                     , thing) }
       HsOuterExplicit{hso_bndrs = exp_bndrs} ->
-        do { (exp_tvs', thing) <- bindExplicitTKBndrsX skol_mode exp_bndrs thing_inside
-           ; return ( HsOuterExplicit { hso_xexplicit = exp_tvs'
+        do { (exp_bndrs, thing) <- bindExplicitTKBndrsX skol_mode exp_bndrs thing_inside
+           ; return ( HsOuterExplicit { hso_xexplicit = noExtField
                                       , hso_bndrs     = exp_bndrs }
                     , thing) }
 
@@ -2991,7 +3000,7 @@ getOuterTyVars :: HsOuterTyVarBndrs flag GhcTc -> [TcTyVar]
 -- The returned [TcTyVar] is not necessarily in dependency order
 -- at least for the HsOuterImplicit case
 getOuterTyVars (HsOuterImplicit { hso_ximplicit = tvs })  = tvs
-getOuterTyVars (HsOuterExplicit { hso_xexplicit = tvbs }) = binderVars tvbs
+getOuterTyVars (HsOuterExplicit { hso_bndrs = tvbs }) = binderVars' . map unLoc $ tvbs
 
 ---------------
 scopedSortOuter :: HsOuterTyVarBndrs Specificity GhcTc -> TcM [InvisTVBinder]
@@ -3001,9 +3010,9 @@ scopedSortOuter :: HsOuterTyVarBndrs Specificity GhcTc -> TcM [InvisTVBinder]
 scopedSortOuter (HsOuterImplicit{hso_ximplicit = imp_tvs})
   = do { imp_tvs <- zonkAndScopedSort imp_tvs
        ; return [Bndr tv SpecifiedSpec | tv <- imp_tvs] }
-scopedSortOuter (HsOuterExplicit{hso_xexplicit = exp_tvs})
+scopedSortOuter (HsOuterExplicit{hso_bndrs = exp_tvs})
   = -- No need to dependency-sort (or zonk) explicit quantifiers
-    return exp_tvs
+    return (map (hsBndrToBndr . unLoc) exp_tvs)
 
 ---------------
 bindOuterSigTKBndrs_Tv :: HsOuterSigTyVarBndrs GhcRn
@@ -3062,9 +3071,9 @@ tcOuterTKBndrsX skol_mode skol_info outer_bndrs thing_inside
            ; return ( HsOuterImplicit{hso_ximplicit = imp_tvs'}
                     , thing) }
       HsOuterExplicit{hso_bndrs = exp_bndrs} ->
-        do { (exp_tvs', thing) <- tcExplicitTKBndrsX skol_mode exp_bndrs thing_inside
-           ; return ( HsOuterExplicit { hso_xexplicit = exp_tvs'
-                                      , hso_bndrs     = exp_bndrs }
+        do { (exp_bndrs', thing) <- tcExplicitTKBndrsX skol_mode exp_bndrs thing_inside
+           ; return ( HsOuterExplicit { hso_xexplicit = noExtField
+                                      , hso_bndrs     = exp_bndrs' }
                     , thing) }
 
 --------------------------------------
@@ -3074,14 +3083,14 @@ tcOuterTKBndrsX skol_mode skol_info outer_bndrs thing_inside
 tcExplicitTKBndrs :: OutputableBndrFlag flag 'Renamed
                   => [LHsTyVarBndr flag GhcRn]
                   -> TcM a
-                  -> TcM ([VarBndr TyVar flag], a)
+                  -> TcM ([LHsTyVarBndr flag GhcTc], a)
 tcExplicitTKBndrs = tcExplicitTKBndrsX (smVanilla { sm_clone = True })
 
 tcExplicitTKBndrsX :: OutputableBndrFlag flag 'Renamed
                    => SkolemMode
                    -> [LHsTyVarBndr flag GhcRn]
                    -> TcM a
-                   -> TcM ([VarBndr TyVar flag], a)
+                   -> TcM ([LHsTyVarBndr flag GhcTc], a)
 -- Push level, capture constraints,
 -- and emit an implication constraint with a ForAllSkol ic_info,
 -- so that it is subject to a telescope test.
@@ -3095,7 +3104,7 @@ tcExplicitTKBndrsX skol_mode bndrs thing_inside
              -- Notice that we use ForAllSkol here, ignoring the enclosing
              -- skol_info unlike tc_implicit_tk_bndrs, because the bad-telescope
              -- test applies only to ForAllSkol
-       ; emitResidualTvConstraint skol_info (binderVars skol_tvs) tclvl wanted
+       ; emitResidualTvConstraint skol_info (binderVars' . map unLoc $ skol_tvs) tclvl wanted
 
        ; return (skol_tvs, res) }
 
@@ -3106,12 +3115,24 @@ bindExplicitTKBndrs_Skol, bindExplicitTKBndrs_Tv
     :: (OutputableBndrFlag flag 'Renamed)
     => [LHsTyVarBndr flag GhcRn]
     -> TcM a
-    -> TcM ([VarBndr TyVar flag], a)
+    -> TcM ([LHsTyVarBndr flag GhcTc], a) -- Returned [LHsTyVarBndr GhcTc] are in 1-1 correspondence
+                                          -- with the passed-in [LHsTyVarBndr GhcRn]
 
 bindExplicitTKBndrs_Skol = bindExplicitTKBndrsX (smVanilla { sm_clone = False })
 bindExplicitTKBndrs_Tv   = bindExplicitTKBndrsX (smVanilla { sm_clone = True, sm_tvtv = True })
    -- sm_clone: see Note [Cloning for type variable binders]
 
+binderVar' :: HsTyVarBndr flag GhcTc -> TyVar
+binderVar' (UserTyVar _ _ v) = unLoc v
+binderVar' (KindedTyVar _ _ v _) = unLoc v
+
+binderVars' :: [HsTyVarBndr flag GhcTc] -> [TyVar]
+binderVars' = map binderVar'
+
+binderVarWithF :: HsTyVarBndr flag GhcTc -> VarBndr TyVar flag
+binderVarWithF (UserTyVar _ flag v) = Bndr (unLoc v) flag
+binderVarWithF (KindedTyVar _ flag v _) = Bndr (unLoc v) flag
+
 bindExplicitTKBndrs_Q_Skol, bindExplicitTKBndrs_Q_Tv
     :: ContextKind
     -> [LHsTyVarBndr () GhcRn]
@@ -3119,14 +3140,14 @@ bindExplicitTKBndrs_Q_Skol, bindExplicitTKBndrs_Q_Tv
     -> TcM ([TcTyVar], a)
 -- These do not clone: see Note [Cloning for type variable binders]
 bindExplicitTKBndrs_Q_Skol ctxt_kind hs_bndrs thing_inside
-  = liftFstM binderVars $
+  = liftFstM (binderVars' . map unLoc) $
     bindExplicitTKBndrsX (smVanilla { sm_clone = False, sm_parent = True
                                     , sm_kind = ctxt_kind })
                          hs_bndrs thing_inside
     -- sm_clone=False: see Note [Cloning for type variable binders]
 
 bindExplicitTKBndrs_Q_Tv ctxt_kind hs_bndrs thing_inside
-  = liftFstM binderVars $
+  = liftFstM (binderVars' . map unLoc) $
     bindExplicitTKBndrsX (smVanilla { sm_clone = False, sm_parent = True
                                     , sm_tvtv = True, sm_kind = ctxt_kind })
                          hs_bndrs thing_inside
@@ -3136,8 +3157,7 @@ bindExplicitTKBndrsX :: (OutputableBndrFlag flag 'Renamed)
     => SkolemMode
     -> [LHsTyVarBndr flag GhcRn]
     -> TcM a
-    -> TcM ([VarBndr TyVar flag], a)  -- Returned [TcTyVar] are in 1-1 correspondence
-                                      -- with the passed-in [LHsTyVarBndr]
+    -> TcM ([LHsTyVarBndr flag GhcTc], a)
 bindExplicitTKBndrsX skol_mode@(SM { sm_parent = check_parent, sm_kind = ctxt_kind
                                    , sm_holes = hole_info })
                      hs_tvs thing_inside
@@ -3149,28 +3169,29 @@ bindExplicitTKBndrsX skol_mode@(SM { sm_parent = check_parent, sm_kind = ctxt_ki
 
     go [] = do { res <- thing_inside
                ; return ([], res) }
-    go (L _ hs_tv : hs_tvs)
+    go (L l hs_tv : hs_tvs)
        = do { lcl_env <- getLclTypeEnv
-            ; tv <- tc_hs_bndr lcl_env hs_tv
+            ; (hs_ty, tv') <- tc_hs_bndr lcl_env hs_tv
             -- Extend the environment as we go, in case a binder
             -- is mentioned in the kind of a later binder
             --   e.g. forall k (a::k). blah
             -- NB: tv's Name may differ from hs_tv's
             -- See Note [Cloning for type variable binders]
-            ; (tvs,res) <- tcExtendNameTyVarEnv [(hsTyVarName hs_tv, tv)] $
+            ; (hs_tys,res) <- tcExtendNameTyVarEnv [(hsTyVarName hs_tv, tv')] $
                            go hs_tvs
-            ; return (Bndr tv (hsTyVarBndrFlag hs_tv):tvs, res) }
+            ; return ((L l hs_ty):hs_tys, res) }
 
 
-    tc_hs_bndr lcl_env (UserTyVar _ _ (L _ name))
+    tc_hs_bndr lcl_env (UserTyVar ann flag (L l name))
       | check_parent
       , Just (ATyVar _ tv) <- lookupNameEnv lcl_env name
-      = return tv
+      = return (UserTyVar ann flag (L l tv), tv)
       | otherwise
       = do { kind <- newExpectedKind ctxt_kind
-           ; newTyVarBndr skol_mode name kind }
+           ; var <- newTyVarBndr skol_mode name kind
+           ; return $ (UserTyVar ann flag (L l var), var)}
 
-    tc_hs_bndr lcl_env (KindedTyVar _ _ (L _ name) lhs_kind)
+    tc_hs_bndr lcl_env (KindedTyVar ann flag (L l name) lhs_kind@(L l' hs_kind))
       | check_parent
       , Just (ATyVar _ tv) <- lookupNameEnv lcl_env name
       = do { kind <- tc_lhs_kind_sig tc_ki_mode (TyVarBndrKindCtxt name) lhs_kind
@@ -3179,11 +3200,13 @@ bindExplicitTKBndrsX skol_mode@(SM { sm_parent = check_parent, sm_kind = ctxt_ki
                           -- This unify rejects:
                           --    class C (m :: * -> *) where
                           --      type F (m :: *) = ...
-           ; return tv }
+           ; return $ (KindedTyVar ann flag (L l tv) (L l' $ XHsType (HsTypeTc kind hs_kind)), tv) }
 
       | otherwise
       = do { kind <- tc_lhs_kind_sig tc_ki_mode (TyVarBndrKindCtxt name) lhs_kind
-           ; newTyVarBndr skol_mode name kind }
+           ; var <- newTyVarBndr skol_mode name kind
+           ; return (KindedTyVar ann flag (L l var) (L l' $ XHsType (HsTypeTc kind hs_kind)), var)
+           }
 
 newTyVarBndr :: SkolemMode -> Name -> Kind -> TcM TcTyVar
 newTyVarBndr (SM { sm_clone = clone, sm_tvtv = tvtv }) name kind
@@ -3817,11 +3840,12 @@ tcHsPartialSigType
          , [(Name,InvisTVBinder)] -- Original tyvar names, in correspondence with
                               --   the implicitly and explicitly bound type variables
          , TcThetaType        -- Theta part
-         , TcType )           -- Tau part
+         , TcType             -- Tau part
+         , LHsSigWcType GhcTc )
 -- See Note [Checking partial type signatures]
 tcHsPartialSigType ctxt sig_ty
   | HsWC { hswc_ext  = sig_wcs, hswc_body = sig_ty } <- sig_ty
-  , L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = body_ty}) <- sig_ty
+  , L l (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = body_ty}) <- sig_ty
   , (hs_ctxt, hs_tau) <- splitLHsQualTy body_ty
   = addSigCtxt ctxt sig_ty $
     do { mode <- mkHoleMode TypeLevel HM_Sig
@@ -3874,7 +3898,13 @@ tcHsPartialSigType ctxt sig_ty
       --     here because we don't have a complete type to check
 
        ; traceTc "tcHsPartialSigType" (ppr tv_prs)
-       ; return (wcs, wcx, tv_prs, theta, tau) }
+       ; let
+           (L ty_loc body_ty') = body_ty
+           sig_ty' =
+               HsWC sig_wcs 
+             . L l . HsSig noExtField outer_bndrs
+             . L ty_loc . XHsType $ HsTypeTc tau body_ty'
+       ; return (wcs, wcx, tv_prs, theta, tau, sig_ty') }
 
 tcPartialContext :: TcTyMode -> Maybe (LHsContext GhcRn) -> TcM (TcThetaType, Maybe TcType)
 tcPartialContext _ Nothing = return ([], Nothing)
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index 671955feb7..c652ae73da 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -481,7 +481,10 @@ Fortunately that's what matchExpectedFunTySigma returns anyway.
                          tcExtendNameTyVarEnv tv_binds $
                          tc_lpat (pat_ty `scaledSet` mkCheckExpType inner_ty) penv pat thing_inside
         ; pat_ty <- readExpType (scaledThing pat_ty)
-        ; return (mkHsWrapPat wrap (SigPat inner_ty pat' sig_ty) pat_ty, res) }
+        ; let
+            (L l hs_ty) = hsps_body sig_ty
+            inner_ty' = HsPS { hsps_ext = hsps_ext sig_ty, hsps_body = (L l (XHsType (HsTypeTc inner_ty hs_ty))) }
+        ; return (mkHsWrapPat wrap (SigPat noExtField pat' inner_ty') pat_ty, res) }
 
 ------------------------
 -- Lists, tuples, arrays
@@ -1223,8 +1226,9 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of
           -- OK to drop coercions here. These unifications are all about
           -- guiding inference based on a user-written type annotation
           -- See Note [Typechecking type applications in patterns]
-
-        ; return (PrefixCon type_args arg_pats', res) }
+        ; let tc_type_args
+                = zipWith (\a (HsPS ext (L l b))-> HsPS ext . L l . XHsType $ HsTypeTc a b) type_args' type_args
+        ; return (PrefixCon tc_type_args arg_pats', res) }
     where
       con_arity  = conLikeArity con_like
       no_of_args = length arg_pats
diff --git a/compiler/GHC/Tc/Gen/Rule.hs b/compiler/GHC/Tc/Gen/Rule.hs
index 73dedfbaf5..515b0c157e 100644
--- a/compiler/GHC/Tc/Gen/Rule.hs
+++ b/compiler/GHC/Tc/Gen/Rule.hs
@@ -125,7 +125,7 @@ tcRule (HsRule { rd_ext  = ext
                             generateRuleConstraints ty_bndrs tm_bndrs lhs rhs
 
        ; let (id_bndrs, lhs', lhs_wanted
-                      , rhs', rhs_wanted, rule_ty) = stuff
+                      , rhs', rhs_wanted, rule_ty, ty_bndrs') = stuff
 
        ; traceTc "tcRule 1" (vcat [ pprFullRuleName rname
                                   , ppr lhs_wanted
@@ -174,7 +174,7 @@ tcRule (HsRule { rd_ext  = ext
        ; return $ HsRule { rd_ext = ext
                          , rd_name = rname
                          , rd_act = act
-                         , rd_tyvs = ty_bndrs -- preserved for ppr-ing
+                         , rd_tyvs = ty_bndrs' -- preserved for ppr-ing
                          , rd_tmvs = map (noLoc . RuleBndr noAnn . noLocA)
                                          (qtkvs ++ tpl_ids)
                          , rd_lhs  = mkHsDictLet lhs_binds lhs'
@@ -185,9 +185,10 @@ generateRuleConstraints :: Maybe [LHsTyVarBndr () GhcRn] -> [LRuleBndr GhcRn]
                         -> TcM ( [TcId]
                                , LHsExpr GhcTc, WantedConstraints
                                , LHsExpr GhcTc, WantedConstraints
-                               , TcType )
+                               , TcType
+                               , Maybe [LHsTyVarBndr () GhcTc])
 generateRuleConstraints ty_bndrs tm_bndrs lhs rhs
-  = do { ((tv_bndrs, id_bndrs), bndr_wanted) <- captureConstraints $
+  = do { ((ty_bndrs, tv_bndrs, id_bndrs), bndr_wanted) <- captureConstraints $
                                                 tcRuleBndrs ty_bndrs tm_bndrs
               -- bndr_wanted constraints can include wildcard hole
               -- constraints, which we should not forget about.
@@ -201,19 +202,21 @@ generateRuleConstraints ty_bndrs tm_bndrs lhs rhs
        ; (rhs',            rhs_wanted) <- captureConstraints $
                                           tcCheckMonoExpr rhs rule_ty
        ; let all_lhs_wanted = bndr_wanted `andWC` lhs_wanted
-       ; return (id_bndrs, lhs', all_lhs_wanted, rhs', rhs_wanted, rule_ty) } }
+       ; return (id_bndrs, lhs', all_lhs_wanted, rhs', rhs_wanted, rule_ty, ty_bndrs) } }
 
 -- See Note [TcLevel in type checking rules]
 tcRuleBndrs :: Maybe [LHsTyVarBndr () GhcRn] -> [LRuleBndr GhcRn]
-            -> TcM ([TcTyVar], [Id])
+            -> TcM (Maybe [LHsTyVarBndr () GhcTc], [TcTyVar], [Id])
 tcRuleBndrs (Just bndrs) xs
   = do { (tybndrs1,(tys2,tms)) <- bindExplicitTKBndrs_Skol bndrs $
                                   tcRuleTmBndrs xs
-       ; let tys1 = binderVars tybndrs1
-       ; return (tys1 ++ tys2, tms) }
+       ; let tys1 = binderVars' $ map unLoc tybndrs1
+       ; return (Just tybndrs1, tys1 ++ tys2, tms) }
 
 tcRuleBndrs Nothing xs
-  = tcRuleTmBndrs xs
+  = do { (tys, tms) <- tcRuleTmBndrs xs
+       ; return (Nothing, tys, tms)
+       }
 
 -- See Note [TcLevel in type checking rules]
 tcRuleTmBndrs :: [LRuleBndr GhcRn] -> TcM ([TcTyVar],[Id])
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 1d81b3636b..6b7b6f45de 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -190,7 +190,7 @@ tcTySig (L loc (TypeSig _ names sig_ty))
   = setSrcSpanA loc $
     do { sigs <- sequence [ tcUserTypeSig (locA loc) sig_ty (Just name)
                           | L _ name <- names ]
-       ; return (map TcIdSig sigs) }
+       ; return (map (TcIdSig . fst) sigs) }
 
 tcTySig (L loc (PatSynSig _ names sig_ty))
   = setSrcSpanA loc $
@@ -202,7 +202,7 @@ tcTySig _ = return []
 
 
 tcUserTypeSig :: SrcSpan -> LHsSigWcType GhcRn -> Maybe Name
-              -> TcM TcIdSigInfo
+              -> TcM (TcIdSigInfo, Maybe (LHsSigWcType GhcTc))
 -- A function or expression type signature
 -- Returns a fully quantified type signature; even the wildcards
 -- are quantified with ordinary skolems that should be instantiated
@@ -217,22 +217,23 @@ tcUserTypeSig :: SrcSpan -> LHsSigWcType GhcRn -> Maybe Name
 tcUserTypeSig loc hs_sig_ty mb_name
   | isCompleteHsSig hs_sig_ty
   = do { sigma_ty <- tcHsSigWcType ctxt_F hs_sig_ty
+       ; let ty = hsttc_type . hsTypeTc . unLoc . sig_body . unLoc . hswc_body $ sigma_ty
        ; traceTc "tcuser" (ppr sigma_ty)
        ; return $
-         CompleteSig { sig_bndr  = mkLocalId name Many sigma_ty
+         (CompleteSig { sig_bndr  = mkLocalId name Many ty
                                    -- We use `Many' as the multiplicity here,
                                    -- as if this identifier corresponds to
                                    -- anything, it is a top-level
                                    -- definition. Which are all unrestricted in
                                    -- the current implementation.
                      , sig_ctxt  = ctxt_T
-                     , sig_loc   = loc } }
+                     , sig_loc   = loc}, Just sigma_ty) }
                        -- Location of the <type> in   f :: <type>
 
   -- Partial sig with wildcards
   | otherwise
   = return (PartialSig { psig_name = name, psig_hs_ty = hs_sig_ty
-                       , sig_ctxt = ctxt_F, sig_loc = loc })
+                       , sig_ctxt = ctxt_F, sig_loc = loc }, Nothing)
   where
     name   = case mb_name of
                Just n  -> n
@@ -380,7 +381,7 @@ tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = hs_ty
   = do { traceTc "tcPatSynSig 1" (ppr sig_ty)
 
        ; let skol_info = DataConSkol name
-       ; (tclvl, wanted, (outer_bndrs, (ex_bndrs, (req, prov, body_ty))))
+       ; (tclvl, wanted, (outer_bndrs, (ex_bndrs', (req, prov, body_ty))))
            <- pushLevelAndSolveEqualitiesX "tcPatSynSig"           $
                      -- See Note [solveEqualities in tcPatSynSig]
               tcOuterTKBndrs skol_info hs_outer_bndrs $
@@ -392,11 +393,12 @@ tcPatSynSig name sig_ty@(L _ (HsSig{sig_bndrs = hs_outer_bndrs, sig_body = hs_ty
                      -- e.g. pattern Zero <- 0#   (#12094)
                  ; return (req, prov, body_ty) }
 
+       ; let ex_bndrs = map (hsBndrToBndr . unLoc) ex_bndrs'
        ; let implicit_tvs :: [TcTyVar]
              univ_bndrs   :: [TcInvisTVBinder]
              (implicit_tvs, univ_bndrs) = case outer_bndrs of
                HsOuterImplicit{hso_ximplicit = implicit_tvs} -> (implicit_tvs, [])
-               HsOuterExplicit{hso_xexplicit = univ_bndrs}   -> ([], univ_bndrs)
+               HsOuterExplicit{hso_bndrs = univ_bndrs}   -> ([], map (hsBndrToBndr . unLoc) univ_bndrs)
 
        ; implicit_tvs <- zonkAndScopedSort implicit_tvs
        ; let implicit_bndrs = mkTyVarBinders SpecifiedSpec implicit_tvs
@@ -468,7 +470,7 @@ ppr_tvs tvs = braces (vcat [ ppr tv <+> dcolon <+> ppr (tyVarKind tv)
 ********************************************************************* -}
 
 
-tcInstSig :: TcIdSigInfo -> TcM TcIdSigInst
+tcInstSig :: TcIdSigInfo -> TcM (TcIdSigInst, Maybe (LHsSigWcType GhcTc))
 -- Instantiate a type signature; only used with plan InferGen
 tcInstSig sig@(CompleteSig { sig_bndr = poly_id, sig_loc = loc })
   = setSrcSpan loc $  -- Set the binding site of the tyvars
@@ -480,14 +482,14 @@ tcInstSig sig@(CompleteSig { sig_bndr = poly_id, sig_loc = loc })
                       , sig_inst_wcs   = []
                       , sig_inst_wcx   = Nothing
                       , sig_inst_theta = theta
-                      , sig_inst_tau   = tau }) }
+                      , sig_inst_tau   = tau }, Nothing) }
 
 tcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty
                              , sig_ctxt = ctxt
                              , sig_loc = loc })
   = setSrcSpan loc $  -- Set the binding site of the tyvars
     do { traceTc "Staring partial sig {" (ppr hs_sig)
-       ; (wcs, wcx, tv_prs, theta, tau) <- tcHsPartialSigType ctxt hs_ty
+       ; (wcs, wcx, tv_prs, theta, tau, ty) <- tcHsPartialSigType ctxt hs_ty
          -- See Note [Checking partial type signatures] in GHC.Tc.Gen.HsType
        ; let inst_sig = TISI { sig_inst_sig   = hs_sig
                              , sig_inst_skols = tv_prs
@@ -496,7 +498,7 @@ tcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty
                              , sig_inst_theta = theta
                              , sig_inst_tau   = tau }
        ; traceTc "End partial sig }" (ppr inst_sig)
-       ; return inst_sig }
+       ; return (inst_sig, Just ty) }
 
 
 {- Note [Pattern bindings and complete signatures]
@@ -758,7 +760,9 @@ tcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl)
 
     tc_one hs_ty
       = do { spec_ty <- tcHsSigType   (FunSigCtxt name False) hs_ty
-           ; wrap    <- tcSpecWrapper (FunSigCtxt name True)  poly_ty spec_ty
+           ; let (HsSig _ _ (L _ ty')) = unLoc spec_ty
+                 ty = hsttc_type . hsTypeTc $ ty'
+           ; wrap    <- tcSpecWrapper (FunSigCtxt name True)  poly_ty ty
            ; return (SpecPrag poly_id wrap inl) }
 
 tcSpecPrag _ prag = pprPanic "tcSpecPrag" (ppr prag)
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index d4b25806bf..931bfcf617 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -3364,7 +3364,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map
 
        ; traceTc "tcConDecl 1" (vcat [ ppr name, ppr explicit_tkv_nms ])
 
-       ; (tclvl, wanted, (exp_tvbndrs, (ctxt, arg_tys, field_lbls, stricts)))
+       ; (tclvl, wanted, (exp_tvbndrs', (ctxt, arg_tys, field_lbls, stricts)))
            <- pushLevelAndSolveEqualitiesX "tcConDecl:H98"  $
               tcExplicitTKBndrs explicit_tkv_nms            $
               do { ctxt <- tcHsContext hs_ctxt
@@ -3375,6 +3375,7 @@ tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map
                  ; return (ctxt, arg_tys, field_lbls, stricts)
                  }
 
+       ; let exp_tvbndrs = map binderVarWithF $ map unLoc exp_tvbndrs'
 
        ; let tc_tvs   = binderVars tc_bndrs
              fake_ty  = mkSpecForAllTys  tc_tvs      $
diff --git a/compiler/GHC/Tc/TyCl/Class.hs b/compiler/GHC/Tc/TyCl/Class.hs
index 80804ecaea..667d140119 100644
--- a/compiler/GHC/Tc/TyCl/Class.hs
+++ b/compiler/GHC/Tc/TyCl/Class.hs
@@ -163,7 +163,7 @@ tcClassSigs clas sigs def_methods
            -> TcM [TcMethInfo]
     tc_sig gen_dm_env (op_names, op_hs_ty)
       = do { traceTc "ClsSig 1" (ppr op_names)
-           ; op_ty <- tcClassSigType op_names op_hs_ty
+           ; op_ty <- hsttc_type . hsTypeTc . unLoc . sig_body . unLoc <$> tcClassSigType op_names op_hs_ty
                    -- Class tyvars already in scope
 
            ; traceTc "ClsSig 2" (ppr op_names $$ ppr op_ty)
@@ -176,9 +176,8 @@ tcClassSigs clas sigs def_methods
     tc_gen_sig :: ([LocatedN Name], LHsSigType GhcRn)
                       -> IOEnv (Env TcGblEnv TcLclEnv) [(Name, (SrcSpan, Type))] -- AZ temp
     tc_gen_sig (op_names, gen_hs_ty)
-      = do { gen_op_ty <- tcClassSigType op_names gen_hs_ty
-           ; return [ (op_name, (locA loc, gen_op_ty))
-                                                 | L loc op_name <- op_names ] }
+      = do { gen_op_ty <- hsttc_type . hsTypeTc . unLoc . sig_body . unLoc <$> tcClassSigType op_names gen_hs_ty
+           ; return [ (op_name, (locA loc, gen_op_ty)) | L loc op_name <- op_names ] }
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index ec05dffaae..f2b1c87ad6 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -1889,30 +1889,31 @@ tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
   | Just hs_sig_ty <- hs_sig_fn sel_name
               -- There is a signature in the instance
               -- See Note [Instance method signatures]
-  = do { (sig_ty, hs_wrap)
+  = do { (ty, hs_wrap)
              <- setSrcSpan (getLocA hs_sig_ty) $
                 do { inst_sigs <- xoptM LangExt.InstanceSigs
                    ; checkTc inst_sigs (misplacedInstSig sel_name hs_sig_ty)
-                   ; sig_ty  <- tcHsSigType (FunSigCtxt sel_name False) hs_sig_ty
+                   ; sig_ty <- tcHsSigType (FunSigCtxt sel_name False) hs_sig_ty
                    ; let local_meth_ty = idType local_meth_id
+                         ty = hsttc_type . hsTypeTc . unLoc . sig_body . unLoc $ sig_ty
                          ctxt = FunSigCtxt sel_name False
                                 -- False <=> do not report redundant constraints when
                                 --           checking instance-sig <= class-meth-sig
                                 -- The instance-sig is the focus here; the class-meth-sig
                                 -- is fixed (#18036)
-                   ; hs_wrap <- addErrCtxtM (methSigCtxt sel_name sig_ty local_meth_ty) $
-                                tcSubTypeSigma ctxt sig_ty local_meth_ty
-                   ; return (sig_ty, hs_wrap) }
+                   ; hs_wrap <- addErrCtxtM (methSigCtxt sel_name ty local_meth_ty) $
+                                tcSubTypeSigma ctxt ty local_meth_ty
+                   ; return (ty, hs_wrap) }
 
        ; inner_meth_name <- newName (nameOccName sel_name)
        ; let ctxt = FunSigCtxt sel_name True
                     -- True <=> check for redundant constraints in the
                     --          user-specified instance signature
-             inner_meth_id  = mkLocalId inner_meth_name Many sig_ty
+             inner_meth_id  = mkLocalId inner_meth_name Many ty
              inner_meth_sig = CompleteSig { sig_bndr = inner_meth_id
                                           , sig_ctxt = ctxt
-                                          , sig_loc  = getLocA hs_sig_ty }
-
+                                          , sig_loc  = getLocA hs_sig_ty
+                                          }
 
        ; (tc_bind, [inner_id]) <- tcPolyCheck no_prag_fn inner_meth_sig meth_bind
 
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index dbed564efc..2cb05b99a9 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -1491,7 +1491,6 @@ data TcIdSigInfo   -- See Note [Complete and partial type signatures]
       , 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
diff --git a/compiler/GHC/Tc/Utils/Zonk.hs b/compiler/GHC/Tc/Utils/Zonk.hs
index 0e34d97c46..12d5918463 100644
--- a/compiler/GHC/Tc/Utils/Zonk.hs
+++ b/compiler/GHC/Tc/Utils/Zonk.hs
@@ -131,7 +131,7 @@ hsPatType (ConPat { pat_con = lcon
                     }
                   })
                                         = conLikeResTy (unLoc lcon) tys
-hsPatType (SigPat ty _ _)               = ty
+hsPatType (SigPat _ _ (HsPS _ (L _ ty))) = hsttc_type . hsTypeTc $ ty
 hsPatType (NPat ty _ _ _)               = ty
 hsPatType (NPlusKPat ty _ _ _ _ _)      = ty
 hsPatType (XPat (CoPat _ _ ty))         = ty
@@ -841,10 +841,10 @@ zonkExpr env (HsApp x e1 e2)
        new_e2 <- zonkLExpr env e2
        return (HsApp x new_e1 new_e2)
 
-zonkExpr env (HsAppType ty e t)
+zonkExpr env (HsAppType _ e (HsWC field (L l (XHsType (HsTypeTc ty t)))))
   = do new_e <- zonkLExpr env e
        new_ty <- zonkTcTypeToTypeX env ty
-       return (HsAppType new_ty new_e t)
+       return (HsAppType noExtField new_e (HsWC field (L l (XHsType (HsTypeTc new_ty t)))))
        -- NB: the type is an HsType; can't zonk that!
 
 zonkExpr _ e@(HsRnBracketOut _ _ _)
@@ -1510,10 +1510,10 @@ zonk_pat env p@(ConPat { pat_con = L _ con
 
 zonk_pat env (LitPat x lit) = return (env, LitPat x lit)
 
-zonk_pat env (SigPat ty pat hs_ty)
+zonk_pat env (SigPat _ pat (HsPS ext (L l (XHsType (HsTypeTc ty hs_ty)))))
   = do  { ty' <- zonkTcTypeToTypeX env ty
         ; (env', pat') <- zonkPat env pat
-        ; return (env', SigPat ty' pat' hs_ty) }
+        ; return (env', SigPat noExtField pat' (HsPS ext (L l (XHsType (HsTypeTc ty' hs_ty))))) }
 
 zonk_pat env (NPat ty (L l lit) mb_neg eq_expr)
   = do  { (env1, eq_expr') <- zonkSyntaxExpr env eq_expr
diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs
index 0b93e4b265..e07fe7f416 100644
--- a/compiler/Language/Haskell/Syntax/Decls.hs
+++ b/compiler/Language/Haskell/Syntax/Decls.hs
@@ -1655,7 +1655,7 @@ data RuleDecl pass
        , rd_name :: XRec pass (SourceText,RuleName)
            -- ^ Note [Pragma source text] in "GHC.Types.Basic"
        , rd_act  :: Activation
-       , rd_tyvs :: Maybe [LHsTyVarBndr () (NoGhcTc pass)]
+       , rd_tyvs :: Maybe [LHsTyVarBndr () pass]
            -- ^ Forall'd type vars
        , rd_tmvs :: [LRuleBndr pass]
            -- ^ Forall'd term vars, before typechecking; after typechecking
diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs
index 2362ea8373..ce4d1202ac 100644
--- a/compiler/Language/Haskell/Syntax/Expr.hs
+++ b/compiler/Language/Haskell/Syntax/Expr.hs
@@ -324,7 +324,7 @@ data HsExpr p
 
   | HsAppType (XAppTypeE p) -- After typechecking: the type argument
               (LHsExpr p)
-              (LHsWcType (NoGhcTc p))  -- ^ Visible type application
+              (LHsWcType p)  -- ^ Visible type application
        --
        -- Explicit type argument; e.g  f @Int x y
        -- NB: Has wildcards, but no implicit quantification
@@ -517,7 +517,7 @@ data HsExpr p
                 (XExprWithTySig p)
 
                 (LHsExpr p)
-                (LHsSigWcType (NoGhcTc p))
+                (LHsSigWcType p)
 
   -- | Arithmetic sequence
   --
diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs
index 86f56f7ad8..14e2504110 100644
--- a/compiler/Language/Haskell/Syntax/Pat.hs
+++ b/compiler/Language/Haskell/Syntax/Pat.hs
@@ -205,7 +205,7 @@ data Pat p
   -- For details on above see note [Api annotations] in GHC.Parser.Annotation
   | SigPat          (XSigPat p)             -- After typechecker: Type
                     (LPat p)                -- Pattern with a type signature
-                    (HsPatSigType (NoGhcTc p)) --  Signature can bind both
+                    (HsPatSigType p)        --  Signature can bind both
                                                --  kind and type vars
 
     -- ^ Pattern with a type signature
@@ -221,7 +221,7 @@ type family ConLikeP x
 
 
 -- | Haskell Constructor Pattern Details
-type HsConPatDetails p = HsConDetails (HsPatSigType (NoGhcTc p)) (LPat p) (HsRecFields p (LPat p))
+type HsConPatDetails p = HsConDetails (HsPatSigType p) (LPat p) (HsRecFields p (LPat p))
 
 hsConPatArgs :: forall p . (UnXRec p) => HsConPatDetails p -> [LPat p]
 hsConPatArgs (PrefixCon _ ps) = ps
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index d91a2f3267..6e77210d50 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -23,7 +23,7 @@ module Language.Haskell.Syntax.Type (
         HsArrow(..),
         hsLinear, hsUnrestricted,
 
-        HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
+        HsType(..), HsTypeTc(..), HsCoreTy, LHsType, HsKind, LHsKind,
         HsForAllTelescope(..), HsTyVarBndr(..), LHsTyVarBndr,
         LHsQTyVars(..),
         HsOuterTyVarBndrs(..), HsOuterFamEqnTyVarBndrs, HsOuterSigTyVarBndrs,
@@ -62,6 +62,8 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsSplice )
 
 import Language.Haskell.Syntax.Extension
 
+import GHC.Hs.Extension
+
 import GHC.Types.SourceText
 import GHC.Types.Name( Name )
 import GHC.Types.Name.Reader ( RdrName )
@@ -368,7 +370,7 @@ data HsOuterTyVarBndrs flag pass
   | HsOuterExplicit -- ^ Explicit forall, e.g.,
                     --    @f :: forall a b. a -> b -> b@
     { hso_xexplicit :: XHsOuterExplicit pass flag
-    , hso_bndrs     :: [LHsTyVarBndr flag (NoGhcTc pass)]
+    , hso_bndrs     :: [LHsTyVarBndr flag pass]
     }
   | XHsOuterTyVarBndrs !(XXHsOuterTyVarBndrs pass)
 
@@ -893,6 +895,14 @@ data HsType pass
   | XHsType
       !(XXType pass)
 
+data HsTypeTc = HsTypeTc
+  { hsttc_type :: Type
+  , hsttc_rn :: HsType GhcRn
+  }
+
+instance Outputable HsTypeTc where
+  ppr (HsTypeTc p _) = ppr p
+
 -- An escape hatch for tunnelling a Core 'Type' through 'HsType'.
 -- For more details on how this works, see:
 --
diff --git a/utils/haddock b/utils/haddock
-Subproject 3699d74aac686c1e071ab050456698ff2ea8c7d
+Subproject eb5aba14948900841d96f4307a82a1524927c37