1 files changed, 23 insertions, 17 deletions
diff --git a/compiler/hsSyn/HsExtension.hs b/compiler/hsSyn/HsExtension.hs
index a7c467dce4..43653a52bd 100644
--- a/compiler/hsSyn/HsExtension.hs
+++ b/compiler/hsSyn/HsExtension.hs
@@ -27,6 +27,8 @@ import Var
 import Outputable
 import SrcLoc (Located)
 
+import Data.Kind
+
 {-
 Note [Trees that grow]
 ~~~~~~~~~~~~~~~~~~~~~~
@@ -85,6 +87,18 @@ type instance IdP GhcTc = Id
 
 type LIdP p = Located (IdP p)
 
+-- | Marks that a field uses the GhcRn variant even when the pass
+-- parameter is GhcTc. Useful for storing HsTypes in HsExprs, say, because
+-- HsType GhcTc should never occur.
+type family NoGhcTc (p :: Type) where
+    -- this way, GHC can figure out that the result is a GhcPass
+  NoGhcTc (GhcPass pass) = GhcPass (NoGhcTcPass pass)
+  NoGhcTc other          = other
+
+type family NoGhcTcPass (p :: Pass) :: Pass where
+  NoGhcTcPass 'Typechecked = 'Renamed
+  NoGhcTcPass other        = other
+
 -- =====================================================================
 -- Type families for the HsBinds extension points
 
@@ -423,12 +437,12 @@ type ForallXRuleDecls (c :: * -> Constraint) (x :: *) =
 
 -- -------------------------------------
 -- RuleDecl type families
-type family XHsRule         x
-type family XXRuleDecl      x
+type family XHsRule          x
+type family XXRuleDecl       x
 
 type ForallXRuleDecl (c :: * -> Constraint) (x :: *) =
-       ( c (XHsRule          x)
-       , c (XXRuleDecl       x)
+       ( c (XHsRule           x)
+       , c (XXRuleDecl        x)
        )
 
 -- -------------------------------------
@@ -1079,21 +1093,9 @@ type ConvertIdX a b =
 -- | Provide a summary constraint that gives all am Outputable constraint to
 -- extension points needing one
 type OutputableX p = -- See Note [OutputableX]
-  (
-    Outputable (XSigPat p)
-  , Outputable (XSigPat GhcRn)
-
-  , Outputable (XIPBinds    p)
-
-  , Outputable (XExprWithTySig p)
-  , Outputable (XExprWithTySig GhcRn)
-
-  , Outputable (XAppTypeE p)
-  , Outputable (XAppTypeE GhcRn)
-
+  ( Outputable (XIPBinds    p)
   , Outputable (XViaStrategy p)
   , Outputable (XViaStrategy GhcRn)
-
   )
 -- TODO: Should OutputableX be included in OutputableBndrId?
 
@@ -1104,5 +1106,9 @@ type OutputableX p = -- See Note [OutputableX]
 type OutputableBndrId id =
   ( OutputableBndr (NameOrRdrName (IdP id))
   , OutputableBndr (IdP id)
+  , OutputableBndr (NameOrRdrName (IdP (NoGhcTc id)))
+  , OutputableBndr (IdP (NoGhcTc id))
+  , NoGhcTc id ~ NoGhcTc (NoGhcTc id)
   , OutputableX id
+  , OutputableX (NoGhcTc id)
   )