Clean up HiePass constraints

1 files changed, 25 insertions, 52 deletions

diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 90afbd9605..58047e531f 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -396,8 +396,7 @@ getRealSpan :: SrcSpan -> Maybe Span
 getRealSpan (RealSrcSpan sp _) = Just sp
 getRealSpan _ = Nothing
 
-grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan
-              , Data (HsLocalBinds (GhcPass p)))
+grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan)
            => GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
 grhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (spanHsLocaLBinds bs) (map getLoc xs)
 
@@ -781,8 +780,8 @@ data HiePassEv p where
   HieRn :: HiePassEv 'Renamed
   HieTc :: HiePassEv 'Typechecked
 
-class ( IsPass p
-      , HiePass (NoGhcTcPass p)
+class ( HiePass (NoGhcTcPass p)
+      , NoGhcTcPass p ~ 'Renamed
       , ModifyState (IdGhcP p)
       , Data (GRHS  (GhcPass p) (LocatedA (HsExpr (GhcPass p))))
       , Data (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))
@@ -800,10 +799,6 @@ class ( IsPass p
       , Data (HsTupArg (GhcPass p))
       , Data (IPBind (GhcPass 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))))
       , Anno (IdGhcP p) ~ SrcSpanAnnN
       )
       => HiePass p where
@@ -830,8 +825,6 @@ type AnnoBody p body
     , Data (Match (GhcPass p) (LocatedA (body (GhcPass p))))
     , Data (GRHS  (GhcPass p) (LocatedA (body (GhcPass p))))
     , Data (Stmt  (GhcPass p) (LocatedA (body (GhcPass p))))
-
-    , IsPass p
     )
 
 instance HiePass p => ToHie (BindContext (LocatedA (HsBind (GhcPass p)))) where
@@ -920,17 +913,13 @@ instance ( HiePass p
          , AnnoBody p body
          , ToHie (LocatedA (body (GhcPass p)))
          ) => ToHie (LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))) where
-  toHie (L span m ) = concatM $ node : case m of
+  toHie (L span m ) = concatM $ makeNodeA m span : case m of
     Match{m_ctxt=mctx, m_pats = pats, m_grhss =  grhss } ->
       [ toHie mctx
       , let rhsScope = mkScope $ grhss_span grhss
           in toHie $ patScopes Nothing rhsScope NoScope pats
       , toHie grhss
       ]
-    where
-      node = case hiePass @p of
-        HieTc -> makeNodeA m span
-        HieRn -> makeNodeA m span
 
 instance HiePass p => ToHie (HsMatchContext (GhcPass p)) where
   toHie (FunRhs{mc_fun=name}) = toHie $ C MatchBind name'
@@ -1035,8 +1024,8 @@ instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
               ]
             ExpansionPat _ p -> [ toHie $ PS rsp scope pscope (L ospan p) ]
     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 GhcRn) a (HsRecFields (GhcPass p) a)
+                 -> HsConDetails (TScoped (HsPatSigType GhcRn)) (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'
@@ -1071,15 +1060,11 @@ instance ( ToHie (LocatedA (body (GhcPass p)))
          , HiePass p
          , AnnoBody p body
          ) => ToHie (Located (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))) where
-  toHie (L span g) = concatM $ node : case g of
+  toHie (L span g) = concatM $ makeNode g span : case g of
     GRHS _ guards body ->
       [ toHie $ listScopes (mkLScopeA body) guards
       , toHie body
       ]
-    where
-      node = case hiePass @p of
-        HieRn -> makeNode g span
-        HieTc -> makeNode g span
 
 instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
   toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of
@@ -1207,7 +1192,7 @@ instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
       HsGetField {} -> []
       HsProjection {} -> []
       XExpr x
-        | GhcTc <- ghcPass @p
+        | HieTc <- hiePass @p
         -> case x of
              WrapExpr (HsWrap w a)
                -> [ toHie $ L mspan a
@@ -1349,34 +1334,23 @@ instance ( ToHie (RFContext label)
       , toHie expr
       ]
 
-instance ToHie (RFContext (Located (FieldOcc GhcRn))) where
-  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
-    FieldOcc name _ ->
-      [ toHie $ C (RecField c rhs) (L nspan name)
-      ]
-
-instance ToHie (RFContext (Located (FieldOcc GhcTc))) where
+instance HiePass p => ToHie (RFContext (Located (FieldOcc (GhcPass p)))) where
   toHie (RFC c rhs (L nspan f)) = concatM $ case f of
-    FieldOcc var _ ->
-      [ toHie $ C (RecField c rhs) (L nspan var)
-      ]
+    FieldOcc fld _ ->
+      case hiePass @p of
+        HieRn -> [toHie $ C (RecField c rhs) (L nspan fld)]
+        HieTc -> [toHie $ C (RecField c rhs) (L nspan fld)]
 
-instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
+instance HiePass p => ToHie (RFContext (Located (AmbiguousFieldOcc (GhcPass p)))) where
   toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
-    Unambiguous name _ ->
-      [ toHie $ C (RecField c rhs) $ L nspan name
-      ]
-    Ambiguous _name _ ->
-      [ ]
-
-instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
-  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
-    Unambiguous var _ ->
-      [ toHie $ C (RecField c rhs) (L nspan var)
-      ]
-    Ambiguous var _ ->
-      [ toHie $ C (RecField c rhs) (L nspan var)
-      ]
+    Unambiguous fld _ ->
+      case hiePass @p of
+        HieRn -> [toHie $ C (RecField c rhs) $ L nspan fld]
+        HieTc -> [toHie $ C (RecField c rhs) $ L nspan fld]
+    Ambiguous fld _ ->
+      case hiePass @p of
+        HieRn -> []
+        HieTc -> [ toHie $ C (RecField c rhs) (L nspan fld) ]
 
 instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where
   toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM
@@ -1914,12 +1888,11 @@ instance HiePass p => ToHie (LocatedA (HsSplice (GhcPass p))) where
         ]
       HsSpliced _ _ _ ->
         []
-      XSplice x -> case ghcPass @p of
+      XSplice x -> case hiePass @p of
 #if __GLASGOW_HASKELL__ < 811
-                     GhcPs -> noExtCon x
-                     GhcRn -> noExtCon x
+                     HieRn -> noExtCon x
 #endif
-                     GhcTc -> case x of
+                     HieTc -> case x of
                                 HsSplicedT _ -> []
 
 instance ToHie (LocatedA (RoleAnnotDecl GhcRn)) where