X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=7e29d67bcc77f171778827a1c2643c46e0cc33dd;hb=bbffa95af87bb66635aaffdaddcd31be063752dc;hp=4261e5d0e1053d2b4529d0e3555ba056754e3f70;hpb=dcef38bab91d45b56f7cf3ceeec96303d93728bb;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index 4261e5d..7e29d67 100644
--- 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,28 +8,29 @@
 %************************************************************************
 
 \begin{code}
-#include "HsVersions.h"
-
-module SrcLoc {- (
+module SrcLoc (
 	SrcLoc,			-- Abstract
 
-	mkSrcLoc,
-	noSrcLoc, isNoSrcLoc,	-- "I'm sorry, I haven't a clue"
+	mkSrcLoc, isGoodSrcLoc,	
+	noSrcLoc, 		-- "I'm sorry, I haven't a clue"
 
-	mkIfaceSrcLoc,		-- Unknown place in an interface
-				-- (this one can die eventually ToDo)
+	importedSrcLoc,		-- Unknown place in an interface
+	builtinSrcLoc,		-- Something wired into the compiler
+	generatedSrcLoc,	-- Code generated within the compiler
 
-	mkBuiltinSrcLoc,	-- Something wired into the compiler
+	incSrcLine, replaceSrcLine,
+	
+	srcLocFile,		-- return the file name part.
+	srcLocLine		-- return the line part.
+    ) where
 
-	mkGeneratedSrcLoc	-- Code generated within the compiler
-    ) -} where
-
-IMP_Ubiq()
+#include "HsVersions.h"
 
+import Util		( thenCmp )
 import Outputable
-import PprStyle		( PprStyle(..), userStyle )
-import Pretty
-
+import FastString	( unpackFS )
+import FastTypes
+import GlaExts		( Int(..), (+#) )
 \end{code}
 
 %************************************************************************
@@ -42,12 +43,12 @@ We keep information about the {\em definition} point for each entity;
 this is the obvious stuff:
 \begin{code}
 data SrcLoc
-  = NoSrcLoc
-
-  | SrcLoc	FAST_STRING	-- A precise location
-		FAST_INT
+  = SrcLoc	FAST_STRING	-- A precise location (file name)
+		FastInt
 
   | UnhelpfulSrcLoc FAST_STRING	-- Just a general indication
+
+  | NoSrcLoc
 \end{code}
 
 Note that an entity might be imported via more than one route, and
@@ -63,15 +64,27 @@ rare case.
 
 Things to make 'em:
 \begin{code}
-noSrcLoc	    = NoSrcLoc
-mkSrcLoc x IBOX(y)  = SrcLoc x y
+mkSrcLoc x y      = SrcLoc x (iUnbox y)
+noSrcLoc	  = NoSrcLoc
+importedSrcLoc	  = UnhelpfulSrcLoc SLIT("<imported>")
+builtinSrcLoc	  = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
+generatedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
 
-mkIfaceSrcLoc	    = UnhelpfulSrcLoc SLIT("<an interface file>")
-mkBuiltinSrcLoc	    = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
-mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
+isGoodSrcLoc (SrcLoc _ _) = True
+isGoodSrcLoc other        = False
 
-isNoSrcLoc NoSrcLoc = True
-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}
 
 %************************************************************************
@@ -81,21 +94,44 @@ 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	    = ptext SLIT("<No locn>")
 \end{code}
-
-{-
-      = hcat [ptext SLIT("{-# LINE "), text (show IBOX(src_line)), space,
-		   char '"', ptext src_file, ptext SLIT(" #-}")]
- --ptext SLIT("\" #-}")]
--}