X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=35c78a8412469632e3ad47c51aaacf2edd827ce1;hp=5b8c6a664543aac4a7b6e9e31c43f12edffb4c60;hb=2fe38b5fb0957f9428864afd69ad3ccd82fae3d0;hpb=7fc749a43b4b6b85d234fa95d4928648259584f4 diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index 5b8c6a6..35c78a8 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -3,52 +3,72 @@ % \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 - +-- | This module contains types that relate to the positions of things +-- in source files, and allow tagging of those things with locations module SrcLoc ( + -- * SrcLoc SrcLoc, -- Abstract - mkSrcLoc, isGoodSrcLoc, mkGeneralSrcLoc, - noSrcLoc, -- "I'm sorry, I haven't a clue" - advanceSrcLoc, + -- ** Constructing SrcLoc + mkSrcLoc, mkGeneralSrcLoc, - importedSrcLoc, -- Unknown place in an interface + noSrcLoc, -- "I'm sorry, I haven't a clue" generatedSrcLoc, -- Code generated within the compiler interactiveSrcLoc, -- Code from an interactive session + advanceSrcLoc, + + -- ** Unsafely deconstructing SrcLoc + -- These are dubious exports, because they crash on some inputs srcLocFile, -- return the file name part srcLocLine, -- return the line part srcLocCol, -- return the column part + + -- ** Misc. operations on SrcLoc pprDefnLoc, + + -- ** Predicates on SrcLoc + isGoodSrcLoc, + -- * SrcSpan SrcSpan, -- Abstract + + -- ** Constructing SrcSpan + mkGeneralSrcSpan, mkSrcSpan, noSrcSpan, wiredInSrcSpan, -- Something wired into the compiler - importedSrcSpan, -- Unknown place in an interface - mkGeneralSrcSpan, - isGoodSrcSpan, isOneLineSpan, - mkSrcSpan, srcLocSpan, + srcLocSpan, combineSrcSpans, + + -- ** Deconstructing SrcSpan srcSpanStart, srcSpanEnd, - optSrcSpanFileName, + srcSpanFileName_maybe, - -- These are dubious exports, because they crash on some inputs, - -- used only in Lexer.x where we are sure what the Span looks like + -- ** Unsafely deconstructing SrcSpan + -- These are dubious exports, because they crash on some inputs srcSpanFile, srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol, - Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc, - leftmost_smallest, leftmost_largest, rightmost, spans, isSubspanOf + -- ** Predicates on SrcSpan + isGoodSrcSpan, isOneLineSpan, + + -- * Located + Located(..), + + -- ** Constructing Located + noLoc, + mkGeneralLocated, + + -- ** Deconstructing Located + getLoc, unLoc, + + -- ** Combining and comparing Located values + eqLocated, cmpLocated, combineLocs, addCLoc, + leftmost_smallest, leftmost_largest, rightmost, + spans, isSubspanOf ) where -#include "HsVersions.h" - import Util import Outputable import FastString @@ -63,59 +83,58 @@ import FastString We keep information about the {\em definition} point for each entity; this is the obvious stuff: \begin{code} +-- | Represents a single point within a file data SrcLoc = SrcLoc FastString -- A precise location (file name) - !Int -- line number, begins at 1 - !Int -- column number, begins at 0 - -- 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 FastString -- Module name - + {-# UNPACK #-} !Int -- line number, begins at 1 + {-# UNPACK #-} !Int -- column number, begins at 1 | 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} +\subsection[SrcLoc-access-fns]{Access functions} %* * %************************************************************************ -Things to make 'em: \begin{code} +mkSrcLoc :: FastString -> Int -> Int -> SrcLoc mkSrcLoc x line col = SrcLoc x line col -noSrcLoc = UnhelpfulLoc FSLIT("") -generatedSrcLoc = UnhelpfulLoc FSLIT("") -interactiveSrcLoc = UnhelpfulLoc FSLIT("") +-- | Built-in "bad" 'SrcLoc' values for particular locations +noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc +noSrcLoc = UnhelpfulLoc (fsLit "") +generatedSrcLoc = UnhelpfulLoc (fsLit "") +interactiveSrcLoc = UnhelpfulLoc (fsLit "") + +-- | Creates a "bad" 'SrcLoc' that has no detailed information about its location mkGeneralSrcLoc :: FastString -> SrcLoc mkGeneralSrcLoc = UnhelpfulLoc -importedSrcLoc :: FastString -> SrcLoc -importedSrcLoc mod_name = ImportedLoc mod_name - +-- | "Good" 'SrcLoc's have precise information about their location +isGoodSrcLoc :: SrcLoc -> Bool isGoodSrcLoc (SrcLoc _ _ _) = True -isGoodSrcLoc other = False +isGoodSrcLoc _other = False +-- | Gives the filename of the 'SrcLoc' if it is available, otherwise returns a dummy value srcLocFile :: SrcLoc -> FastString srcLocFile (SrcLoc fname _ _) = fname -srcLocFile other = FSLIT(" Int -srcLocLine (SrcLoc _ l c) = l -srcLocLine other = panic "srcLocLine: unknown line" +srcLocLine (SrcLoc _ l _) = l +srcLocLine _other = panic "srcLocLine: unknown line" +-- | Raises an error when used on a "bad" 'SrcLoc' srcLocCol :: SrcLoc -> Int -srcLocCol (SrcLoc _ l c) = c -srcLocCol other = panic "srcLocCol: unknown col" +srcLocCol (SrcLoc _ _ c) = c +srcLocCol _other = panic "srcLocCol: unknown col" +-- | Move the 'SrcLoc' down by one line if the character is a newline +-- and across by one character in any other case advanceSrcLoc :: SrcLoc -> Char -> SrcLoc -advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f (l + 1) 0 +advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f (l + 1) 1 advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1) advanceSrcLoc loc _ = loc -- Better than nothing \end{code} @@ -130,36 +149,32 @@ advanceSrcLoc loc _ = loc -- Better than nothing -- SrcLoc is an instance of Ord so that we can sort error messages easily instance Eq SrcLoc where loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of - EQ -> True - other -> False + EQ -> True + _other -> False instance Ord SrcLoc where compare = cmpSrcLoc - + +cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering 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 (UnhelpfulLoc _) _other = 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 +cmpSrcLoc (SrcLoc _ _ _) _other = GT instance Outputable SrcLoc where ppr (SrcLoc src_path src_line src_col) = getPprStyle $ \ sty -> if userStyle sty || debugStyle sty then - hcat [ ftext src_path, char ':', - int src_line, - char ':', int src_col - ] - else - hcat [text "{-# LINE ", int src_line, space, - char '\"', ftext src_path, text " #-}"] - - ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> ftext mod + hcat [ pprFastFilePath src_path, char ':', + int src_line, + char ':', int src_col + ] + else + hcat [text "{-# LINE ", int src_line, space, + char '\"', pprFastFilePath src_path, text " #-}"] + ppr (UnhelpfulLoc s) = ftext s \end{code} @@ -176,75 +191,132 @@ by a pair of (line,column) coordinates, but in fact we optimise slightly by using more compact representations for single-line and zero-length spans, both of which are quite common. -The end position is defined to be the column *after* the end of the +The end position is defined to be the column /after/ the end of the span. That is, a span of (1,1)-(1,2) is one character long, and a span of (1,1)-(1,1) is zero characters long. -} data SrcSpan = SrcSpanOneLine -- a common case: a single line - { srcSpanFile :: FastString, - srcSpanLine :: !Int, - srcSpanSCol :: !Int, - srcSpanECol :: !Int + { srcSpanFile :: !FastString, + srcSpanLine :: {-# UNPACK #-} !Int, + srcSpanSCol :: {-# UNPACK #-} !Int, + srcSpanECol :: {-# UNPACK #-} !Int } | SrcSpanMultiLine - { srcSpanFile :: FastString, - srcSpanSLine :: !Int, - srcSpanSCol :: !Int, - srcSpanELine :: !Int, - srcSpanECol :: !Int + { srcSpanFile :: !FastString, + srcSpanSLine :: {-# UNPACK #-} !Int, + srcSpanSCol :: {-# UNPACK #-} !Int, + srcSpanELine :: {-# UNPACK #-} !Int, + srcSpanECol :: {-# UNPACK #-} !Int } | SrcSpanPoint - { srcSpanFile :: FastString, - srcSpanLine :: !Int, - srcSpanCol :: !Int + { srcSpanFile :: !FastString, + srcSpanLine :: {-# UNPACK #-} !Int, + srcSpanCol :: {-# UNPACK #-} !Int } - | ImportedSpan FastString -- Module name - - | UnhelpfulSpan FastString -- Just a general indication + | UnhelpfulSpan !FastString -- Just a general indication -- also used to indicate an empty span +#ifdef DEBUG + deriving (Eq, Show) -- Show is used by Lexer.x, becuase we + -- derive Show for Token +#else deriving Eq +#endif --- We want to order SrcSpans first by the start point, then by the end point. -instance Ord SrcSpan where - a `compare` b = - (srcSpanStart a `compare` srcSpanStart b) `thenCmp` - (srcSpanEnd a `compare` srcSpanEnd b) - -noSrcSpan = UnhelpfulSpan FSLIT("") -wiredInSrcSpan = UnhelpfulSpan FSLIT("") -importedSrcSpan = ImportedSpan +-- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty +noSrcSpan, wiredInSrcSpan :: SrcSpan +noSrcSpan = UnhelpfulSpan (fsLit "") +wiredInSrcSpan = UnhelpfulSpan (fsLit "") +-- | Create a "bad" 'SrcSpan' that has not location information mkGeneralSrcSpan :: FastString -> SrcSpan mkGeneralSrcSpan = UnhelpfulSpan +-- | Create a 'SrcSpan' corresponding to a single point +srcLocSpan :: SrcLoc -> SrcSpan +srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str +srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col + +-- | Create a 'SrcSpan' between two points in a file +mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan +mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str +mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str +mkSrcSpan loc1 loc2 + | line1 == line2 = if col1 == col2 + then SrcSpanPoint file line1 col1 + else SrcSpanOneLine file line1 col1 col2 + | otherwise = SrcSpanMultiLine file line1 col1 line2 col2 + where + line1 = srcLocLine loc1 + line2 = srcLocLine loc2 + col1 = srcLocCol loc1 + col2 = srcLocCol loc2 + file = srcLocFile loc1 + +-- | Combines two 'SrcSpan' into one that spans at least all the characters +-- within both spans. Assumes the "file" part is the same in both inputs +combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan +combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful +combineSrcSpans l (UnhelpfulSpan _) = l +combineSrcSpans start end + = case line1 `compare` line2 of + EQ -> case col1 `compare` col2 of + EQ -> SrcSpanPoint file line1 col1 + LT -> SrcSpanOneLine file line1 col1 col2 + GT -> SrcSpanOneLine file line1 col2 col1 + LT -> SrcSpanMultiLine file line1 col1 line2 col2 + GT -> SrcSpanMultiLine file line2 col2 line1 col1 + where + line1 = srcSpanStartLine start + col1 = srcSpanStartCol start + line2 = srcSpanEndLine end + col2 = srcSpanEndCol end + file = srcSpanFile start +\end{code} + +%************************************************************************ +%* * +\subsection[SrcSpan-predicates]{Predicates} +%* * +%************************************************************************ + +\begin{code} +-- | Test if a 'SrcSpan' is "good", i.e. has precise location information +isGoodSrcSpan :: SrcSpan -> Bool isGoodSrcSpan SrcSpanOneLine{} = True 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 +-- ^ True if the span is known to straddle only one line. +-- For "bad" 'SrcSpan', 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 +\end{code} + +%************************************************************************ +%* * +\subsection[SrcSpan-unsafe-access-fns]{Unsafe access functions} +%* * +%************************************************************************ + +\begin{code} + +-- | Raises an error when used on a "bad" 'SrcSpan' +srcSpanStartLine :: SrcSpan -> Int +-- | Raises an error when used on a "bad" 'SrcSpan' +srcSpanEndLine :: SrcSpan -> Int +-- | Raises an error when used on a "bad" 'SrcSpan' +srcSpanStartCol :: SrcSpan -> Int +-- | Raises an error when used on a "bad" 'SrcSpan' +srcSpanEndCol :: SrcSpan -> Int srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l @@ -265,107 +337,96 @@ srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol" --------------------------------------------------------- -srcSpanStart (ImportedSpan str) = ImportedLoc str +\end{code} + +%************************************************************************ +%* * +\subsection[SrcSpan-access-fns]{Access functions} +%* * +%************************************************************************ + +\begin{code} + +-- | Returns the location at the start of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable +srcSpanStart :: SrcSpan -> SrcLoc +-- | Returns the location at the end of the 'SrcSpan' or a "bad" 'SrcSpan' if that is unavailable +srcSpanEnd :: SrcSpan -> SrcLoc + 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) (srcSpanEndLine 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 +-- | Obtains the filename for a 'SrcSpan' if it is "good" +srcSpanFileName_maybe :: SrcSpan -> Maybe FastString +srcSpanFileName_maybe (SrcSpanOneLine { srcSpanFile = nm }) = Just nm +srcSpanFileName_maybe (SrcSpanMultiLine { srcSpanFile = nm }) = Just nm +srcSpanFileName_maybe (SrcSpanPoint { srcSpanFile = nm}) = Just nm +srcSpanFileName_maybe _ = Nothing -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 - then SrcSpanPoint file line1 col1 - else SrcSpanOneLine file line1 col1 col2 - | otherwise = SrcSpanMultiLine file line1 col1 line2 col2 - where - line1 = srcLocLine loc1 - line2 = srcLocLine loc2 - col1 = srcLocCol loc1 - col2 = srcLocCol loc2 - file = srcLocFile loc1 +\end{code} -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 - EQ -> case col1 `compare` col2 of - EQ -> SrcSpanPoint file line1 col1 - LT -> SrcSpanOneLine file line1 col1 col2 - GT -> SrcSpanOneLine file line1 col2 col1 - LT -> SrcSpanMultiLine file line1 col1 line2 col2 - GT -> SrcSpanMultiLine file line2 col2 line1 col1 - where - line1 = srcSpanStartLine start - col1 = srcSpanStartCol start - line2 = srcSpanEndLine end - col2 = srcSpanEndCol end - file = srcSpanFile start +%************************************************************************ +%* * +\subsection[SrcSpan-instances]{Instances} +%* * +%************************************************************************ + +\begin{code} + +-- We want to order SrcSpans first by the start point, then by the end point. +instance Ord SrcSpan where + a `compare` b = + (srcSpanStart a `compare` srcSpanStart b) `thenCmp` + (srcSpanEnd a `compare` srcSpanEnd b) -pprDefnLoc :: SrcSpan -> SDoc --- "defined at ..." or "imported from ..." -pprDefnLoc loc - | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc - | otherwise = ppr loc instance Outputable SrcSpan where ppr span = getPprStyle $ \ sty -> if userStyle sty || debugStyle sty then - pprUserSpan span - else - hcat [text "{-# LINE ", int (srcSpanStartLine span), space, - char '\"', ftext (srcSpanFile span), text " #-}"] + pprUserSpan True span + else + hcat [text "{-# LINE ", int (srcSpanStartLine span), space, + char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"] + +pprUserSpan :: Bool -> SrcSpan -> SDoc +pprUserSpan show_path (SrcSpanOneLine src_path line start_col end_col) + = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon) + , int line, char ':', int start_col + , ppUnless (end_col - start_col <= 1) + (char '-' <> int (end_col-1)) + -- For single-character or point spans, we just + -- output the starting column number + ] + + +pprUserSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol) + = hcat [ ppWhen show_path (pprFastFilePath src_path <> colon) + , parens (int sline <> char ',' <> int scol) + , char '-' + , parens (int eline <> char ',' <> + if ecol == 0 then int ecol else int (ecol-1)) + ] +pprUserSpan show_path (SrcSpanPoint src_path line col) + = hcat [ ppWhen show_path $ (pprFastFilePath src_path <> colon) + , int line, char ':', int col ] -pprUserSpan (SrcSpanOneLine src_path line start_col end_col) - = hcat [ ftext src_path, char ':', - int line, - char ':', int start_col - ] - <> if end_col - start_col <= 1 - then empty - -- for single-character or point spans, we just output the starting - -- column number - else char '-' <> int (end_col-1) - -pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol) - = hcat [ ftext src_path, char ':', - parens (int sline <> char ',' <> int scol), - char '-', - parens (int eline <> char ',' <> - if ecol == 0 then int ecol else int (ecol-1)) - ] - -pprUserSpan (SrcSpanPoint src_path line col) - = hcat [ ftext src_path, char ':', - int line, - char ':', int col - ] +pprUserSpan _ (UnhelpfulSpan s) = ftext s -pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> ftext mod -pprUserSpan (UnhelpfulSpan s) = ftext s +pprDefnLoc :: SrcSpan -> SDoc +-- ^ Pretty prints information about the 'SrcSpan' in the style "defined at ..." +pprDefnLoc loc + | isGoodSrcSpan loc = ptext (sLit "Defined at") <+> ppr loc + | otherwise = ppr loc \end{code} %************************************************************************ @@ -387,17 +448,25 @@ getLoc (L l _) = l noLoc :: e -> Located e noLoc e = L noSrcSpan e +mkGeneralLocated :: String -> e -> Located e +mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) e + combineLocs :: Located a -> Located b -> SrcSpan combineLocs a b = combineSrcSpans (getLoc a) (getLoc b) +-- | Combine locations from two 'Located' things and add them to a third thing addCLoc :: Located a -> Located b -> c -> Located c addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c -- not clear whether to add a general Eq instance, but this is useful sometimes: + +-- | Tests whether the two located things are equal eqLocated :: Eq a => Located a -> Located a -> Bool eqLocated a b = unLoc a == unLoc b --- not clear whether to add a general Eq instance, but this is useful sometimes: +-- not clear whether to add a general Ord instance, but this is useful sometimes: + +-- | Tests the ordering of the two located things cmpLocated :: Ord a => Located a -> Located a -> Ordering cmpLocated a b = unLoc a `compare` unLoc b @@ -405,18 +474,18 @@ instance Functor Located where fmap f (L l e) = L l (f e) instance Outputable e => Outputable (Located e) where - ppr (L span e) = ppr e - -- do we want to dump the span in debugSty mode? + ppr (L l e) = ifPprDebug (braces (pprUserSpan False l)) <> ppr e + -- Print spans without the file name etc \end{code} - %************************************************************************ %* * -\subsection{Manipulating SrcSpans} +\subsection{Ordering SrcSpans for InteractiveUI} %* * %************************************************************************ \begin{code} +-- | Alternative strategies for ordering 'SrcSpan's leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering rightmost = flip compare leftmost_smallest = compare @@ -425,14 +494,18 @@ leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b) (srcSpanEnd b `compare` srcSpanEnd a) -spans :: SrcSpan -> (Int,Int) -> Bool +-- | Determines whether a span encloses a given line and column index +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 +-- | Determines whether a span is enclosed by another one +isSubspanOf :: SrcSpan -- ^ The span that may be enclosed by the other + -> SrcSpan -- ^ The span it may be enclosed by + -> Bool isSubspanOf src parent - | optSrcSpanFileName parent /= optSrcSpanFileName src = False + | srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False | otherwise = srcSpanStart parent <= srcSpanStart src && srcSpanEnd parent >= srcSpanEnd src -\end{code} \ No newline at end of file +\end{code}