Commit ce2cc64f authored by Alan Zimmerman's avatar Alan Zimmerman Committed by Austin Seipp

Adding dedicated Show instances for SrcSpan/SrcLoc

Summary:
The derived Show instances for SrcSpan and SrcLoc are very verbose.

This patch replaces them with hand-made ones which use positional
syntax for the record constructors, rather than exhaustively listing
each one.

Test Plan: sh ./validate

Reviewers: austin

Reviewed By: austin

Subscribers: thomie, carter

Differential Revision: https://phabricator.haskell.org/D445
parent df22507f
......@@ -99,11 +99,11 @@ data RealSrcLoc
= SrcLoc FastString -- A precise location (file name)
{-# UNPACK #-} !Int -- line number, begins at 1
{-# UNPACK #-} !Int -- column number, begins at 1
deriving Show
data SrcLoc
= RealSrcLoc {-# UNPACK #-}!RealSrcLoc
| UnhelpfulLoc FastString -- Just a general indication
deriving Show
\end{code}
%************************************************************************
......@@ -259,8 +259,7 @@ data RealSrcSpan
srcSpanLine :: {-# UNPACK #-} !Int,
srcSpanCol :: {-# UNPACK #-} !Int
}
deriving (Eq, Typeable, Show) -- Show is used by Lexer.x, because we
-- derive Show for Token
deriving (Eq, Typeable)
data SrcSpan =
RealSrcSpan !RealSrcSpan
......@@ -433,6 +432,21 @@ instance Ord SrcSpan where
(srcSpanStart a `compare` srcSpanStart b) `thenCmp`
(srcSpanEnd a `compare` srcSpanEnd b)
instance Show RealSrcLoc where
show (SrcLoc filename row col)
= "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col
-- Show is used by Lexer.x, because we derive Show for Token
instance Show RealSrcSpan where
show (SrcSpanOneLine file l sc ec)
= "SrcSpanOneLine " ++ show file ++ " "
++ intercalate " " (map show [l,sc,ec])
show (SrcSpanMultiLine file sl sc el ec)
= "SrcSpanMultiLine " ++ show file ++ " "
++ intercalate " " (map show [sl,sc,el,ec])
show (SrcSpanPoint file l c)
= "SrcSpanPoint " ++ show file ++ " " ++ intercalate " " (map show [l,c])
instance Outputable RealSrcSpan where
ppr span = pprUserRealSpan True span
......
showsrcspan
*.hi
*.o
*.run.*
*.normalised
TOP=../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
clean:
rm -f *.o *.hi
showsrcspan: clean
'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc showsrcspan
./showsrcspan "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`"
.PHONY: clean
test('showsrcspan', normal, run_command, ['$MAKE -s --no-print-directory showsrcspan'])
\ No newline at end of file
module Main where
import Data.Data
import System.IO
import GHC
import FastString
import SrcLoc
import MonadUtils
import Outputable
import Bag (filterBag,isEmptyBag)
import System.Directory (removeFile)
import System.Environment( getArgs )
main::IO()
main = do
let
loc1 = mkSrcLoc (mkFastString "filename") 1 3
loc2 = mkSrcLoc (mkFastString "filename") 1 5
loc3 = mkSrcLoc (mkFastString "filename") 10 1
badLoc = mkGeneralSrcLoc (mkFastString "bad loc")
pointSpan = mkSrcSpan loc1 loc1
lineSpan = mkSrcSpan loc1 loc2
multiSpan = mkSrcSpan loc2 loc3
badSpan = mkGeneralSrcSpan (mkFastString "bad span")
print $ show loc1
print $ show loc2
print $ show badLoc
print $ show pointSpan
print $ show lineSpan
print $ show multiSpan
print $ show badSpan
"RealSrcLoc SrcLoc \"filename\" 1 3"
"RealSrcLoc SrcLoc \"filename\" 1 5"
"UnhelpfulLoc \"bad loc\""
"RealSrcSpan SrcSpanPoint \"filename\" 1 3"
"RealSrcSpan SrcSpanOneLine \"filename\" 1 3 5"
"RealSrcSpan SrcSpanMultiLine \"filename\" 1 5 10 1"
"UnhelpfulSpan \"bad span\""
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment