X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;fp=ghc%2Fcompiler%2FbasicTypes%2FSrcLoc.lhs;h=0000000000000000000000000000000000000000;hb=0065d5ab628975892cea1ec7303f968c3338cbe1;hp=51d4318b0be60e8c785d8a28b959b04e4c7a62f3;hpb=28a464a75e14cece5db40f2765a29348273ff2d2;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/SrcLoc.lhs b/ghc/compiler/basicTypes/SrcLoc.lhs deleted file mode 100644 index 51d4318..0000000 --- a/ghc/compiler/basicTypes/SrcLoc.lhs +++ /dev/null @@ -1,386 +0,0 @@ -% -% (c) The University of Glasgow, 1992-2003 -% -%************************************************************************ -%* * -\section[SrcLoc]{The @SrcLoc@ type} -%* * -%************************************************************************ - -\begin{code} -module SrcLoc ( - SrcLoc, -- Abstract - - mkSrcLoc, isGoodSrcLoc, mkGeneralSrcLoc, - noSrcLoc, -- "I'm sorry, I haven't a clue" - 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 - - 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 -\end{code} - -%************************************************************************ -%* * -\subsection[SrcLoc-SrcLocations]{Source-location information} -%* * -%************************************************************************ - -We keep information about the {\em definition} point for each entity; -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 - -- 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 - - | UnhelpfulLoc FastString -- Just a general indication -\end{code} - -Note that an entity might be imported via more than one route, and -there could be more than one ``definition point'' --- in two or more -\tr{.hi} files. We deemed it probably-unworthwhile to cater for this -rare case. - -%************************************************************************ -%* * -\subsection[SrcLoc-access-fns]{Access functions for names} -%* * -%************************************************************************ - -Things to make 'em: -\begin{code} -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 - -srcLocFile :: SrcLoc -> FastString -srcLocFile (SrcLoc fname _ _) = fname -srcLocFile other = FSLIT(" Int -srcLocLine (SrcLoc _ l c) = l -srcLocLine other = panic "srcLocLine: unknown line" - -srcLocCol :: SrcLoc -> Int -srcLocCol (SrcLoc _ l c) = c -srcLocCol other = panic "srcLocCol: unknown col" - -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} - -%************************************************************************ -%* * -\subsection[SrcLoc-instances]{Instance declarations for various names} -%* * -%************************************************************************ - -\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 (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2 -cmpSrcLoc (UnhelpfulLoc _) other = LT - -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 - -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 " #-}"] - - 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 (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}