X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=cfd42a6f641a845d6d116e9e1908f5d318788ba2;hb=9dd6e1c216993624a2cd74b62ca0f0569c02c26b;hp=650de416a40f5bcd5c3e66f2784f9192b98c2cd7;hpb=2f51f1402e6869c0f049ffbe7b019bf6ab80558f;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index 650de41..cfd42a6 100644
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ b/ghc/compiler/basicTypes/SrcLoc.lhs
@@ -8,24 +8,27 @@
 %************************************************************************
 
 \begin{code}
-#include "HsVersions.h"
-
 module SrcLoc (
-	SrcLoc,			-- abstract
+	SrcLoc,			-- Abstract
+
+	mkSrcLoc,
+	noSrcLoc, isNoSrcLoc,	-- "I'm sorry, I haven't a clue"
 
-	mkSrcLoc, mkSrcLoc2,	-- the usual
-	mkUnknownSrcLoc,	-- "I'm sorry, I haven't a clue"
 	mkIfaceSrcLoc,		-- Unknown place in an interface
 				-- (this one can die eventually ToDo)
-	mkBuiltinSrcLoc,	-- something wired into the compiler
-	mkGeneratedSrcLoc,	-- code generated within the compiler
-	unpackSrcLoc
+
+	mkBuiltinSrcLoc,	-- Something wired into the compiler
+
+	mkGeneratedSrcLoc,	-- Code generated within the compiler
+
+	incSrcLine
     ) where
 
-import Ubiq
+#include "HsVersions.h"
 
-import PprStyle		( PprStyle(..) )
-import Pretty
+import Outputable
+import FastString	( unpackFS )
+import GlaExts		( Int(..), Int#, (+#) )
 \end{code}
 
 %************************************************************************
@@ -38,10 +41,12 @@ We keep information about the {\em definition} point for each entity;
 this is the obvious stuff:
 \begin{code}
 data SrcLoc
-  = SrcLoc	FAST_STRING	-- source file name
-		FAST_STRING	-- line number in source file
-  | SrcLoc2	FAST_STRING	-- same, but w/ an Int line#
+  = NoSrcLoc
+
+  | SrcLoc	FAST_STRING	-- A precise location (file name)
 		FAST_INT
+
+  | UnhelpfulSrcLoc FAST_STRING	-- Just a general indication
 \end{code}
 
 Note that an entity might be imported via more than one route, and
@@ -57,15 +62,19 @@ rare case.
 
 Things to make 'em:
 \begin{code}
-mkSrcLoc	    = SrcLoc
-mkSrcLoc2 x IBOX(y) = SrcLoc2 x y
-mkUnknownSrcLoc	    = SrcLoc SLIT("<unknown>") SLIT("<unknown>")
-mkIfaceSrcLoc	    = SrcLoc SLIT("<an interface file>") SLIT("<unknown>")
-mkBuiltinSrcLoc	    = SrcLoc SLIT("<built-into-the-compiler>") SLIT("<none>")
-mkGeneratedSrcLoc   = SrcLoc SLIT("<compiler-generated-code>") SLIT("<none>")
-
-unpackSrcLoc (SrcLoc  src_file src_line) = (src_file, src_line)
-unpackSrcLoc (SrcLoc2 src_file src_line) = (src_file, _PK_ (show IBOX(src_line)))
+noSrcLoc	    = NoSrcLoc
+mkSrcLoc x IBOX(y)  = SrcLoc x y
+
+mkIfaceSrcLoc	    = UnhelpfulSrcLoc SLIT("<an interface file>")
+mkBuiltinSrcLoc	    = UnhelpfulSrcLoc SLIT("<built-into-the-compiler>")
+mkGeneratedSrcLoc   = UnhelpfulSrcLoc SLIT("<compiler-generated-code>")
+
+isNoSrcLoc NoSrcLoc = True
+isNoSrcLoc other    = False
+
+incSrcLine :: SrcLoc -> SrcLoc
+incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
+incSrcLine loc  	= loc
 \end{code}
 
 %************************************************************************
@@ -76,13 +85,25 @@ unpackSrcLoc (SrcLoc2 src_file src_line) = (src_file, _PK_ (show IBOX(src_line))
 
 \begin{code}
 instance Outputable SrcLoc where
-    ppr PprForUser (SrcLoc src_file src_line)
-      = ppBesides [ ppChar '"', ppPStr src_file, ppPStr SLIT("\", line "), ppPStr src_line ]
+    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 sty (SrcLoc src_file src_line)
-      = ppBesides [ppPStr SLIT("{-# LINE "), ppPStr src_line, ppSP,
-		   ppChar '"', ppPStr src_file, ppPStr SLIT("\" #-}")]
+    ppr (UnhelpfulSrcLoc s) = ptext s
 
-    ppr sty (SrcLoc2 src_file src_line)
-      = ppr sty (SrcLoc src_file (_PK_ (show IBOX(src_line))))
+    ppr NoSrcLoc = text "<NoSrcLoc>"
 \end{code}