[project @ 1999-01-18 19:04:55 by sof]

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

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index e745378..6962b92 100644 (file)
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ b/ghc/compiler/basicTypes/SrcLoc.lhs
@@ -1,5 +1,5 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994
+% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 %************************************************************************
 %*                                                                     *
@@ -8,8 +8,6 @@
 %************************************************************************
 
 \begin{code}
-#include "HsVersions.h"
-
 module SrcLoc (
        SrcLoc,                 -- Abstract
 
@@ -21,13 +19,18 @@ module SrcLoc (
 
        mkBuiltinSrcLoc,        -- Something wired into the compiler
 
-       mkGeneratedSrcLoc       -- Code generated within the compiler
+       mkGeneratedSrcLoc,      -- Code generated within the compiler
+
+       incSrcLine,
+       
+       srcLocFile              -- return the file name part.
     ) where
 
-IMP_Ubiq()
+#include "HsVersions.h"
 
-import PprStyle                ( PprStyle(..) )
-import Pretty
+import Outputable
+import FastString      ( unpackFS )
+import GlaExts         ( Int(..), (+#) )
 \end{code}
 
 %************************************************************************
@@ -42,10 +45,23 @@ this is the obvious stuff:
 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
+
+instance Ord SrcLoc where
+  compare NoSrcLoc NoSrcLoc           = EQ
+  compare NoSrcLoc _                 = GT
+  compare (UnhelpfulSrcLoc _) (UnhelpfulSrcLoc _) = EQ
+  compare (UnhelpfulSrcLoc _) _       = GT
+  compare _ NoSrcLoc                  = LT
+  compare _ (UnhelpfulSrcLoc _)       = LT
+  compare (SrcLoc _ y1) (SrcLoc _ y2) = compare IBOX(y1) IBOX(y2) 
+
+instance Eq SrcLoc where
+  (==) x y = compare x y == EQ
+  
 \end{code}
 
 Note that an entity might be imported via more than one route, and
@@ -70,6 +86,13 @@ mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
 
 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}
 
 %************************************************************************
@@ -80,19 +103,25 @@ isNoSrcLoc other    = False
 
 \begin{code}
 instance Outputable SrcLoc where
-    ppr PprForUser (SrcLoc src_file src_line)
-      = ppBesides [ ppPStr src_file, ppChar ':', ppStr (show IBOX(src_line)) ]
-
-    ppr sty (SrcLoc src_file src_line)
-      = ppBesides [ppStr "{-# LINE ", ppStr (show IBOX(src_line)), ppSP,
-                  ppChar '\"', ppPStr src_file, ppStr " #-}"]
-    ppr sty (UnhelpfulSrcLoc s) = ppPStr s
-
-    ppr sty NoSrcLoc = ppStr "<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}
-
-{-
-      = ppBesides [ppPStr SLIT("{-# LINE "), ppStr (show IBOX(src_line)), ppSP,
-                  ppChar '"', ppPStr src_file, ppPStr SLIT(" #-}")]
- --ppPStr SLIT("\" #-}")]
--}