X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=8bed6c19772e76f18c0f0c3f0bc5307395613765;hp=e1a2a43567efcf9b9907f096708e0c3eada91c41;hb=294dab1b04599cd7628642b0fe02e088ac3da4ba;hpb=8cb87328256a7143c6d6d2c70d7c0ed6a8d50eb6 diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index e1a2a43..8bed6c1 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,12 +129,12 @@ srcLocFile _other = (fsLit " 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 @@ -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 (Typeable, Data) unLoc :: Located e -> e unLoc (L _ e) = e