X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=ab1c2d49ddbf0a42c78233a2d317ba82d871b826;hp=51d4318b0be60e8c785d8a28b959b04e4c7a62f3;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index 51d4318..ab1c2d4 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 -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/CodingStyle#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 @@ -26,22 +27,29 @@ module SrcLoc ( pprDefnLoc, SrcSpan, -- Abstract - noSrcSpan, + noSrcSpan, + wiredInSrcSpan, -- Something wired into the compiler + importedSrcSpan, -- Unknown place in an interface mkGeneralSrcSpan, - isGoodSrcSpan, + isGoodSrcSpan, isOneLineSpan, mkSrcSpan, srcLocSpan, combineSrcSpans, - srcSpanFile, - srcSpanStartLine, srcSpanEndLine, - srcSpanStartCol, srcSpanEndCol, 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, + 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} @@ -62,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} @@ -83,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 @@ -137,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 @@ -156,7 +159,7 @@ instance Outputable SrcLoc where hcat [text "{-# LINE ", int src_line, space, char '\"', ftext src_path, text " #-}"] - ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> text mod + ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> ftext mod ppr (UnhelpfulLoc s) = ftext s \end{code} @@ -199,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 @@ -212,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 @@ -222,6 +227,25 @@ 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 +isOneLineSpan s + | isGoodSrcSpan s = srcSpanStartLine s == srcSpanEndLine s + | otherwise = False + +-------------------------------------------------------- +-- Don't export these four; +-- they panic on Imported, Unhelpful. +-- They are for internal use only +-- Urk! Some are needed for Lexer.x; see comment in export list + srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l @@ -241,13 +265,13 @@ srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol" +-------------------------------------------------------- srcSpanStart (ImportedSpan str) = ImportedLoc str srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str -srcSpanStart s = - mkSrcLoc (srcSpanFile s) - (srcSpanStartLine s) - (srcSpanStartCol s) +srcSpanStart s = mkSrcLoc (srcSpanFile s) + (srcSpanStartLine s) + (srcSpanStartCol s) srcSpanEnd (ImportedSpan str) = ImportedLoc str srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str @@ -299,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 @@ -340,7 +364,7 @@ pprUserSpan (SrcSpanPoint src_path line col) char ':', int col ] -pprUserSpan (ImportedSpan mod) = ptext SLIT("Imported from") <+> quotes (text mod) +pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> ftext mod pprUserSpan (UnhelpfulSpan s) = ftext s \end{code} @@ -384,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