X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=1a0198095985536eb691a2b060cacda485ba6449;hb=789690fc23a49aa3bcbc946992fd6340c90d8c10;hp=20e1bca9c32b84d6c95a011f6e01452dd9cc27ba;hpb=8371c6389ea42280eb202acd16bf33e4fc036555;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index 20e1bca..1a01980 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -72,6 +72,8 @@ module SrcLoc (
 import Util
 import Outputable
 import FastString
+
+import Data.Bits
 \end{code}
 
 %************************************************************************
@@ -124,17 +126,20 @@ srcLocFile _other	      = (fsLit "<unknown file")
 -- | Raises an error when used on a "bad" 'SrcLoc'
 srcLocLine :: SrcLoc -> Int
 srcLocLine (SrcLoc _ l _) = l
-srcLocLine _other	  = panic "srcLocLine: unknown line"
+srcLocLine (UnhelpfulLoc s) = pprPanic "srcLocLine" (ftext s)
 
 -- | Raises an error when used on a "bad" 'SrcLoc'
 srcLocCol :: SrcLoc -> Int
 srcLocCol (SrcLoc _ _ c) = c
-srcLocCol _other         = panic "srcLocCol: unknown col"
+srcLocCol (UnhelpfulLoc s) = pprPanic "srcLocCol" (ftext s)
 
--- | Move the 'SrcLoc' down by one line if the character is a newline
--- and across by one character in any other case
+-- | Move the 'SrcLoc' down by one line if the character is a newline,
+-- to the next 8-char tabstop if it is a tab, and across by one
+-- character in any other case
 advanceSrcLoc :: SrcLoc -> Char -> SrcLoc
 advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f  (l + 1) 1
+advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f  l (((((c - 1) `shiftR` 3) + 1)
+                                                  `shiftL` 3) + 1)
 advanceSrcLoc (SrcLoc f l c) _    = SrcLoc f  l (c + 1)
 advanceSrcLoc loc            _    = loc -- Better than nothing
 \end{code}