X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=8e91e3adec003e9dab36744e7be6f38fde6dae06;hb=3b1438a9757639d7f37f10e1237e2369ca0ebe4a;hp=52c47178914697a588afc6e331062dfa2e5b4815;hpb=49c98d143c382a1341e1046f5ca00819a25691ba;p=ghc-hetmet.git diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index 52c4717..8e91e3a 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -3,6 +3,13 @@ % \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/Commentary/CodingStyle#Warnings +-- for details + module SrcLoc ( SrcLoc, -- Abstract @@ -10,8 +17,6 @@ module SrcLoc ( noSrcLoc, -- "I'm sorry, I haven't a clue" 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 @@ -22,17 +27,22 @@ module SrcLoc ( SrcSpan, -- Abstract noSrcSpan, + wiredInSrcSpan, -- Something wired into the compiler 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" @@ -58,16 +68,9 @@ 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 - | UnhelpfulLoc FastString -- Just a general indication \end{code} -Note that an entity might be imported via more than one route, and -there could be more than one ``definition point'' --- in two or more -\tr{.hi} files. We deemed it probably-unworthwhile to cater for this -rare case. - %************************************************************************ %* * \subsection[SrcLoc-access-fns]{Access functions for names} @@ -79,15 +82,11 @@ 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 mod_name = ImportedLoc mod_name - isGoodSrcLoc (SrcLoc _ _ _) = True isGoodSrcLoc other = False @@ -128,16 +127,8 @@ instance Ord SrcLoc where cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2 cmpSrcLoc (UnhelpfulLoc _) other = LT -cmpSrcLoc (ImportedLoc _) (UnhelpfulLoc _) = GT -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 @@ -152,7 +143,6 @@ 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 (UnhelpfulLoc s) = ftext s \end{code} @@ -195,8 +185,6 @@ data SrcSpan srcSpanCol :: !Int } - | ImportedSpan String -- Module name - | UnhelpfulSpan FastString -- Just a general indication -- also used to indicate an empty span @@ -208,7 +196,8 @@ instance Ord SrcSpan where (srcSpanStart a `compare` srcSpanStart b) `thenCmp` (srcSpanEnd a `compare` srcSpanEnd b) -noSrcSpan = UnhelpfulSpan FSLIT("") +noSrcSpan = UnhelpfulSpan FSLIT("") +wiredInSrcSpan = UnhelpfulSpan FSLIT("") mkGeneralSrcSpan :: FastString -> SrcSpan mkGeneralSrcSpan = UnhelpfulSpan @@ -218,6 +207,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 @@ -227,7 +222,7 @@ isOneLineSpan s -------------------------------------------------------- -- Don't export these four; --- they panic on Imported, Unhelpful. +-- they panic on Unhelpful. -- They are for internal use only -- Urk! Some are needed for Lexer.x; see comment in export list @@ -252,13 +247,11 @@ 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) -srcSpanEnd (ImportedSpan str) = ImportedLoc str srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str srcSpanEnd s = mkSrcLoc (srcSpanFile s) @@ -266,14 +259,11 @@ srcSpanEnd s = (srcSpanEndCol s) srcLocSpan :: SrcLoc -> SrcSpan -srcLocSpan (ImportedLoc str) = ImportedSpan str srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan -mkSrcSpan (ImportedLoc str) _ = ImportedSpan str mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str -mkSrcSpan _ (ImportedLoc str) = ImportedSpan str mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str mkSrcSpan loc1 loc2 | line1 == line2 = if col1 == col2 @@ -289,9 +279,7 @@ mkSrcSpan loc1 loc2 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan -- Assumes the 'file' part is the same in both -combineSrcSpans (ImportedSpan str) _ = ImportedSpan str combineSrcSpans (UnhelpfulSpan str) r = r -- this seems more useful -combineSrcSpans _ (ImportedSpan str) = ImportedSpan str combineSrcSpans l (UnhelpfulSpan str) = l combineSrcSpans start end = case line1 `compare` line2 of @@ -308,11 +296,11 @@ combineSrcSpans start end col2 = srcSpanEndCol end file = srcSpanFile start -pprDefnLoc :: SrcLoc -> SDoc --- "defined at ..." or "imported from ..." +pprDefnLoc :: SrcSpan -> SDoc +-- "defined at ..." 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 @@ -349,7 +337,6 @@ pprUserSpan (SrcSpanPoint src_path line col) char ':', int col ] -pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> text mod pprUserSpan (UnhelpfulSpan s) = ftext s \end{code} @@ -393,3 +380,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}