diff options
Diffstat (limited to 'utils')
-rw-r--r-- | utils/check-exact/ExactPrint.hs | 51 | ||||
-rw-r--r-- | utils/check-exact/Main.hs | 7 | ||||
-rw-r--r-- | utils/check-exact/Orphans.hs | 2 | ||||
-rw-r--r-- | utils/check-exact/Transform.hs | 9 | ||||
-rw-r--r-- | utils/check-exact/Utils.hs | 19 |
5 files changed, 56 insertions, 32 deletions
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 52fb4136ec..57389565b4 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -114,6 +114,7 @@ defaultEPState = EPState , uExtraDP = Nothing , epComments = [] , epCommentsApplied = [] + , epEof = Nothing } @@ -188,6 +189,7 @@ data EPState = EPState -- Shared , epComments :: ![Comment] , epCommentsApplied :: ![[Comment]] + , epEof :: !(Maybe (RealSrcSpan, RealSrcSpan)) } -- --------------------------------------------------------------------- @@ -238,11 +240,7 @@ instance HasEntry (EpAnn a) where fromAnn' :: (HasEntry a) => a -> Entry fromAnn' an = case fromAnn an of NoEntryVal -> NoEntryVal - Entry a c _ u -> Entry a c' FlushComments u - where - c' = case c of - EpaComments cs -> EpaCommentsBalanced (filterEofComment False cs) (filterEofComment True cs) - EpaCommentsBalanced cp ct -> EpaCommentsBalanced cp ct + Entry a c _ u -> Entry a c FlushComments u -- --------------------------------------------------------------------- @@ -355,7 +353,7 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do let mflush = when (flush == FlushComments) $ do debugM $ "flushing comments in enterAnn:" ++ showAst cs - flushComments (getFollowingComments cs ++ filterEofComment True (priorComments cs)) + flushComments (getFollowingComments cs) advance edp a' <- exact a @@ -369,6 +367,17 @@ enterAnn (Entry anchor' cs flush canUpdateAnchor) a = do mapM_ printOneComment (map tokComment $ getFollowingComments cs) debugM $ "ending trailing comments" + eof <- getEofPos + case eof of + Nothing -> return () + Just (pos, prior) -> do + let dp = if pos == prior + then (DifferentLine 1 0) + else origDelta pos prior + debugM $ "EOF:(pos,prior,dp) =" ++ showGhc (ss2pos pos, ss2pos prior, dp) + printStringAtLsDelta dp "" + setEofPos Nothing -- Only do this once + let newAchor = anchor' { anchor_op = MovedAnchor edp } let r = case canUpdateAnchor of CanUpdateAnchor -> setAnnotationAnchor a' newAchor (mkEpaComments (priorCs++ postCs) []) @@ -413,23 +422,12 @@ addComments csNew = do -- ones in the state. flushComments :: (Monad m, Monoid w) => [LEpaComment] -> EP w m () flushComments trailing = do - addCommentsA (filterEofComment False trailing) + addCommentsA trailing cs <- getUnallocatedComments debugM $ "flushing comments starting" mapM_ printOneComment (sortComments cs) - debugM $ "flushing comments:EOF:trailing:" ++ showAst (trailing) - debugM $ "flushing comments:EOF:" ++ showAst (filterEofComment True trailing) - mapM_ printOneComment (map tokComment (filterEofComment True trailing)) debugM $ "flushing comments done" -filterEofComment :: Bool -> [LEpaComment] -> [LEpaComment] -filterEofComment keep cs = fixCs cs - where - notEof com = case com of - L _ (GHC.EpaComment (EpaEofComment) _) -> keep - _ -> not keep - fixCs c = filter notEof c - -- --------------------------------------------------------------------- -- |In order to interleave annotations into the stream, we turn them into @@ -1397,6 +1395,13 @@ instance ExactPrint (HsModule GhcPs) where EpAnnNotUsed -> (am_decls $ anns an0) EpAnn _ r _ -> r + -- Print EOF + case am_eof $ anns an of + Nothing -> return () + Just (pos, prior) -> do + debugM $ "am_eof:" ++ showGhc (pos, prior) + setEofPos (Just (pos, prior)) + let anf = an0 { anns = (anns an0) { am_decls = am_decls' }} debugM $ "HsModule, anf=" ++ showAst anf @@ -4761,7 +4766,7 @@ printStringAtLsDelta cl s = do -- `debug` ("printStringAtLsDelta:(pos,s):" ++ show (undelta p cl colOffset,s)) p' <- getPosP d <- getPriorEndD - debugM $ "printStringAtLsDelta:(pos,p',d,s):" ++ show (undelta p cl colOffset,p',d,s) + debugM $ "printStringAtLsDelta:(pos,p,p',d,s):" ++ show (undelta p cl colOffset,p,p',d,s) else return () `debug` ("printStringAtLsDelta:bad delta for (mc,s):" ++ show (cl,s)) -- --------------------------------------------------------------------- @@ -4873,6 +4878,14 @@ setAnchorU rss = do debugM $ "setAnchorU:" ++ show (rs2range rss) modify (\s -> s { uAnchorSpan = rss }) +getEofPos :: (Monad m, Monoid w) => EP w m (Maybe (RealSrcSpan, RealSrcSpan)) +getEofPos = gets epEof + +setEofPos :: (Monad m, Monoid w) => Maybe (RealSrcSpan, RealSrcSpan) -> EP w m () +setEofPos l = modify (\s -> s {epEof = l}) + +-- --------------------------------------------------------------------- + getUnallocatedComments :: (Monad m, Monoid w) => EP w m [Comment] getUnallocatedComments = gets epComments diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index 87921ac3e8..f286355cc1 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -36,7 +36,8 @@ import GHC.Data.FastString -- --------------------------------------------------------------------- _tt :: IO () -_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/" +_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_build/stage1/lib/" +-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib/" -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib" -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib" @@ -58,7 +59,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2) -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3) -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls) - -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2) + "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2) -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" (Just changeWhereIn3a) -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" (Just changeWhereIn3b) -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" (Just addLocaLDecl1) @@ -194,7 +195,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/ -- "../../testsuite/tests/printer/Test19834.hs" Nothing -- "../../testsuite/tests/printer/Test19840.hs" Nothing -- "../../testsuite/tests/printer/Test19850.hs" Nothing - "../../testsuite/tests/printer/Test20258.hs" Nothing + -- "../../testsuite/tests/printer/Test20258.hs" Nothing -- "../../testsuite/tests/printer/PprLinearArrow.hs" Nothing -- "../../testsuite/tests/printer/PprSemis.hs" Nothing -- "../../testsuite/tests/printer/PprEmptyMostly.hs" Nothing diff --git a/utils/check-exact/Orphans.hs b/utils/check-exact/Orphans.hs index 1403324861..f6000288b0 100644 --- a/utils/check-exact/Orphans.hs +++ b/utils/check-exact/Orphans.hs @@ -89,4 +89,4 @@ instance Default EpAnnSumPat where def = EpAnnSumPat def def def instance Default AnnsModule where - def = AnnsModule [] mempty + def = AnnsModule [] mempty Nothing diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs index 13c089eb71..3e3ebdcb39 100644 --- a/utils/check-exact/Transform.hs +++ b/utils/check-exact/Transform.hs @@ -709,15 +709,6 @@ commentOrigDelta (L (GHC.Anchor la _) (GHC.EpaComment t pp)) -- --------------------------------------------------------------------- - --- | For comment-related deltas starting on a new line we have an --- off-by-one problem. Adjust -tweakDelta :: DeltaPos -> DeltaPos -tweakDelta (SameLine d) = SameLine d -tweakDelta (DifferentLine l d) = DifferentLine l (d-1) - --- --------------------------------------------------------------------- - balanceSameLineComments :: (Monad m) => LMatch GhcPs (LHsExpr GhcPs) -> TransformT m (LMatch GhcPs (LHsExpr GhcPs)) balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs index 91d9cd5827..b60c989bcf 100644 --- a/utils/check-exact/Utils.hs +++ b/utils/check-exact/Utils.hs @@ -172,6 +172,25 @@ isPointSrcSpan ss = spanLength ss == 0 -- --------------------------------------------------------------------- +origDelta :: RealSrcSpan -> RealSrcSpan -> DeltaPos +origDelta pos pp = op + where + (r,c) = ss2posEnd pp + + op = if r == 0 + then ( ss2delta (r,c+1) pos) + else (tweakDelta $ ss2delta (r,c ) pos) + +-- --------------------------------------------------------------------- + +-- | For comment-related deltas starting on a new line we have an +-- off-by-one problem. Adjust +tweakDelta :: DeltaPos -> DeltaPos +tweakDelta (SameLine d) = SameLine d +tweakDelta (DifferentLine l d) = DifferentLine l (d-1) + +-- --------------------------------------------------------------------- + -- |Given a list of items and a list of keys, returns a list of items -- ordered by their position in the list of keys. orderByKey :: [(RealSrcSpan,a)] -> [RealSrcSpan] -> [(RealSrcSpan,a)] |