X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=06f8ec8c27ca1b121f931f8e12e265490dcb54e1;hb=9b8f6b8689528dacb59fcc50c98174476585324c;hp=e213befc839f045bb0fe872005444a7c81e2753e;hpb=f41e3ea766c340c49b829eabfdea7c77bda2a95e;p=ghc-hetmet.git

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index e213bef..06f8ec8 100644
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -69,11 +69,14 @@ module SrcLoc (
         spans, isSubspanOf
     ) where
 
+#include "Typeable.h"
+
 import Util
 import Outputable
 import FastString
 
 import Data.Bits
+import Data.Data
 \end{code}
 
 %************************************************************************
@@ -126,19 +129,19 @@ 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,
 -- 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 `shiftR` 3) + 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
@@ -162,11 +165,11 @@ instance Ord SrcLoc where
    
 cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
 cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
-cmpSrcLoc (UnhelpfulLoc _)  _other            = LT
+cmpSrcLoc (UnhelpfulLoc _)  (SrcLoc _ _ _)    = GT
+cmpSrcLoc (SrcLoc _ _ _)    (UnhelpfulLoc _)  = LT
 
 cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)      
   = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
-cmpSrcLoc (SrcLoc _ _ _) _other = GT
 
 instance Outputable SrcLoc where
     ppr (SrcLoc src_path src_line src_col)
@@ -181,6 +184,14 @@ instance Outputable SrcLoc where
                   char '\"', pprFastFilePath src_path, text " #-}"]
 
     ppr (UnhelpfulLoc s)  = ftext s
+
+INSTANCE_TYPEABLE0(SrcSpan,srcSpanTc,"SrcSpan")
+
+instance Data SrcSpan where
+  -- don't traverse?
+  toConstr _   = abstractConstr "SrcSpan"
+  gunfold _ _  = error "gunfold"
+  dataTypeOf _ = mkNoRepType "SrcSpan"
 \end{code}
 
 %************************************************************************
@@ -443,6 +454,7 @@ pprDefnLoc loc
 \begin{code}
 -- | We attach SrcSpans to lots of things, so let's have a datatype for it.
 data Located e = L SrcSpan e
+  deriving (Eq, Ord, Typeable, Data)
 
 unLoc :: Located e -> e
 unLoc (L _ e) = e
@@ -479,7 +491,7 @@ instance Functor Located where
   fmap f (L l e) = L l (f e)
 
 instance Outputable e => Outputable (Located e) where
-  ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) <> ppr e
+  ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) $$ ppr e
 		-- Print spans without the file name etc
 \end{code}