X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=51d4318b0be60e8c785d8a28b959b04e4c7a62f3;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=7e29d67bcc77f171778827a1c2643c46e0cc33dd;hpb=2ecf1c9f639dc75f1078e88c2e551116923f742a;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs index 7e29d67..51d4318 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-1998 +% (c) The University of Glasgow, 1992-2003 % %************************************************************************ %* * @@ -11,26 +11,39 @@ module SrcLoc ( SrcLoc, -- Abstract - mkSrcLoc, isGoodSrcLoc, + mkSrcLoc, isGoodSrcLoc, mkGeneralSrcLoc, noSrcLoc, -- "I'm sorry, I haven't a clue" + advanceSrcLoc, importedSrcLoc, -- Unknown place in an interface - builtinSrcLoc, -- Something wired into the compiler + wiredInSrcLoc, -- Something wired into the compiler generatedSrcLoc, -- Code generated within the compiler + interactiveSrcLoc, -- Code from an interactive session - incSrcLine, replaceSrcLine, - - srcLocFile, -- return the file name part. - srcLocLine -- return the line part. + srcLocFile, -- return the file name part + srcLocLine, -- return the line part + srcLocCol, -- return the column part + pprDefnLoc, + + SrcSpan, -- Abstract + noSrcSpan, + mkGeneralSrcSpan, + isGoodSrcSpan, + mkSrcSpan, srcLocSpan, + combineSrcSpans, + srcSpanFile, + srcSpanStartLine, srcSpanEndLine, + srcSpanStartCol, srcSpanEndCol, + srcSpanStart, srcSpanEnd, + + Located(..), getLoc, unLoc, noLoc, eqLocated, cmpLocated, combineLocs, addCLoc ) where #include "HsVersions.h" import Util ( thenCmp ) import Outputable -import FastString ( unpackFS ) -import FastTypes -import GlaExts ( Int(..), (+#) ) +import FastString \end{code} %************************************************************************ @@ -43,12 +56,15 @@ 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 + = SrcLoc FastString -- A precise location (file name) + !Int -- line number, begins at 1 + !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 - | UnhelpfulSrcLoc FAST_STRING -- Just a general indication + | ImportedLoc String -- Module name - | NoSrcLoc + | UnhelpfulLoc FastString -- Just a general indication \end{code} Note that an entity might be imported via more than one route, and @@ -64,27 +80,37 @@ 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("") +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 mod_name = ImportedLoc mod_name -isGoodSrcLoc (SrcLoc _ _) = True -isGoodSrcLoc other = False +isGoodSrcLoc (SrcLoc _ _ _) = True +isGoodSrcLoc other = False -srcLocFile :: SrcLoc -> FAST_STRING -srcLocFile (SrcLoc fname _) = fname +srcLocFile :: SrcLoc -> FastString +srcLocFile (SrcLoc fname _ _) = fname +srcLocFile other = FSLIT(" FastInt -srcLocLine (SrcLoc _ l) = l +srcLocLine :: SrcLoc -> Int +srcLocLine (SrcLoc _ l c) = l +srcLocLine other = panic "srcLocLine: unknown line" -incSrcLine :: SrcLoc -> SrcLoc -incSrcLine (SrcLoc s l) = SrcLoc s (l +# 1#) -incSrcLine loc = loc +srcLocCol :: SrcLoc -> Int +srcLocCol (SrcLoc _ l c) = c +srcLocCol other = panic "srcLocCol: unknown col" -replaceSrcLine :: SrcLoc -> FastInt -> SrcLoc -replaceSrcLine (SrcLoc s _) l = SrcLoc s l +advanceSrcLoc :: SrcLoc -> Char -> SrcLoc +advanceSrcLoc (SrcLoc f l c) '\n' = SrcLoc f (l + 1) 0 +advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1) +advanceSrcLoc loc _ = loc -- Better than nothing \end{code} %************************************************************************ @@ -103,35 +129,258 @@ instance Eq SrcLoc where instance Ord SrcLoc where compare = cmpSrcLoc -cmpSrcLoc NoSrcLoc NoSrcLoc = EQ -cmpSrcLoc NoSrcLoc other = LT +cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2 +cmpSrcLoc (UnhelpfulLoc _) other = LT -cmpSrcLoc (UnhelpfulSrcLoc s1) (UnhelpfulSrcLoc s2) = s1 `compare` s2 -cmpSrcLoc (UnhelpfulSrcLoc s1) other = GT +cmpSrcLoc (ImportedLoc _) (UnhelpfulLoc _) = GT +cmpSrcLoc (ImportedLoc m1) (ImportedLoc m2) = m1 `compare` m2 +cmpSrcLoc (ImportedLoc _) other = LT + +cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2) + = (s1 `compare` s2) `thenCmp` (l1 `cmpline` l2) `thenCmp` (c1 `cmpline` c2) + where + l1 `cmpline` l2 | l1 < l2 = LT + | l1 == l2 = EQ + | otherwise = GT +cmpSrcLoc (SrcLoc _ _ _) 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 (SrcLoc src_path src_line) + ppr (SrcLoc src_path src_line src_col) = getPprStyle $ \ sty -> - if userStyle sty then - hcat [ text src_file, char ':', int (iBox src_line) ] + if userStyle sty || debugStyle sty then + hcat [ ftext src_path, char ':', + int src_line, + char ':', int src_col + ] else - if debugStyle sty then - hcat [ ptext src_path, char ':', int (iBox src_line) ] + hcat [text "{-# LINE ", int src_line, space, + char '\"', ftext src_path, text " #-}"] + + ppr (ImportedLoc mod) = ptext SLIT("Imported from") <+> text mod + ppr (UnhelpfulLoc s) = ftext s +\end{code} + +%************************************************************************ +%* * +\subsection[SrcSpan]{Source Spans} +%* * +%************************************************************************ + +\begin{code} +{- | +A SrcSpan delimits a portion of a text file. It could be represented +by a pair of (line,column) coordinates, but in fact we optimise +slightly by using more compact representations for single-line and +zero-length spans, both of which are quite common. + +The end position is defined to be the column *after* the end of the +span. That is, a span of (1,1)-(1,2) is one character long, and a +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 + } + + | SrcSpanMultiLine + { srcSpanFile :: FastString, + srcSpanSLine :: !Int, + srcSpanSCol :: !Int, + srcSpanELine :: !Int, + srcSpanECol :: !Int + } + + | SrcSpanPoint + { srcSpanFile :: FastString, + srcSpanLine :: !Int, + srcSpanCol :: !Int + } + + | ImportedSpan String -- Module name + + | UnhelpfulSpan FastString -- Just a general indication + -- also used to indicate an empty span + + deriving Eq + +-- We want to order SrcSpans first by the start point, then by the end point. +instance Ord SrcSpan where + a `compare` b = + (srcSpanStart a `compare` srcSpanStart b) `thenCmp` + (srcSpanEnd a `compare` srcSpanEnd b) + +noSrcSpan = UnhelpfulSpan FSLIT("") + +mkGeneralSrcSpan :: FastString -> SrcSpan +mkGeneralSrcSpan = UnhelpfulSpan + +isGoodSrcSpan SrcSpanOneLine{} = True +isGoodSrcSpan SrcSpanMultiLine{} = True +isGoodSrcSpan SrcSpanPoint{} = True +isGoodSrcSpan _ = False + +srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l +srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l +srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l +srcSpanStartLine _ = panic "SrcLoc.srcSpanStartLine" + +srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l +srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l +srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l +srcSpanEndLine _ = panic "SrcLoc.srcSpanEndLine" + +srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l +srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l +srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l +srcSpanStartCol _ = panic "SrcLoc.srcSpanStartCol" + +srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c +srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c +srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c +srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol" + +srcSpanStart (ImportedSpan str) = ImportedLoc str +srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str +srcSpanStart s = + mkSrcLoc (srcSpanFile s) + (srcSpanStartLine s) + (srcSpanStartCol s) + +srcSpanEnd (ImportedSpan str) = ImportedLoc str +srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str +srcSpanEnd s = + mkSrcLoc (srcSpanFile s) + (srcSpanEndLine s) + (srcSpanEndCol s) + +srcLocSpan :: SrcLoc -> SrcSpan +srcLocSpan (ImportedLoc str) = ImportedSpan str +srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str +srcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col + +mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan +mkSrcSpan (ImportedLoc str) _ = ImportedSpan str +mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str +mkSrcSpan _ (ImportedLoc str) = ImportedSpan str +mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str +mkSrcSpan loc1 loc2 + | line1 == line2 = if col1 == col2 + then SrcSpanPoint file line1 col1 + else SrcSpanOneLine file line1 col1 col2 + | otherwise = SrcSpanMultiLine file line1 col1 line2 col2 + where + line1 = srcLocLine loc1 + line2 = srcLocLine loc2 + col1 = srcLocCol loc1 + col2 = srcLocCol loc2 + file = srcLocFile loc1 + +combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan +-- Assumes the 'file' part is the same in both +combineSrcSpans (ImportedSpan str) _ = ImportedSpan str +combineSrcSpans (UnhelpfulSpan str) r = r -- this seems more useful +combineSrcSpans _ (ImportedSpan str) = ImportedSpan str +combineSrcSpans l (UnhelpfulSpan str) = l +combineSrcSpans start end + = case line1 `compare` line2 of + EQ -> case col1 `compare` col2 of + EQ -> SrcSpanPoint file line1 col1 + LT -> SrcSpanOneLine file line1 col1 col2 + GT -> SrcSpanOneLine file line1 col2 col1 + LT -> SrcSpanMultiLine file line1 col1 line2 col2 + GT -> SrcSpanMultiLine file line2 col2 line1 col1 + where + line1 = srcSpanStartLine start + col1 = srcSpanStartCol start + line2 = srcSpanEndLine end + col2 = srcSpanEndCol end + file = srcSpanFile start + +pprDefnLoc :: SrcLoc -> SDoc +-- "defined at ..." or "imported from ..." +pprDefnLoc loc + | isGoodSrcLoc loc = ptext SLIT("Defined at") <+> ppr loc + | otherwise = ppr loc + +instance Outputable SrcSpan where + ppr span + = getPprStyle $ \ sty -> + if userStyle sty || debugStyle sty then + pprUserSpan span 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 = ptext SLIT("") + hcat [text "{-# LINE ", int (srcSpanStartLine span), space, + char '\"', ftext (srcSpanFile span), text " #-}"] + + +pprUserSpan (SrcSpanOneLine src_path line start_col end_col) + = hcat [ ftext src_path, char ':', + int line, + char ':', int start_col + ] + <> if end_col - start_col <= 1 + then empty + -- for single-character or point spans, we just output the starting + -- column number + else char '-' <> int (end_col-1) + +pprUserSpan (SrcSpanMultiLine src_path sline scol eline ecol) + = hcat [ ftext src_path, char ':', + parens (int sline <> char ',' <> int scol), + char '-', + parens (int eline <> char ',' <> + if ecol == 0 then int ecol else int (ecol-1)) + ] + +pprUserSpan (SrcSpanPoint src_path line col) + = hcat [ ftext src_path, char ':', + int line, + char ':', int col + ] + +pprUserSpan (ImportedSpan mod) = ptext SLIT("Imported from") <+> quotes (text mod) +pprUserSpan (UnhelpfulSpan s) = ftext s +\end{code} + +%************************************************************************ +%* * +\subsection[Located]{Attaching SrcSpans to things} +%* * +%************************************************************************ + +\begin{code} +-- | We attach SrcSpans to lots of things, so let's have a datatype for it. +data Located e = L SrcSpan e + +unLoc :: Located e -> e +unLoc (L _ e) = e + +getLoc :: Located e -> SrcSpan +getLoc (L l _) = l + +noLoc :: e -> Located e +noLoc e = L noSrcSpan e + +combineLocs :: Located a -> Located b -> SrcSpan +combineLocs a b = combineSrcSpans (getLoc a) (getLoc b) + +addCLoc :: Located a -> Located b -> c -> Located c +addCLoc a b c = L (combineSrcSpans (getLoc a) (getLoc b)) c + +-- not clear whether to add a general Eq instance, but this is useful sometimes: +eqLocated :: Eq a => Located a -> Located a -> Bool +eqLocated a b = unLoc a == unLoc b + +-- not clear whether to add a general Eq instance, but this is useful sometimes: +cmpLocated :: Ord a => Located a -> Located a -> Ordering +cmpLocated a b = unLoc a `compare` unLoc b + +instance Functor Located where + fmap f (L l e) = L l (f e) + +instance Outputable e => Outputable (Located e) where + ppr (L span e) = ppr e + -- do we want to dump the span in debugSty mode? \end{code}