X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;fp=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=377a8c872d839be40af4099f82c817d2ba47a741;hb=9541ef3440f89f5f275509b1cc64fb9c498dcf73;hp=c3249dfd27a08790da80c836c6e4cba11dcb33cd;hpb=74fce831a7115e88f374a08d39675c434fbbc07a;p=ghc-hetmet.git

diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs
index c3249df..377a8c8 100644
--- a/ghc/compiler/basicTypes/SrcLoc.lhs
+++ b/ghc/compiler/basicTypes/SrcLoc.lhs
@@ -13,15 +13,15 @@ module SrcLoc (
 
 	mkSrcLoc, isGoodSrcLoc,	isWiredInLoc,
 	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
 
-	incSrcLine, replaceSrcLine,
-	
-	srcLocFile,		-- return the file name part.
-	srcLocLine		-- return the line part.
+	srcLocFile,		-- return the file name part
+	srcLocLine,		-- return the line part
+	srcLocCol,		-- return the column part
     ) where
 
 #include "HsVersions.h"
@@ -32,7 +32,7 @@ import FastString	( unpackFS )
 import FastTypes
 import FastString
 
-import GLAEXTS		( (+#) )
+import GLAEXTS		( (+#), quotInt# )
 \end{code}
 
 %************************************************************************
@@ -52,9 +52,24 @@ data SrcLoc
 			-- isWiredInName
 
   | SrcLoc	FastString	-- A precise location (file name)
-		FastInt
+		FastInt		-- line
+		FastInt		-- column
 
   | UnhelpfulSrcLoc 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
@@ -70,30 +85,35 @@ rare case.
 
 Things to make 'em:
 \begin{code}
-mkSrcLoc x y      = SrcLoc x (iUnbox y)
+mkSrcLoc x line col = SrcLoc x (iUnbox line) (iUnbox col)
 wiredInSrcLoc	  = WiredInLoc
 noSrcLoc	  = UnhelpfulSrcLoc FSLIT("<No locn>")
 importedSrcLoc	  = UnhelpfulSrcLoc FSLIT("<imported>")
 generatedSrcLoc   = UnhelpfulSrcLoc FSLIT("<compiler-generated-code>")
 
-isGoodSrcLoc (SrcLoc _ _) = True
+isGoodSrcLoc (SrcLoc _ _ _) = True
 isGoodSrcLoc other        = False
 
 isWiredInLoc WiredInLoc = True
 isWiredInLoc other	= False
 
 srcLocFile :: SrcLoc -> FastString
-srcLocFile (SrcLoc fname _) = fname
+srcLocFile (SrcLoc fname _ _) = fname
+
+srcLocLine :: SrcLoc -> Int
+srcLocLine (SrcLoc _ l c) = iBox l
 
-srcLocLine :: SrcLoc -> FastInt
-srcLocLine (SrcLoc _ l) = l
+srcLocCol :: SrcLoc -> Int
+srcLocCol (SrcLoc _ l c) = iBox c
 
-incSrcLine :: SrcLoc -> SrcLoc
-incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#)
-incSrcLine loc  	= loc
+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#)
 
-replaceSrcLine :: SrcLoc -> FastInt -> SrcLoc
-replaceSrcLine (SrcLoc s _) l = SrcLoc s l
+-- 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}
 
 %************************************************************************
@@ -118,19 +138,23 @@ cmpSrcLoc WiredInLoc other      = LT
 cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2
 cmpSrcLoc (UnhelpfulSrcLoc s1) other		    = GT
 
-cmpSrcLoc (SrcLoc s1 l1) WiredInLoc	     = 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 
+cmpSrcLoc (SrcLoc _ _ _) WiredInLoc	     = GT
+cmpSrcLoc (SrcLoc _ _ _) (UnhelpfulSrcLoc _) = 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 
 					  
 instance Outputable SrcLoc where
-    ppr (SrcLoc src_path src_line)
+    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) ]
+	   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 " #-}"]