From eb392f1320df45d3d678ad682f5e91769f71935d Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Sat, 20 Feb 2021 18:17:24 +0000
Subject: Add some utility functions to GHC.Types.SrcLoc

pprUserSpan, isZeroWidthSpan, pprLocated, combineRealSrcSpans
---
 compiler/GHC/Types/SrcLoc.hs | 31 ++++++++++++++++++++++++++-----
 1 file 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
 
-- 
cgit v1.2.1