X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=ea32651645b3e019ed22a817b43eccfb520ee3fd;hb=9d899efe741906ad957cf3ad84122f62c73a9de6;hp=e028c1267696554047816469e012be63b6bdcad3;hpb=38e7ac3ffa32d75c1922e7247a910e06d9957116;p=ghc-hetmet.git diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index e028c12..ea32651 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -11,7 +11,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 @@ -22,11 +21,14 @@ 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 @@ -60,7 +62,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} @@ -81,13 +83,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 @@ -150,7 +151,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} @@ -193,7 +194,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 @@ -206,7 +207,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 @@ -216,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 @@ -306,11 +315,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 @@ -347,7 +356,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}