[Git][ghc/ghc][wip/match-pat] Update check-exact
Vladislav Zavialov (@int-index)
gitlab at gitlab.haskell.org
Sun Aug 27 06:20:28 UTC 2023
Vladislav Zavialov pushed to branch wip/match-pat at Glasgow Haskell Compiler / GHC
Commits:
d3bbd68b by Vladislav Zavialov at 2023-08-27T09:15:53+03:00
Update check-exact
- - - - -
3 changed files:
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Transform.hs
Changes:
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -2179,7 +2179,7 @@ instance ExactPrint (RecordPatSynField GhcPs) where
-- ---------------------------------------------------------------------
-instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where
+instance ExactPrint (Match GhcPs (LocatedA (Pat GhcPs)) (LocatedA (HsCmd GhcPs))) where
getAnnotationEntry (Match ann _ _ _) = fromAnn ann
setAnnotationAnchor (Match an a b c) anc cs = Match (setAnchorEpa an anc cs) a b c
@@ -2188,7 +2188,7 @@ instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where
-- -------------------------------------
-instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where
+instance ExactPrint (Match GhcPs (LocatedA (Pat GhcPs)) (LocatedA (HsExpr GhcPs))) where
getAnnotationEntry (Match ann _ _ _) = fromAnn ann
setAnnotationAnchor (Match an a b c) anc cs = Match (setAnchorEpa an anc cs) a b c
@@ -2197,7 +2197,10 @@ instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where
-- ---------------------------------------------------------------------
-exactMatch :: (Monad m, Monoid w) => (ExactPrint (GRHSs GhcPs body)) => (Match GhcPs body) -> EP w m (Match GhcPs body)
+exactMatch :: (Monad m, Monoid w)
+ => (ExactPrint pat, ExactPrint (GRHSs GhcPs body))
+ => (Match GhcPs pat body)
+ -> EP w m (Match GhcPs pat body)
exactMatch (Match an mctxt pats grhss) = do
debugM $ "exact Match entered"
@@ -3053,7 +3056,7 @@ instance ExactPrint (HsUntypedSplice GhcPs) where
-- ---------------------------------------------------------------------
-- TODO:AZ: combine these instances
-instance ExactPrint (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where
+instance ExactPrint (MatchGroup GhcPs (LocatedA (Pat GhcPs)) (LocatedA (HsExpr GhcPs))) where
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ = a
exact (MG x matches) = do
@@ -3063,7 +3066,7 @@ instance ExactPrint (MatchGroup GhcPs (LocatedA (HsExpr GhcPs))) where
else return matches
return (MG x matches')
-instance ExactPrint (MatchGroup GhcPs (LocatedA (HsCmd GhcPs))) where
+instance ExactPrint (MatchGroup GhcPs (LocatedA (Pat GhcPs)) (LocatedA (HsCmd GhcPs))) where
getAnnotationEntry = const NoEntryVal
setAnnotationAnchor a _ _ = a
exact (MG x matches) = do
@@ -4400,8 +4403,8 @@ instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where
(an1, ies') <- markAnnList an0 (markAnnotated ies)
return (L (SrcSpanAnn an1 l) ies')
-instance (ExactPrint (Match GhcPs (LocatedA body)))
- => ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA body))]) where
+instance (ExactPrint (Match GhcPs (LocatedA pat) (LocatedA body)))
+ => ExactPrint (LocatedL [LocatedA (Match GhcPs (LocatedA pat) (LocatedA body))]) where
getAnnotationEntry = entryFromLocatedA
setAnnotationAnchor = setAnchorAn
exact (L la a) = do
=====================================
utils/check-exact/Main.hs
=====================================
@@ -512,8 +512,8 @@ changeLocalDecls libdir (L l p) = do
let sig' = setEntryDP (L ls sig) (SameLine 0)
let (p',_,_w) = runTransform doAddLocal
doAddLocal = everywhereM (mkM replaceLocalBinds) p
- replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
- -> Transform (LMatch GhcPs (LHsExpr GhcPs))
+ replaceLocalBinds :: LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs)
+ -> Transform (LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs))
replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds van (ValBinds _ binds sigs))))) = do
let oldDecls = sortLocatedA $ map wrapDecl (bagToList binds) ++ map wrapSig sigs
let decls = s:d:oldDecls
@@ -543,8 +543,8 @@ changeLocalDecls2 libdir (L l p) = do
let sig' = setEntryDP (L ls sig) (SameLine 2)
let (p',_,_w) = runTransform doAddLocal
doAddLocal = everywhereM (mkM replaceLocalBinds) p
- replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
- -> Transform (LMatch GhcPs (LHsExpr GhcPs))
+ replaceLocalBinds :: LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs)
+ -> Transform (LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs))
replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do
newSpan <- uniqueSrcSpanT
let anc = (Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 2)))
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -187,7 +187,7 @@ captureMatchLineSpacing :: LHsDecl GhcPs -> LHsDecl GhcPs
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' :: [LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs)]
ms' = captureLineSpacing ms
captureMatchLineSpacing d = d
@@ -245,7 +245,7 @@ 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)]
+ ms' :: [LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs)]
ms' = case ms of
[] -> []
(m0':ms0) -> setEntryDP m0' dp : ms0
@@ -375,7 +375,7 @@ 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)]
+ ms' :: [LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs)]
ms' = case ms of
[] -> []
(m0':ms0) -> setEntryDP m0' dp : ms0
@@ -452,7 +452,7 @@ balanceCommentsFB f s = balanceComments' f s
-- | Move comments on the same line as the end of the match into the
-- GRHS, prior to the binds
balanceCommentsMatch :: (Monad m)
- => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
+ => LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs))
balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds))) = do
logTr $ "balanceCommentsMatch: (logInfo)=" ++ showAst (logInfo)
return (L l'' (Match am mctxt pats (GRHSs xg grhss' binds')))
@@ -683,7 +683,7 @@ commentOrigDelta (L (GHC.Anchor la _) (GHC.EpaComment t pp))
-- ---------------------------------------------------------------------
balanceSameLineComments :: (Monad m)
- => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs))
+ => LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs))
balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do
logTr $ "balanceSameLineComments: (la)=" ++ showGhc (ss2range $ locA la)
logTr $ "balanceSameLineComments: [logInfo]=" ++ showAst logInfo
@@ -877,7 +877,7 @@ instance HasDecls (LocatedA (HsDecl GhcPs)) where
-- ---------------------------------------------------------------------
-instance HasDecls (LocatedA (Match GhcPs (LocatedA (HsExpr GhcPs)))) where
+instance HasDecls (LocatedA (Match GhcPs (LocatedA (Pat GhcPs)) (LocatedA (HsExpr GhcPs)))) where
hsDecls (L _ (Match _ _ _ (GRHSs _ _ lb))) = return $ hsDeclsLocalBinds lb
replaceDecls (L l (Match xm c p (GRHSs xr rhs binds))) []
@@ -1101,7 +1101,7 @@ newWhereAnnotation ww = do
-- ---------------------------------------------------------------------
type Decl = LHsDecl GhcPs
-type PMatch = LMatch GhcPs (LHsExpr GhcPs)
+type PMatch = LMatch GhcPs (LPat GhcPs) (LHsExpr GhcPs)
-- |Modify a 'LHsBind' wrapped in a 'ValD'. For a 'PatBind' the
-- declarations are extracted and returned after modification. For a
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3bbd68b9306aa91a53e455701bc86fc84abed3c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d3bbd68b9306aa91a53e455701bc86fc84abed3c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230827/7e198535/attachment-0001.html>
More information about the ghc-commits
mailing list