X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=3dccd51cb18a6069567e730c71353c31dc87b107;hb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;hp=f4a3b2b3884c87bba2aa02aa8d6e6037728f7c42;hpb=7a3bd641457666e10d0a47be9f22762e03defbf0;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs index f4a3b2b..3dccd51 100644 --- a/ghc/compiler/basicTypes/SrcLoc.lhs +++ b/ghc/compiler/basicTypes/SrcLoc.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1994 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % %************************************************************************ %* * @@ -8,8 +8,6 @@ %************************************************************************ \begin{code} -#include "HsVersions.h" - module SrcLoc ( SrcLoc, -- Abstract @@ -21,13 +19,20 @@ module SrcLoc ( mkBuiltinSrcLoc, -- Something wired into the compiler - mkGeneratedSrcLoc -- Code generated within the compiler + mkGeneratedSrcLoc, -- Code generated within the compiler + + incSrcLine, replaceSrcLine, + + srcLocFile, -- return the file name part. + srcLocLine -- return the line part. ) where -IMP_Ubiq() +#include "HsVersions.h" -import PprStyle ( PprStyle(..) ) -import Pretty +import Util ( thenCmp ) +import Outputable +import FastString ( unpackFS ) +import GlaExts ( Int(..), (+#) ) \end{code} %************************************************************************ @@ -42,7 +47,7 @@ this is the obvious stuff: data SrcLoc = NoSrcLoc - | SrcLoc FAST_STRING -- A precise location + | SrcLoc FAST_STRING -- A precise location (file name) FAST_INT | UnhelpfulSrcLoc FAST_STRING -- Just a general indication @@ -70,6 +75,19 @@ mkGeneratedSrcLoc = UnhelpfulSrcLoc SLIT("") isNoSrcLoc NoSrcLoc = True isNoSrcLoc other = False + +srcLocFile :: SrcLoc -> FAST_STRING +srcLocFile (SrcLoc fname _) = fname + +srcLocLine :: SrcLoc -> FAST_INT +srcLocLine (SrcLoc _ l) = l + +incSrcLine :: SrcLoc -> SrcLoc +incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#) +incSrcLine loc = loc + +replaceSrcLine :: SrcLoc -> FAST_INT -> SrcLoc +replaceSrcLine (SrcLoc s _) l = SrcLoc s l \end{code} %************************************************************************ @@ -79,15 +97,45 @@ isNoSrcLoc other = False %************************************************************************ \begin{code} +-- 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 + +instance Ord SrcLoc where + compare = cmpSrcLoc + +cmpSrcLoc NoSrcLoc NoSrcLoc = EQ +cmpSrcLoc NoSrcLoc 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) (UnhelpfulSrcLoc _) = LT +cmpSrcLoc (SrcLoc s1 l1) (SrcLoc s2 l2) = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) + where + l1 `cmpline` l2 | l1 <# l2 = LT + | l1 ==# l2 = EQ + | otherwise = GT + instance Outputable SrcLoc where - ppr PprForUser (SrcLoc src_file src_line) - = ppBesides [ ppPStr src_file, ppStr ": ", ppStr (show IBOX(src_line)) ] - - ppr sty (SrcLoc src_file src_line) - = ppBesides [ppPStr SLIT("{-# LINE "), ppStr (show IBOX(src_line)), ppSP, - ppChar '"', ppPStr src_file, ppPStr SLIT("\" #-}")] - - ppr sty (UnhelpfulSrcLoc s) = ppPStr s - - ppr sty NoSrcLoc = ppStr "" + 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) ] + else + hcat [text "{-# LINE ", int IBOX(src_line), space, + char '\"', ptext 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 NoSrcLoc = text "" \end{code}