X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=cf68b79ae796e3e6db77e618adb7cb9fd565db06;hb=3d5970436af5ab73957278671059e00d1a52c616;hp=fda74e0110055155684e996a7fbab760c0549aca;hpb=e932508283461bfc5b6658a374fd6e9126979e49;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index fda74e0..cf68b79 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -43,6 +43,7 @@ module SrcLoc (
 import Util
 import Outputable
 import FastString
+import System.FilePath
 \end{code}
 
 %************************************************************************
@@ -56,8 +57,8 @@ this is the obvious stuff:
 \begin{code}
 data SrcLoc
   = SrcLoc	FastString	-- A precise location (file name)
-		!Int		-- line number, begins at 1
-		!Int		-- column number, begins at 0
+		{-# UNPACK #-} !Int		-- line number, begins at 1
+		{-# UNPACK #-} !Int		-- column number, begins at 0
 		-- Don't ask me why lines start at 1 and columns start at
 		-- zero.  That's just the way it is, so there.  --SDM
 
@@ -129,17 +130,20 @@ cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
   = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
 cmpSrcLoc (SrcLoc _ _ _) _other = GT
 
+pprFastFilePath :: FastString -> SDoc
+pprFastFilePath path = text $ normalise $ unpackFS path
+
 instance Outputable SrcLoc where
     ppr (SrcLoc src_path src_line src_col)
       = getPprStyle $ \ sty ->
         if userStyle sty || debugStyle sty then
-	   hcat [ ftext src_path, char ':', 
-		  int src_line,
-		  char ':', int src_col
-		]
-	else
-	   hcat [text "{-# LINE ", int src_line, space,
-		 char '\"', ftext src_path, text " #-}"]
+            hcat [ pprFastFilePath src_path, char ':', 
+                   int src_line,
+                   char ':', int src_col
+                 ]
+        else
+            hcat [text "{-# LINE ", int src_line, space,
+                  char '\"', pprFastFilePath src_path, text " #-}"]
 
     ppr (UnhelpfulLoc s)  = ftext s
 \end{code}
@@ -163,30 +167,35 @@ span of (1,1)-(1,1) is zero characters long.
 -}
 data SrcSpan
   = SrcSpanOneLine 		-- a common case: a single line
-	{ srcSpanFile     :: FastString,
-	  srcSpanLine     :: !Int,
-	  srcSpanSCol     :: !Int,
-	  srcSpanECol     :: !Int
+	{ srcSpanFile     :: !FastString,
+	  srcSpanLine     :: {-# UNPACK #-} !Int,
+	  srcSpanSCol     :: {-# UNPACK #-} !Int,
+	  srcSpanECol     :: {-# UNPACK #-} !Int
 	}
 
   | SrcSpanMultiLine
-	{ srcSpanFile	  :: FastString,
-	  srcSpanSLine    :: !Int,
-	  srcSpanSCol	  :: !Int,
-	  srcSpanELine    :: !Int,
-	  srcSpanECol     :: !Int
+	{ srcSpanFile	  :: !FastString,
+	  srcSpanSLine    :: {-# UNPACK #-} !Int,
+	  srcSpanSCol	  :: {-# UNPACK #-} !Int,
+	  srcSpanELine    :: {-# UNPACK #-} !Int,
+	  srcSpanECol     :: {-# UNPACK #-} !Int
 	}
 
   | SrcSpanPoint
-	{ srcSpanFile	  :: FastString,
-	  srcSpanLine	  :: !Int,
-	  srcSpanCol      :: !Int
+	{ srcSpanFile	  :: !FastString,
+	  srcSpanLine	  :: {-# UNPACK #-} !Int,
+	  srcSpanCol      :: {-# UNPACK #-} !Int
 	}
 
-  | UnhelpfulSpan FastString	-- Just a general indication
+  | UnhelpfulSpan !FastString	-- Just a general indication
 				-- also used to indicate an empty span
 
+#ifdef DEBUG
+  deriving (Eq, Show)	-- Show is used by Lexer.x, becuase we
+			-- derive Show for Token
+#else
   deriving Eq
+#endif
 
 -- We want to order SrcSpans first by the start point, then by the end point.
 instance Ord SrcSpan where
@@ -311,15 +320,15 @@ instance Outputable SrcSpan where
     ppr span
       = getPprStyle $ \ sty ->
         if userStyle sty || debugStyle sty then
-	   pprUserSpan span
-	else
-	   hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
-		 char '\"', ftext (srcSpanFile span), text " #-}"]
+           pprUserSpan span
+        else
+           hcat [text "{-# LINE ", int (srcSpanStartLine span), space,
+                 char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"]
 
 
 pprUserSpan :: SrcSpan -> SDoc
 pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
-  = hcat [ ftext src_path, char ':', 
+  = hcat [ pprFastFilePath src_path, char ':', 
 	   int line,
 	   char ':', int start_col
 	 ]
@@ -330,7 +339,7 @@ pprUserSpan (SrcSpanOneLine src_path line start_col end_col)
 	  else  char '-' <> int (end_col-1)
 
 pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
-  = hcat [ ftext src_path, char ':', 
+  = hcat [ pprFastFilePath src_path, char ':', 
 		  parens (int sline <> char ',' <>  int scol),
 		  char '-',
 		  parens (int eline <> char ',' <>  
@@ -338,7 +347,7 @@ pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol)
 		]
 
 pprUserSpan (SrcSpanPoint src_path line col)
-  = hcat [ ftext src_path, char ':', 
+  = hcat [ pprFastFilePath src_path, char ':', 
 	   int line,
 	   char ':', int col
 	 ]