diff options
author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2021-09-30 21:19:41 +0300 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-10-04 18:44:07 -0400 |
commit | 2308a130cac014ab1383a1f90a693c75fdceca67 (patch) | |
tree | bc99ea249d0a2cee78683cab51865bb6e5721e25 | |
parent | b3267fadd42429e6253cefd85d556aeea4dadd6f (diff) | |
download | haskell-2308a130cac014ab1383a1f90a693c75fdceca67.tar.gz |
Clean up HiePass constraints
-rw-r--r-- | compiler/GHC/Hs/Utils.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Iface/Ext/Ast.hs | 77 |
2 files changed, 26 insertions, 54 deletions
diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index 3f29455032..e5e3b35b94 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -152,7 +152,6 @@ import Data.Either import Data.Function import Data.List ( partition, deleteBy ) import Data.Proxy -import Data.Data (Data) {- ************************************************************************ @@ -876,7 +875,7 @@ isInfixFunBind (FunBind { fun_matches = MG _ matches _ }) isInfixFunBind _ = False -- |Return the 'SrcSpan' encompassing the contents of any enclosed binds -spanHsLocaLBinds :: (Data (HsLocalBinds (GhcPass p))) => HsLocalBinds (GhcPass p) -> SrcSpan +spanHsLocaLBinds :: HsLocalBinds (GhcPass p) -> SrcSpan spanHsLocaLBinds (EmptyLocalBinds _) = noSrcSpan spanHsLocaLBinds (HsValBinds _ (ValBinds _ bs sigs)) = foldr combineSrcSpans noSrcSpan (bsSpans ++ sigsSpans) 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 |