X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=845e1db2ad8cf0983f5f324d1d40d8e9fe702fa9;hp=2dc6c48415c17a7d54eb8cd8c540ea2b5da3bb0a;hb=17b297d97d327620ed6bfab942f8992b2446f1bf;hpb=8eb5a108434cbe0af52650444a2fac9d55d2a491 diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index 2dc6c48..845e1db 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -1,13 +1,15 @@ % -% (c) The University of Glasgow, 1992-2003 +% (c) The University of Glasgow, 1992-2006 % -%************************************************************************ -%* * -\section[SrcLoc]{The @SrcLoc@ type} -%* * -%************************************************************************ \begin{code} +{-# OPTIONS_GHC -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings +-- for details + module SrcLoc ( SrcLoc, -- Abstract @@ -16,7 +18,6 @@ module SrcLoc ( 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 @@ -27,22 +28,28 @@ module SrcLoc ( SrcSpan, -- Abstract noSrcSpan, + wiredInSrcSpan, -- Something wired into the compiler + importedSrcSpan, -- Unknown place in an interface mkGeneralSrcSpan, isGoodSrcSpan, isOneLineSpan, mkSrcSpan, srcLocSpan, combineSrcSpans, srcSpanStart, srcSpanEnd, + optSrcSpanFileName, -- These are dubious exports, because they crash on some inputs, -- used only in Lexer.x where we are sure what the Span looks like - srcSpanFile, srcSpanEndLine, srcSpanEndCol, + srcSpanFile, + srcSpanStartLine, srcSpanEndLine, + srcSpanStartCol, srcSpanEndCol, - Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc + Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc, + leftmost_smallest, leftmost_largest, rightmost, spans, isSubspanOf ) where #include "HsVersions.h" -import Util ( thenCmp ) +import Util import Outputable import FastString \end{code} @@ -63,7 +70,7 @@ data SrcLoc -- Don't ask me why lines start at 1 and columns start at -- zero. That's just the way it is, so there. --SDM - | ImportedLoc String -- Module name + | ImportedLoc FastString -- Module name | UnhelpfulLoc FastString -- Just a general indication \end{code} @@ -84,13 +91,12 @@ Things to make 'em: mkSrcLoc x line col = SrcLoc x line col noSrcLoc = UnhelpfulLoc FSLIT("") generatedSrcLoc = UnhelpfulLoc FSLIT("") -wiredInSrcLoc = UnhelpfulLoc FSLIT("") interactiveSrcLoc = UnhelpfulLoc FSLIT("") mkGeneralSrcLoc :: FastString -> SrcLoc mkGeneralSrcLoc = UnhelpfulLoc -importedSrcLoc :: String -> SrcLoc +importedSrcLoc :: FastString -> SrcLoc importedSrcLoc mod_name = ImportedLoc mod_name isGoodSrcLoc (SrcLoc _ _ _) = True @@ -138,11 +144,7 @@ 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 + = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2) cmpSrcLoc (SrcLoc _ _ _) other = GT instance Outputable SrcLoc where @@ -157,7 +159,7 @@ instance Outputable SrcLoc where hcat [text "{-# LINE ", int src_line, space, char '\"', ftext src_path, text " #-}"] - ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> text mod + ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> ftext mod ppr (UnhelpfulLoc s) = ftext s \end{code} @@ -200,7 +202,7 @@ data SrcSpan srcSpanCol :: !Int } - | ImportedSpan String -- Module name + | ImportedSpan FastString -- Module name | UnhelpfulSpan FastString -- Just a general indication -- also used to indicate an empty span @@ -213,7 +215,9 @@ instance Ord SrcSpan where (srcSpanStart a `compare` srcSpanStart b) `thenCmp` (srcSpanEnd a `compare` srcSpanEnd b) -noSrcSpan = UnhelpfulSpan FSLIT("") +noSrcSpan = UnhelpfulSpan FSLIT("") +wiredInSrcSpan = UnhelpfulSpan FSLIT("") +importedSrcSpan = ImportedSpan mkGeneralSrcSpan :: FastString -> SrcSpan mkGeneralSrcSpan = UnhelpfulSpan @@ -223,6 +227,12 @@ isGoodSrcSpan SrcSpanMultiLine{} = True isGoodSrcSpan SrcSpanPoint{} = True isGoodSrcSpan _ = False +optSrcSpanFileName :: SrcSpan -> Maybe FastString +optSrcSpanFileName (SrcSpanOneLine { srcSpanFile = nm }) = Just nm +optSrcSpanFileName (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm +optSrcSpanFileName (SrcSpanPoint { srcSpanFile = nm}) = Just nm +optSrcSpanFileName _ = Nothing + isOneLineSpan :: SrcSpan -> Bool -- True if the span is known to straddle more than one line -- By default, it returns False @@ -313,11 +323,11 @@ combineSrcSpans start end col2 = srcSpanEndCol end file = srcSpanFile start -pprDefnLoc :: SrcLoc -> SDoc +pprDefnLoc :: SrcSpan -> SDoc -- "defined at ..." or "imported from ..." pprDefnLoc loc - | isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc - | otherwise = ppr loc + | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc + | otherwise = ppr loc instance Outputable SrcSpan where ppr span @@ -354,7 +364,7 @@ pprUserSpan (SrcSpanPoint src_path line col) char ':', int col ] -pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> text mod +pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> ftext mod pprUserSpan (UnhelpfulSpan s) = ftext s \end{code} @@ -398,3 +408,31 @@ instance Outputable e => Outputable (Located e) where ppr (L span e) = ppr e -- do we want to dump the span in debugSty mode? \end{code} + + +%************************************************************************ +%* * +\subsection{Manipulating SrcSpans} +%* * +%************************************************************************ + +\begin{code} +leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering +rightmost = flip compare +leftmost_smallest = compare +leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b) + `thenCmp` + (srcSpanEnd b `compare` srcSpanEnd a) + + +spans :: SrcSpan -> (Int,Int) -> Bool +spans span (l,c) = srcSpanStart span <= loc && loc <= srcSpanEnd span + where loc = mkSrcLoc (srcSpanFile span) l c + +isSubspanOf :: SrcSpan -> SrcSpan -> Bool +isSubspanOf src parent + | optSrcSpanFileName parent /= optSrcSpanFileName src = False + | otherwise = srcSpanStart parent <= srcSpanStart src && + srcSpanEnd parent >= srcSpanEnd src + +\end{code} \ No newline at end of file