diff options
author | romes <rodrigo.m.mesquita@gmail.com> | 2022-06-14 00:56:14 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-07-06 13:50:27 -0400 |
commit | fd379d1b8e709f4eaa20a969bf9fffd40b8a4433 (patch) | |
tree | a168d8d325b6d7cc2170676a8822e8b38152a85f /utils | |
parent | 371c5ecf6898294f4e5bf91784dc794e7e16b7cc (diff) | |
download | haskell-fd379d1b8e709f4eaa20a969bf9fffd40b8a4433.tar.gz |
Remove many GHC dependencies from L.H.S
Continue to prune the `Language.Haskell.Syntax.*` modules out of GHC
imports according to the plan in the linked issue.
Moves more GHC-specific declarations to `GHC.*` and brings more required
GHC-independent declarations to `Language.Haskell.Syntax.*` (extending
e.g. `Language.Haskell.Syntax.Basic`).
Progress towards #21592
Bump haddock submodule for !8308
-------------------------
Metric Decrease:
hard_hole_fits
-------------------------
Diffstat (limited to 'utils')
-rw-r--r-- | utils/check-exact/ExactPrint.hs | 52 | ||||
-rw-r--r-- | utils/check-exact/Main.hs | 2 | ||||
-rw-r--r-- | utils/check-exact/Transform.hs | 24 | ||||
m--------- | utils/haddock | 0 |
4 files changed, 36 insertions, 42 deletions
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 1255d492e0..ef2e98841b 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -944,18 +944,18 @@ instance ExactPrint (ForeignDecl GhcPs) where -- --------------------------------------------------------------------- -instance ExactPrint ForeignImport where +instance ExactPrint (ForeignImport GhcPs) where getAnnotationEntry = const NoEntryVal - exact (CImport cconv safety@(L ll _) _mh _imp (L ls src)) = do + exact (CImport (L ls src) cconv safety@(L ll _) _mh _imp) = do markAnnotated cconv unless (ll == noSrcSpan) $ markAnnotated safety unless (ls == noSrcSpan) $ markExternalSourceText ls src "" -- --------------------------------------------------------------------- -instance ExactPrint ForeignExport where +instance ExactPrint (ForeignExport GhcPs) where getAnnotationEntry = const NoEntryVal - exact (CExport spec (L ls src)) = do + exact (CExport (L ls src) spec) = do debugM $ "CExport starting" markAnnotated spec unless (ls == noSrcSpan) $ markExternalSourceText ls src "" @@ -983,8 +983,8 @@ instance ExactPrint CCallConv where -- --------------------------------------------------------------------- instance ExactPrint (WarnDecls GhcPs) where - getAnnotationEntry (Warnings an _ _) = fromAnn an - exact (Warnings an src warns) = do + getAnnotationEntry (Warnings (an,_) _) = fromAnn an + exact (Warnings (an,src) warns) = do markAnnOpen an src "{-# WARNING" -- Note: might be {-# DEPRECATED markAnnotated warns markLocatedAALS an id AnnClose (Just "#-}") @@ -1024,8 +1024,8 @@ instance ExactPrint FastString where -- --------------------------------------------------------------------- instance ExactPrint (RuleDecls GhcPs) where - getAnnotationEntry (HsRules an _ _) = fromAnn an - exact (HsRules an src rules) = do + getAnnotationEntry (HsRules (an,_) _) = fromAnn an + exact (HsRules (an, src) rules) = do case src of NoSourceText -> markLocatedAALS an id AnnOpen (Just "{-# RULES") SourceText srcTxt -> markLocatedAALS an id AnnOpen (Just srcTxt) @@ -1036,8 +1036,8 @@ instance ExactPrint (RuleDecls GhcPs) where -- --------------------------------------------------------------------- instance ExactPrint (RuleDecl GhcPs) where - getAnnotationEntry (HsRule {rd_ext = an}) = fromAnn an - exact (HsRule an ln act mtybndrs termbndrs lhs rhs) = do + getAnnotationEntry (HsRule {rd_ext = (an,_)}) = fromAnn an + exact (HsRule (an,_) ln act mtybndrs termbndrs lhs rhs) = do debugM "HsRule entered" markAnnotated ln debugM "HsRule after ln" @@ -1309,9 +1309,9 @@ instance ExactPrint (HsBind GhcPs) where getAnnotationEntry VarBind{} = NoEntryVal getAnnotationEntry PatSynBind{} = NoEntryVal - exact (FunBind _ _ matches _) = do + exact (FunBind _ _ matches) = do markAnnotated matches - exact (PatBind _ pat grhss _) = do + exact (PatBind _ pat grhss) = do markAnnotated pat markAnnotated grhss exact (PatSynBind _ bind) = markAnnotated bind @@ -1593,14 +1593,13 @@ instance ExactPrint (Sig GhcPs) where getAnnotationEntry (TypeSig a _ _) = fromAnn a getAnnotationEntry (PatSynSig a _ _) = fromAnn a getAnnotationEntry (ClassOpSig a _ _ _) = fromAnn a - getAnnotationEntry (IdSig {}) = NoEntryVal getAnnotationEntry (FixSig a _) = fromAnn a getAnnotationEntry (InlineSig a _ _) = fromAnn a getAnnotationEntry (SpecSig a _ _ _) = fromAnn a - getAnnotationEntry (SpecInstSig a _ _) = fromAnn a - getAnnotationEntry (MinimalSig a _ _) = fromAnn a - getAnnotationEntry (SCCFunSig a _ _ _) = fromAnn a - getAnnotationEntry (CompleteMatchSig a _ _ _) = fromAnn a + getAnnotationEntry (SpecInstSig (a, _) _) = fromAnn a + getAnnotationEntry (MinimalSig (a, _) _) = fromAnn a + getAnnotationEntry (SCCFunSig (a, _) _ _) = fromAnn a + getAnnotationEntry (CompleteMatchSig (a, _) _ _) = fromAnn a -- instance Annotate (Sig GhcPs) where @@ -1616,9 +1615,6 @@ instance ExactPrint (Sig GhcPs) where | is_deflt = markLocatedAAL an asRest AnnDefault >> exactVarSig an vars ty | otherwise = exactVarSig an vars ty --- markAST _ (IdSig {}) = --- traceM "warning: Introduced after renaming" - exact (FixSig an (FixitySig _ names (Fixity src v fdir))) = do let fixstr = case fdir of InfixL -> "infixl" @@ -1650,7 +1646,7 @@ instance ExactPrint (Sig GhcPs) where markAnnotated typs markLocatedAALS an id AnnClose (Just "#-}") - exact (SpecInstSig an src typ) = do + exact (SpecInstSig (an, src) typ) = do markAnnOpen an src "{-# SPECIALISE" markEpAnn an AnnInstance markAnnotated typ @@ -1663,7 +1659,7 @@ instance ExactPrint (Sig GhcPs) where -- markWithString AnnClose "#-}" -- '#-}' -- markTrailingSemi - exact (MinimalSig an src formula) = do + exact (MinimalSig (an, src) formula) = do markAnnOpen an src "{-# MINIMAL" markAnnotated formula markLocatedAALS an id AnnClose (Just "#-}") @@ -1674,13 +1670,13 @@ instance ExactPrint (Sig GhcPs) where -- markWithString AnnClose "#-}" -- markTrailingSemi - exact (SCCFunSig an src ln ml) = do + exact (SCCFunSig (an, src) ln ml) = do markAnnOpen an src "{-# SCC" markAnnotated ln markAnnotated ml markLocatedAALS an id AnnClose (Just "#-}") - exact (CompleteMatchSig an src cs mty) = do + exact (CompleteMatchSig (an, src) cs mty) = do markAnnOpen an src "{-# COMPLETE" markAnnotated cs case mty of @@ -1690,8 +1686,6 @@ instance ExactPrint (Sig GhcPs) where markAnnotated ty markLocatedAALS an id AnnClose (Just "#-}") - exact x = error $ "exact Sig for:" ++ showAst x - -- --------------------------------------------------------------------- exactVarSig :: (ExactPrint a) => EpAnn AnnSig -> [LocatedN RdrName] -> a -> EPP () @@ -1746,9 +1740,9 @@ instance ExactPrint (DefaultDecl GhcPs) where -- --------------------------------------------------------------------- instance ExactPrint (AnnDecl GhcPs) where - getAnnotationEntry (HsAnnotation an _ _ _) = fromAnn an + getAnnotationEntry (HsAnnotation (an, _) _ _) = fromAnn an - exact (HsAnnotation an src prov e) = do + exact (HsAnnotation (an, src) prov e) = do markAnnOpenP an src "{-# ANN" case prov of (ValueAnnProvenance n) -> markAnnotated n @@ -2126,7 +2120,7 @@ exactMdo an (Just module_name) kw = markLocatedAALS an al_rest kw (Just n) instance ExactPrint (HsPragE GhcPs) where getAnnotationEntry HsPragSCC{} = NoEntryVal - exact (HsPragSCC an st sl) = do + exact (HsPragSCC (an, st) sl) = do markAnnOpenP an st "{-# SCC" let txt = sourceTextToString (sl_st sl) (unpackFS $ sl_fs sl) markLocatedAALS an apr_rest AnnVal (Just txt) -- optional diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index 8e79de24b3..122c63990a 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -692,7 +692,7 @@ addLocaLDecl6 libdir lp = do [de1'',d2] <- balanceCommentsList decls0 let de1 = captureMatchLineSpacing de1'' - let L _ (ValD _ (FunBind _ _ (MG _ (L _ ms)) _)) = de1 + let L _ (ValD _ (FunBind _ _ (MG _ (L _ ms)))) = de1 let [ma1,_ma2] = ms (de1',_) <- modifyValD (getLocA ma1) de1 $ \_m decls -> do diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs index 08b335291c..3009160c89 100644 --- a/utils/check-exact/Transform.hs +++ b/utils/check-exact/Transform.hs @@ -263,8 +263,8 @@ captureOrder ls = AnnSortKey $ map (rs . getLocA) ls -- --------------------------------------------------------------------- captureMatchLineSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs -captureMatchLineSpacing (L l (ValD x (FunBind a b (MG c (L d ms )) f))) - = L l (ValD x (FunBind a b (MG c (L d ms')) f)) +captureMatchLineSpacing (L l (ValD x (FunBind a b (MG c (L d ms ))))) + = L l (ValD x (FunBind a b (MG c (L d ms')))) where ms' :: [LMatch GhcPs (LHsExpr GhcPs)] ms' = captureLineSpacing ms @@ -447,8 +447,8 @@ getEntryDP anns ast = -- --------------------------------------------------------------------- setEntryDPDecl :: LHsDecl GhcPs -> DeltaPos -> LHsDecl GhcPs -setEntryDPDecl decl@(L _ (ValD x (FunBind a b (MG c (L d ms )) f))) dp - = L l' (ValD x (FunBind a b (MG c (L d ms')) f)) +setEntryDPDecl decl@(L _ (ValD x (FunBind a b (MG c (L d ms ))))) dp + = L l' (ValD x (FunBind a b (MG c (L d ms')))) where L l' _ = setEntryDP' decl dp ms' :: [LMatch GhcPs (LHsExpr GhcPs)] @@ -552,8 +552,8 @@ transferEntryDP' la lb = do pushDeclDP :: HsDecl GhcPs -> DeltaPos -> HsDecl GhcPs -pushDeclDP (ValD x (FunBind a b (MG c (L d ms )) f)) dp - = ValD x (FunBind a b (MG c (L d' ms')) f) +pushDeclDP (ValD x (FunBind a b (MG c (L d ms )))) dp + = ValD x (FunBind a b (MG c (L d' ms'))) where L d' _ = setEntryDP' (L d ms) dp ms' :: [LMatch GhcPs (LHsExpr GhcPs)] @@ -623,7 +623,7 @@ balanceComments first second = do -- 'Match' if that 'Match' needs to be manipulated. balanceCommentsFB :: (Monad m) => LHsBind GhcPs -> LocatedA b -> TransformT m (LHsBind GhcPs, LocatedA b) -balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)) t)) second = do +balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)))) second = do logTr $ "balanceCommentsFB entered: " ++ showGhc (ss2range $ locA lf) -- There are comments on lf. We need to -- + Keep the prior ones here @@ -655,7 +655,7 @@ balanceCommentsFB (L lf (FunBind x n (MG o (L lm matches)) t)) second = do _ -> (m'',lf') logTr $ "balanceCommentsMatch done" -- return (L lf'' (FunBind x n (MG mx (L lm (reverse (m''':ms))) o) t), second') - balanceComments' (L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms)))) t)) second' + balanceComments' (L lf'' (FunBind x n (MG o (L lm (reverse (m''':ms)))))) second' balanceCommentsFB f s = balanceComments' f s -- | Move comments on the same line as the end of the match into the @@ -1221,7 +1221,7 @@ hsDeclsPatBindD x = error $ "hsDeclsPatBindD called for:" ++ showGhc x -- for 'hsDecls' \/ 'replaceDecls'. 'hsDeclsPatBind' \/ 'replaceDeclsPatBind' is -- idempotent. hsDeclsPatBind :: (Monad m) => LHsBind GhcPs -> TransformT m [LHsDecl GhcPs] -hsDeclsPatBind (L _ (PatBind _ _ (GRHSs _ _grhs lb) _)) = hsDeclsValBinds lb +hsDeclsPatBind (L _ (PatBind _ _ (GRHSs _ _grhs lb))) = hsDeclsValBinds lb hsDeclsPatBind x = error $ "hsDeclsPatBind called for:" ++ showGhc x -- ------------------------------------- @@ -1243,7 +1243,7 @@ replaceDeclsPatBindD x _ = error $ "replaceDeclsPatBindD called for:" ++ showGhc -- idempotent. replaceDeclsPatBind :: (Monad m) => LHsBind GhcPs -> [LHsDecl GhcPs] -> TransformT m (LHsBind GhcPs) -replaceDeclsPatBind (L l (PatBind x a (GRHSs xr rhss binds) b)) newDecls +replaceDeclsPatBind (L l (PatBind x a (GRHSs xr rhss binds))) newDecls = do logTr "replaceDecls PatBind" -- Need to throw in a fresh where clause if the binds were empty, @@ -1261,7 +1261,7 @@ replaceDeclsPatBind (L l (PatBind x a (GRHSs xr rhss binds) b)) newDecls -- modifyAnnsT (captureOrderAnnKey (mkAnnKey p) newDecls) binds'' <- replaceDeclsValbinds WithWhere binds newDecls -- let binds' = L (getLoc binds) binds'' - return (L l (PatBind x a (GRHSs xr rhss binds'') b)) + return (L l (PatBind x a (GRHSs xr rhss binds''))) replaceDeclsPatBind x _ = error $ "replaceDeclsPatBind called for:" ++ showGhc x -- --------------------------------------------------------------------- @@ -1372,7 +1372,7 @@ hsDeclsGeneric t = q t -- --------------------------------- lhsbind :: (Monad m) => LHsBind GhcPs -> TransformT m [LHsDecl GhcPs] - lhsbind (L _ (FunBind _ _ (MG _ (L _ matches)) _)) = do + lhsbind (L _ (FunBind _ _ (MG _ (L _ matches)))) = do dss <- mapM hsDecls matches return (concat dss) lhsbind p@(L _ (PatBind{})) = do diff --git a/utils/haddock b/utils/haddock -Subproject 8976930748c4c9ba19cede2f0f29037d1cbce5e +Subproject 7bd04379ada2d9ff1c406d258629f8abdf617b3 |