%
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
%************************************************************************
%* *
%************************************************************************
\begin{code}
-#include "HsVersions.h"
-
-module SrcLoc {- (
+module SrcLoc (
SrcLoc, -- Abstract
mkSrcLoc,
mkBuiltinSrcLoc, -- Something wired into the compiler
- mkGeneratedSrcLoc -- Code generated within the compiler
- ) -} where
+ mkGeneratedSrcLoc, -- Code generated within the compiler
-IMP_Ubiq()
+ incSrcLine,
+
+ srcLocFile -- return the file name part.
+ ) where
-import Outputable
-import Pretty
+#include "HsVersions.h"
+import Outputable
+import FastString ( unpackFS )
+import GlaExts ( Int(..), (+#) )
\end{code}
%************************************************************************
data SrcLoc
= NoSrcLoc
- | SrcLoc FAST_STRING -- A precise location
+ | SrcLoc FAST_STRING -- A precise location (file name)
FAST_INT
| UnhelpfulSrcLoc FAST_STRING -- Just a general indication
isNoSrcLoc NoSrcLoc = True
isNoSrcLoc other = False
+
+srcLocFile :: SrcLoc -> FAST_STRING
+srcLocFile (SrcLoc fname _) = fname
+
+incSrcLine :: SrcLoc -> SrcLoc
+incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
+incSrcLine loc = loc
\end{code}
%************************************************************************
\begin{code}
instance Outputable SrcLoc where
- ppr sty (SrcLoc src_file src_line)
- | userStyle sty
- = hcat [ ptext src_file, char ':', text (show IBOX(src_line)) ]
-
- | otherwise
- = hcat [text "{-# LINE ", text (show IBOX(src_line)), space,
- char '\"', ptext src_file, text " #-}"]
- ppr sty (UnhelpfulSrcLoc s) = ptext s
-
- ppr sty NoSrcLoc = text "<NoSrcLoc>"
+ ppr (SrcLoc src_path src_line)
+ = getPprStyle $ \ sty ->
+ if userStyle sty then
+ hcat [ text src_file, char ':', int IBOX(src_line) ]
+ else
+ if debugStyle sty then
+ hcat [ ptext src_path, char ':', int IBOX(src_line) ]
+ else
+ hcat [text "{-# LINE ", int IBOX(src_line), space,
+ char '\"', ptext src_path, text " #-}"]
+ where
+ src_file = remove_directory_prefix (unpackFS src_path)
+
+ remove_directory_prefix path = case break (== '/') path of
+ (filename, []) -> filename
+ (prefix, slash : rest) -> ASSERT( slash == '/' )
+ remove_directory_prefix rest
+
+ ppr (UnhelpfulSrcLoc s) = ptext s
+
+ ppr NoSrcLoc = text "<NoSrcLoc>"
\end{code}
-
-{-
- = hcat [ptext SLIT("{-# LINE "), text (show IBOX(src_line)), space,
- char '"', ptext src_file, ptext SLIT(" #-}")]
- --ptext SLIT("\" #-}")]
--}