X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=cf68b79ae796e3e6db77e618adb7cb9fd565db06;hb=1967fd3474913f3c0dc72b070019a830223c7fab;hp=44c51f36a19f1286a11a0c00e35955b3b386695b;hpb=f3399c446c7507d46d6cc550aa2fe7027dbc1b5b;p=ghc-hetmet.git diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index 44c51f3..cf68b79 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -43,6 +43,7 @@ module SrcLoc ( import Util import Outputable import FastString +import System.FilePath \end{code} %************************************************************************ @@ -56,8 +57,8 @@ this is the obvious stuff: \begin{code} data SrcLoc = SrcLoc FastString -- A precise location (file name) - !Int -- line number, begins at 1 - !Int -- column number, begins at 0 + {-# UNPACK #-} !Int -- line number, begins at 1 + {-# UNPACK #-} !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 @@ -129,17 +130,20 @@ cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2) = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2) cmpSrcLoc (SrcLoc _ _ _) _other = GT +pprFastFilePath :: FastString -> SDoc +pprFastFilePath path = text $ normalise $ unpackFS path + 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 " #-}"] + 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} @@ -163,27 +167,27 @@ 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 } - | UnhelpfulSpan FastString -- Just a general indication + | UnhelpfulSpan !FastString -- Just a general indication -- also used to indicate an empty span #ifdef DEBUG @@ -316,15 +320,15 @@ 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 span + else + hcat [text "{-# LINE ", int (srcSpanStartLine span), space, + char '\"', pprFastFilePath $ srcSpanFile span, text " #-}"] pprUserSpan :: SrcSpan -> SDoc pprUserSpan (SrcSpanOneLine src_path line start_col end_col) - = hcat [ ftext src_path, char ':', + = hcat [ pprFastFilePath src_path, char ':', int line, char ':', int start_col ] @@ -335,7 +339,7 @@ pprUserSpan (SrcSpanOneLine src_path line start_col end_col) else char '-' <> int (end_col-1) pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol) - = hcat [ ftext src_path, char ':', + = hcat [ pprFastFilePath src_path, char ':', parens (int sline <> char ',' <> int scol), char '-', parens (int eline <> char ',' <> @@ -343,7 +347,7 @@ pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol) ] pprUserSpan (SrcSpanPoint src_path line col) - = hcat [ ftext src_path, char ':', + = hcat [ pprFastFilePath src_path, char ':', int line, char ':', int col ]