diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-02-20 18:17:24 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-28 05:38:29 -0500 |
| commit | 980151aa61a63f2c3d52de0a5fe2198d8e609471 (patch) | |
| tree | 5ae52aceaadcba08b16ead10869368a17c441267 | |
| parent | 0f2891f01854b36ae190ccb2565f6ff9876b74c0 (diff) | |
| download | haskell-980151aa61a63f2c3d52de0a5fe2198d8e609471.tar.gz | |
Add some utility functions to GHC.Types.SrcLoc
pprUserSpan, isZeroWidthSpan, pprLocated, combineRealSrcSpans
| -rw-r--r-- | compiler/GHC/Types/SrcLoc.hs | 31 |
1 files changed, 26 insertions, 5 deletions
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs index 38c7872358..7dd7b297e3 100644 --- a/compiler/GHC/Types/SrcLoc.hs +++ b/compiler/GHC/Types/SrcLoc.hs @@ -49,6 +49,7 @@ module GHC.Types.SrcLoc ( realSrcSpanStart, realSrcSpanEnd, srcSpanFileName_maybe, pprUserRealSpan, pprUnhelpfulSpanReason, + pprUserSpan, unhelpfulSpanFS, -- ** Unsafely deconstructing SrcSpan @@ -58,7 +59,7 @@ module GHC.Types.SrcLoc ( srcSpanStartCol, srcSpanEndCol, -- ** Predicates on SrcSpan - isGoodSrcSpan, isOneLineSpan, + isGoodSrcSpan, isOneLineSpan, isZeroWidthSpan, containsSpan, -- * StringBuffer locations @@ -79,6 +80,7 @@ module GHC.Types.SrcLoc ( -- ** Deconstructing Located getLoc, unLoc, unRealSrcSpan, getRealSrcSpan, + pprLocated, -- ** Modifying Located mapLoc, @@ -102,6 +104,7 @@ module GHC.Types.SrcLoc ( psSpanStart, psSpanEnd, mkSrcSpanPs, + combineRealSrcSpans, -- * Layout information LayoutInfo(..), @@ -543,6 +546,14 @@ isOneLineSpan :: SrcSpan -> Bool isOneLineSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s isOneLineSpan (UnhelpfulSpan _) = False +isZeroWidthSpan :: SrcSpan -> Bool +-- ^ True if the span has a width of zero, as returned for "virtual" +-- semicolons in the lexer. +-- For "bad" 'SrcSpan', it returns False +isZeroWidthSpan (RealSrcSpan s _) = srcSpanStartLine s == srcSpanEndLine s + && srcSpanStartCol s == srcSpanEndCol s +isZeroWidthSpan (UnhelpfulSpan _) = False + -- | Tests whether the first span "contains" the other span, meaning -- that it covers at least as much source code. True where spans are equal. containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool @@ -764,11 +775,21 @@ cmpBufSpan (L l1 _) (L l2 _) | otherwise = panic "cmpBufSpan: no BufSpan" -instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where - ppr (L l e) = -- TODO: We can't do this since Located was refactored into - -- GenLocated: +instance (Outputable e) => Outputable (Located e) where + ppr (L l e) = -- GenLocated: + -- Print spans without the file name etc + whenPprDebug (braces (pprUserSpan False l)) + $$ ppr e +instance (Outputable e) => Outputable (GenLocated RealSrcSpan e) where + ppr (L l e) = -- GenLocated: + -- Print spans without the file name etc + whenPprDebug (braces (pprUserSpan False (RealSrcSpan l Nothing))) + $$ ppr e + + +pprLocated :: (Outputable l, Outputable e) => GenLocated l e -> SDoc +pprLocated (L l e) = -- Print spans without the file name etc - -- ifPprDebug (braces (pprUserSpan False l)) whenPprDebug (braces (ppr l)) $$ ppr e |