Adding dedicated Show instances for SrcSpan/SrcLoc
authorAlan Zimmerman <alan.zimm@gmail.com>
Tue, 18 Nov 2014 01:19:10 +0000 (19:19 -0600)
committerAustin Seipp <austin@well-typed.com>
Tue, 18 Nov 2014 01:19:10 +0000 (19:19 -0600)
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

compiler/basicTypes/SrcLoc.lhs
testsuite/tests/ghc-api/show-srcspan/.gitignore [new file with mode: 0644]
testsuite/tests/ghc-api/show-srcspan/Makefile [new file with mode: 0644]
testsuite/tests/ghc-api/show-srcspan/all.T [new file with mode: 0644]
testsuite/tests/ghc-api/show-srcspan/showsrcspan.hs [new file with mode: 0644]
testsuite/tests/ghc-api/show-srcspan/showsrcspan.stdout [new file with mode: 0644]

index 6b46454..c7e1fbe 100644 (file)
@@ -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/show-srcspan/.gitignore b/testsuite/tests/ghc-api/show-srcspan/.gitignore
new file mode 100644 (file)
index 0000000..e135b85
--- /dev/null
@@ -0,0 +1,5 @@
+showsrcspan
+*.hi
+*.o
+*.run.*
+*.normalised
diff --git a/testsuite/tests/ghc-api/show-srcspan/Makefile b/testsuite/tests/ghc-api/show-srcspan/Makefile
new file mode 100644 (file)
index 0000000..e467b61
--- /dev/null
@@ -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 (file)
index 0000000..fbb8d04
--- /dev/null
@@ -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 (file)
index 0000000..bf73b59
--- /dev/null
@@ -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 (file)
index 0000000..f896565
--- /dev/null
@@ -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\""