[project @ 2000-10-12 13:11:45 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / SrcLoc.lhs

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index 5ebb9e6..5eaf8e6 100644 (file)
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ b/ghc/compiler/basicTypes/SrcLoc.lhs
@@ -21,9 +21,10 @@ module SrcLoc (
 
        mkGeneratedSrcLoc,      -- Code generated within the compiler
 
-       incSrcLine,
+       incSrcLine, replaceSrcLine,
        
-       srcLocFile              -- return the file name part.
+       srcLocFile,             -- return the file name part.
+       srcLocLine              -- return the line part.
     ) where
 
 #include "HsVersions.h"
@@ -31,6 +32,7 @@ module SrcLoc (
 import Util            ( thenCmp )
 import Outputable
 import FastString      ( unpackFS )
+import FastTypes
 import GlaExts         ( Int(..), (+#) )
 \end{code}
 
@@ -47,7 +49,7 @@ data SrcLoc
   = NoSrcLoc
 
   | SrcLoc     FAST_STRING     -- A precise location (file name)
-               FAST_INT
+               FastInt
 
   | UnhelpfulSrcLoc FAST_STRING        -- Just a general indication
 \end{code}
@@ -66,7 +68,7 @@ rare case.
 Things to make 'em:
 \begin{code}
 noSrcLoc           = NoSrcLoc
-mkSrcLoc x IBOX(y)  = SrcLoc x y
+mkSrcLoc x y        = SrcLoc x (iUnbox y)
 
 mkIfaceSrcLoc      = UnhelpfulSrcLoc SLIT("<an interface file>")
 mkBuiltinSrcLoc            = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
@@ -78,9 +80,15 @@ isNoSrcLoc other    = False
 srcLocFile :: SrcLoc -> FAST_STRING
 srcLocFile (SrcLoc fname _) = fname
 
+srcLocLine :: SrcLoc -> FastInt
+srcLocLine (SrcLoc _ l) = l
+
 incSrcLine :: SrcLoc -> SrcLoc
 incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
 incSrcLine loc         = loc
+
+replaceSrcLine :: SrcLoc -> FastInt -> SrcLoc
+replaceSrcLine (SrcLoc s _) l = SrcLoc s l
 \end{code}
 
 %************************************************************************
@@ -117,20 +125,16 @@ instance Outputable SrcLoc where
     ppr (SrcLoc src_path src_line)
       = getPprStyle $ \ sty ->
         if userStyle sty then
-          hcat [ text src_file, char ':', int IBOX(src_line) ]
+          hcat [ text src_file, char ':', int (iBox src_line) ]
        else
        if debugStyle sty then
-          hcat [ ptext src_path, char ':', int IBOX(src_line) ]
+          hcat [ ptext src_path, char ':', int (iBox src_line) ]
        else
-          hcat [text "{-# LINE ", int IBOX(src_line), space,
+          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
+       src_file = unpackFS src_path    -- Leave the directory prefix intact,
+                                       -- so emacs can find the file
 
     ppr (UnhelpfulSrcLoc s) = ptext s