[project @ 2000-04-20 12:50:18 by simonpj]

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

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index 4261e5d..3dccd51 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,9 +8,7 @@
 %************************************************************************
 
 \begin{code}
-#include "HsVersions.h"
-
-module SrcLoc {- (
+module SrcLoc (
        SrcLoc,                 -- Abstract
 
        mkSrcLoc,
@@ -21,15 +19,20 @@ module SrcLoc {- (
 
        mkBuiltinSrcLoc,        -- Something wired into the compiler
 
-       mkGeneratedSrcLoc       -- Code generated within the compiler
-    ) -} where
+       mkGeneratedSrcLoc,      -- Code generated within the compiler
 
-IMP_Ubiq()
+       incSrcLine, replaceSrcLine,
+       
+       srcLocFile,             -- return the file name part.
+       srcLocLine              -- return the line part.
+    ) where
 
-import Outputable
-import PprStyle                ( PprStyle(..), userStyle )
-import Pretty
+#include "HsVersions.h"
 
+import Util            ( thenCmp )
+import Outputable
+import FastString      ( unpackFS )
+import GlaExts         ( Int(..), (+#) )
 \end{code}
 
 %************************************************************************
@@ -44,7 +47,7 @@ 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
@@ -72,6 +75,19 @@ mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
 
 isNoSrcLoc NoSrcLoc = True
 isNoSrcLoc other    = False
+
+srcLocFile :: SrcLoc -> FAST_STRING
+srcLocFile (SrcLoc fname _) = fname
+
+srcLocLine :: SrcLoc -> FAST_INT
+srcLocLine (SrcLoc _ l) = l
+
+incSrcLine :: SrcLoc -> SrcLoc
+incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
+incSrcLine loc         = loc
+
+replaceSrcLine :: SrcLoc -> FAST_INT -> SrcLoc
+replaceSrcLine (SrcLoc s _) l = SrcLoc s l
 \end{code}
 
 %************************************************************************
@@ -81,21 +97,45 @@ isNoSrcLoc other    = False
 %************************************************************************
 
 \begin{code}
+-- SrcLoc is an instance of Ord so that we can sort error messages easily
+instance Eq SrcLoc where
+  loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
+                  EQ    -> True
+                  other -> False
+
+instance Ord SrcLoc where
+  compare = cmpSrcLoc
+
+cmpSrcLoc NoSrcLoc NoSrcLoc = EQ
+cmpSrcLoc NoSrcLoc other    = LT
+
+cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
+cmpSrcLoc (UnhelpfulSrcLoc s1) other               = GT
+
+cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc           = GT
+cmpSrcLoc (SrcLoc s1 l1) (UnhelpfulSrcLoc _) = LT
+cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2)      = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2)
+                                            where
+                                               l1 `cmpline` l2 | l1 <#  l2 = LT
+                                                               | l1 ==# l2 = EQ
+                                                               | otherwise = GT 
+                                         
 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 = unpackFS src_path    -- Leave the directory prefix intact,
+                                       -- so emacs can find the file
+
+    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("\" #-}")]
--}