X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=cd3513568c52780fb5c90ae2a503d90f3cc59da3;hb=0b1ca3f5cbbc9dd3b8cc8e6df566b3dd3effe928;hp=423b4b32e0482a5b2c3f773a6d2adba4567452c0;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index 423b4b3..cd35135 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,21 +8,31 @@
 %************************************************************************
 
 \begin{code}
-#include "HsVersions.h"
-
 module SrcLoc (
-	SrcLoc,			-- abstract
+	SrcLoc,			-- Abstract
+
+	mkSrcLoc, isGoodSrcLoc,	mkGeneralSrcLoc,
+	noSrcLoc, 		-- "I'm sorry, I haven't a clue"
+	advanceSrcLoc,
+
+	importedSrcLoc,		-- Unknown place in an interface
+	wiredInSrcLoc,		-- Something wired into the compiler
+	generatedSrcLoc,	-- Code generated within the compiler
+	interactiveSrcLoc,	-- Code from an interactive session
 
-	mkSrcLoc, mkSrcLoc2,	-- the usual
-	mkUnknownSrcLoc,	-- "I'm sorry, I haven't a clue"
-	mkBuiltinSrcLoc,	-- something wired into the compiler
-	mkGeneratedSrcLoc,	-- code generated within the compiler
-	unpackSrcLoc
+	srcLocFile,		-- return the file name part
+	srcLocLine,		-- return the line part
+	srcLocCol,		-- return the column part
     ) where
 
+#include "HsVersions.h"
+
+import Util		( thenCmp )
 import Outputable
-import Pretty
-import Util
+import FastTypes
+import FastString
+
+import GLAEXTS		( (+#), quotInt# )
 \end{code}
 
 %************************************************************************
@@ -35,10 +45,27 @@ 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#
-		FAST_INT
+  = SrcLoc	FastString	-- A precise location (file name)
+		FastInt		-- line
+		FastInt		-- column
+
+  | ImportedLoc	String		-- Module name
+
+  | UnhelpfulLoc FastString	-- Just a general indication
+
+{-
+data SrcSpan
+  = WiredInSpan
+
+	-- A precise source file span
+  | SrcSpan	FastString 	-- file name
+		FastInt		-- beginning line
+		FastInt		-- beginning column
+		FastInt		-- end line
+		FastInt		-- end column		
+
+  | UnhelpfulSrcSpan FastString	-- Just a general indication
+-}
 \end{code}
 
 Note that an entity might be imported via more than one route, and
@@ -54,14 +81,42 @@ rare case.
 
 Things to make 'em:
 \begin{code}
-mkSrcLoc	    = SrcLoc
-mkSrcLoc2 x IBOX(y) = SrcLoc2 x y
-mkUnknownSrcLoc	    = SrcLoc SLIT("<unknown>") 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)))
+mkSrcLoc x line col = SrcLoc x (iUnbox line) (iUnbox col)
+noSrcLoc	  = UnhelpfulLoc FSLIT("<no locn>")
+generatedSrcLoc   = UnhelpfulLoc FSLIT("<compiler-generated code>")
+wiredInSrcLoc     = UnhelpfulLoc FSLIT("<wired into compiler>")
+interactiveSrcLoc = UnhelpfulLoc FSLIT("<interactive session>")
+
+mkGeneralSrcLoc :: FastString -> SrcLoc
+mkGeneralSrcLoc = UnhelpfulLoc 
+
+importedSrcLoc :: String -> SrcLoc
+importedSrcLoc mod_name = ImportedLoc mod_name
+
+isGoodSrcLoc (SrcLoc _ _ _) = True
+isGoodSrcLoc other          = False
+
+srcLocFile :: SrcLoc -> FastString
+srcLocFile (SrcLoc fname _ _) = fname
+srcLocFile other	      = FSLIT("<unknown file")
+
+srcLocLine :: SrcLoc -> Int
+srcLocLine (SrcLoc _ l c) = iBox l
+srcLocLine other	  = panic "srcLocLine: unknown line"
+
+srcLocCol :: SrcLoc -> Int
+srcLocCol (SrcLoc _ l c) = iBox c
+srcLocCol other	  = panic "srcLocCol: unknown col"
+
+advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
+advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (tab c)
+advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f  (l +# 1#) 0#
+advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c +# 1#)
+advanceSrcLoc loc	     _	  = loc	-- Better than nothing
+
+-- Advance to the next tab stop.  Tabs are at column positions 0, 8, 16, etc.
+tab :: FastInt -> FastInt
+tab c = (c `quotInt#` 8# +# 1#) *# 8#
 \end{code}
 
 %************************************************************************
@@ -71,14 +126,42 @@ 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 ]
+-- 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 (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
+cmpSrcLoc (UnhelpfulLoc _)  other      	      = LT
 
-    ppr sty (SrcLoc src_file src_line)
-      = ppBesides [ppPStr SLIT("{-# LINE "), ppPStr src_line, ppSP,
-		   ppChar '"', ppPStr src_file, ppPStr SLIT("\" #-}")]
+cmpSrcLoc (ImportedLoc _)  (UnhelpfulLoc _)  = GT
+cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2)  = m1 `compare` m2
+cmpSrcLoc (ImportedLoc _)  other	     = LT
+
+cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)      
+  = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2)
+  where
+	l1 `cmpline` l2 | l1 <#  l2 = LT
+			| l1 ==# l2 = EQ
+			| otherwise = GT 
+cmpSrcLoc (SrcLoc _ _ _) other = GT
+
+instance Outputable SrcLoc where
+    ppr (SrcLoc src_path src_line src_col)
+      = getPprStyle $ \ sty ->
+        if userStyle sty || debugStyle sty then
+	   hcat [ ftext src_path, char ':', 
+		  int (iBox src_line)
+		  {- TODO: char ':', int (iBox src_col) -} 
+		]
+	else
+	   hcat [text "{-# LINE ", int (iBox src_line), space,
+		 char '\"', ftext src_path, text " #-}"]
 
-    ppr sty (SrcLoc2 src_file src_line)
-      = ppr sty (SrcLoc src_file (_PK_ (show IBOX(src_line))))
+    ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> quotes (text mod)
+    ppr (UnhelpfulLoc s)  = ftext s
 \end{code}