X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=c3249dfd27a08790da80c836c6e4cba11dcb33cd;hb=6ff1e84bcef3c4aba42c1b6e90f2eba84c8b02ac;hp=1c3cc687e595fdc32ccf6bae09efaa1619de2b6a;hpb=9adbdb312507dcc7d5777e36376535918549103b;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs index 1c3cc68..c3249df 100644 --- a/ghc/compiler/basicTypes/SrcLoc.lhs +++ b/ghc/compiler/basicTypes/SrcLoc.lhs @@ -11,11 +11,11 @@ module SrcLoc ( SrcLoc, -- Abstract - mkSrcLoc, isGoodSrcLoc, + mkSrcLoc, isGoodSrcLoc, isWiredInLoc, noSrcLoc, -- "I'm sorry, I haven't a clue" importedSrcLoc, -- Unknown place in an interface - builtinSrcLoc, -- Something wired into the compiler + wiredInSrcLoc, -- Something wired into the compiler generatedSrcLoc, -- Code generated within the compiler incSrcLine, replaceSrcLine, @@ -30,7 +30,9 @@ import Util ( thenCmp ) import Outputable import FastString ( unpackFS ) import FastTypes -import GlaExts ( Int(..), (+#) ) +import FastString + +import GLAEXTS ( (+#) ) \end{code} %************************************************************************ @@ -43,12 +45,16 @@ We keep information about the {\em definition} point for each entity; this is the obvious stuff: \begin{code} data SrcLoc - = SrcLoc FAST_STRING -- A precise location (file name) - FastInt + = WiredInLoc -- Used exclusively for Ids and TyCons + -- that are totally wired in to the + -- compiler. That supports the + -- occasionally-useful predicate + -- isWiredInName - | UnhelpfulSrcLoc FAST_STRING -- Just a general indication + | SrcLoc FastString -- A precise location (file name) + FastInt - | NoSrcLoc + | UnhelpfulSrcLoc FastString -- Just a general indication \end{code} Note that an entity might be imported via more than one route, and @@ -65,15 +71,18 @@ rare case. Things to make 'em: \begin{code} mkSrcLoc x y = SrcLoc x (iUnbox y) -noSrcLoc = NoSrcLoc -importedSrcLoc = UnhelpfulSrcLoc SLIT("") -builtinSrcLoc = UnhelpfulSrcLoc SLIT("") -generatedSrcLoc = UnhelpfulSrcLoc SLIT("") +wiredInSrcLoc = WiredInLoc +noSrcLoc = UnhelpfulSrcLoc FSLIT("") +importedSrcLoc = UnhelpfulSrcLoc FSLIT("") +generatedSrcLoc = UnhelpfulSrcLoc FSLIT("") isGoodSrcLoc (SrcLoc _ _) = True isGoodSrcLoc other = False -srcLocFile :: SrcLoc -> FAST_STRING +isWiredInLoc WiredInLoc = True +isWiredInLoc other = False + +srcLocFile :: SrcLoc -> FastString srcLocFile (SrcLoc fname _) = fname srcLocLine :: SrcLoc -> FastInt @@ -103,13 +112,13 @@ instance Eq SrcLoc where instance Ord SrcLoc where compare = cmpSrcLoc -cmpSrcLoc NoSrcLoc NoSrcLoc = EQ -cmpSrcLoc NoSrcLoc other = LT +cmpSrcLoc WiredInLoc WiredInLoc = EQ +cmpSrcLoc WiredInLoc other = LT cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2 cmpSrcLoc (UnhelpfulSrcLoc s1) other = GT -cmpSrcLoc (SrcLoc s1 l1) NoSrcLoc = GT +cmpSrcLoc (SrcLoc s1 l1) WiredInLoc = GT cmpSrcLoc (SrcLoc s1 l1) (UnhelpfulSrcLoc _) = LT cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2) = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) where @@ -120,17 +129,15 @@ cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2) = (s1 `compare` s2) `thenCmp` (l1 ` instance Outputable SrcLoc where ppr (SrcLoc src_path src_line) = getPprStyle $ \ sty -> - if userStyle sty then - hcat [ text src_file, char ':', int (iBox src_line) ] - else - if debugStyle sty then - hcat [ ptext src_path, char ':', int (iBox src_line) ] + if userStyle sty || debugStyle sty then + hcat [ ftext src_path, char ':', int (iBox src_line) ] else hcat [text "{-# LINE ", int (iBox src_line), space, - char '\"', ptext src_path, text " #-}"] + char '\"', ftext src_path, text " #-}"] where src_file = unpackFS src_path -- Leave the directory prefix intact, -- so emacs can find the file - ppr (UnhelpfulSrcLoc s) = ptext s + ppr (UnhelpfulSrcLoc s) = ftext s + ppr WiredInLoc = ptext SLIT("") \end{code}