Fixing Hpc SrcSpan usage; rejecting SrcSpans that are not in the source file

[ghc-hetmet.git] / compiler / basicTypes / SrcLoc.lhs

diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs
index c1b49e9..ea32651 100644 (file)
--- a/compiler/basicTypes/SrcLoc.lhs
+++ b/compiler/basicTypes/SrcLoc.lhs
@@ -28,6 +28,7 @@ module SrcLoc (
        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
@@ -218,6 +219,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