Make TcUnify warning-free
[ghc-hetmet.git] / compiler / basicTypes / SrcLoc.lhs
index fda74e0..7e43251 100644 (file)
@@ -38,11 +38,10 @@ module SrcLoc (
         leftmost_smallest, leftmost_largest, rightmost, spans, isSubspanOf
     ) where
 
-#include "HsVersions.h"
-
 import Util
 import Outputable
 import FastString
+import System.FilePath
 \end{code}
 
 %************************************************************************
@@ -56,8 +55,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
 
@@ -76,9 +75,9 @@ mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
 mkSrcLoc x line col = SrcLoc x line col
 
 noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
-noSrcLoc         = UnhelpfulLoc FSLIT("<no location info>")
-generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
-interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
+noSrcLoc         = UnhelpfulLoc (fsLit "<no location info>")
+generatedSrcLoc   = UnhelpfulLoc (fsLit "<compiler-generated code>")
+interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive session>")
 
 mkGeneralSrcLoc :: FastString -> SrcLoc
 mkGeneralSrcLoc = UnhelpfulLoc 
@@ -89,7 +88,7 @@ isGoodSrcLoc _other         = False
 
 srcLocFile :: SrcLoc -> FastString
 srcLocFile (SrcLoc fname _ _) = fname
-srcLocFile _other            = FSLIT("<unknown file")
+srcLocFile _other            = (fsLit "<unknown file")
 
 srcLocLine :: SrcLoc -> Int
 srcLocLine (SrcLoc _ l _) = l
@@ -129,17 +128,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 +165,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
@@ -195,8 +202,8 @@ instance Ord SrcSpan where
      (srcSpanEnd   a `compare` srcSpanEnd   b)
 
 noSrcSpan, wiredInSrcSpan :: SrcSpan
-noSrcSpan      = UnhelpfulSpan FSLIT("<no location info>")
-wiredInSrcSpan = UnhelpfulSpan FSLIT("<wired into compiler>")
+noSrcSpan      = UnhelpfulSpan (fsLit "<no location info>")
+wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")
 
 mkGeneralSrcSpan :: FastString -> SrcSpan
 mkGeneralSrcSpan = UnhelpfulSpan
@@ -304,22 +311,22 @@ combineSrcSpans   start end
 pprDefnLoc :: SrcSpan -> SDoc
 -- "defined at ..."
 pprDefnLoc loc
-  | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc
+  | isGoodSrcSpan loc = ptext (sLit "Defined at") <+> ppr loc
   | otherwise        = ppr loc
 
 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 +337,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 +345,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
         ]