[commit: ghc] master: Adding dedicated Show instances for SrcSpan/SrcLoc (ce2cc64)
git at git.haskell.org
git at git.haskell.org
Tue Nov 18 01:20:12 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/ce2cc64f0b4c447bf83fd0d0b260f00126a0c4d6/ghc
>---------------------------------------------------------------
commit ce2cc64f0b4c447bf83fd0d0b260f00126a0c4d6
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date: Mon Nov 17 19:19:10 2014 -0600
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
>---------------------------------------------------------------
ce2cc64f0b4c447bf83fd0d0b260f00126a0c4d6
compiler/basicTypes/SrcLoc.lhs | 20 +++++++++++--
.../ghc-api/{landmines => show-srcspan}/.gitignore | 2 +-
testsuite/tests/ghc-api/show-srcspan/Makefile | 13 +++++++++
testsuite/tests/ghc-api/show-srcspan/all.T | 1 +
.../tests/ghc-api/show-srcspan/showsrcspan.hs | 33 ++++++++++++++++++++++
.../tests/ghc-api/show-srcspan/showsrcspan.stdout | 7 +++++
6 files changed, 72 insertions(+), 4 deletions(-)
diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 6b46454..c7e1fbe 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -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
diff --git a/testsuite/tests/ghc-api/landmines/.gitignore b/testsuite/tests/ghc-api/show-srcspan/.gitignore
similarity index 71%
copy from testsuite/tests/ghc-api/landmines/.gitignore
copy to testsuite/tests/ghc-api/show-srcspan/.gitignore
index 1452e78..e135b85 100644
--- a/testsuite/tests/ghc-api/landmines/.gitignore
+++ b/testsuite/tests/ghc-api/show-srcspan/.gitignore
@@ -1,4 +1,4 @@
-landmines
+showsrcspan
*.hi
*.o
*.run.*
diff --git a/testsuite/tests/ghc-api/show-srcspan/Makefile b/testsuite/tests/ghc-api/show-srcspan/Makefile
new file mode 100644
index 0000000..e467b61
--- /dev/null
+++ b/testsuite/tests/ghc-api/show-srcspan/Makefile
@@ -0,0 +1,13 @@
+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
diff --git a/testsuite/tests/ghc-api/show-srcspan/all.T b/testsuite/tests/ghc-api/show-srcspan/all.T
new file mode 100644
index 0000000..fbb8d04
--- /dev/null
+++ b/testsuite/tests/ghc-api/show-srcspan/all.T
@@ -0,0 +1 @@
+test('showsrcspan', normal, run_command, ['$MAKE -s --no-print-directory showsrcspan'])
\ No newline at end of file
diff --git a/testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs b/testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs
new file mode 100644
index 0000000..bf73b59
--- /dev/null
+++ b/testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs
@@ -0,0 +1,33 @@
+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
diff --git a/testsuite/tests/ghc-api/show-srcspan/showsrcspan.stdout b/testsuite/tests/ghc-api/show-srcspan/showsrcspan.stdout
new file mode 100644
index 0000000..f896565
--- /dev/null
+++ b/testsuite/tests/ghc-api/show-srcspan/showsrcspan.stdout
@@ -0,0 +1,7 @@
+"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\""
More information about the ghc-commits
mailing list