X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FbasicTypes%2FSrcLoc.lhs;h=fda74e0110055155684e996a7fbab760c0549aca;hb=cc51a698c0938edaa3ccc95db19150bbaec6f795;hp=9e84c642ac026799d5e5b5d281b6160cea900892;hpb=c5ff473955ffc2c1e4de76ae3d6eb2a37f785001;p=ghc-hetmet.git diff --git a/compiler/basicTypes/SrcLoc.lhs b/compiler/basicTypes/SrcLoc.lhs index 9e84c64..fda74e0 100644 --- a/compiler/basicTypes/SrcLoc.lhs +++ b/compiler/basicTypes/SrcLoc.lhs @@ -10,7 +10,6 @@ module SrcLoc ( noSrcLoc, -- "I'm sorry, I haven't a clue" advanceSrcLoc, - importedSrcLoc, -- Unknown place in an interface generatedSrcLoc, -- Code generated within the compiler interactiveSrcLoc, -- Code from an interactive session @@ -22,7 +21,6 @@ module SrcLoc ( SrcSpan, -- Abstract noSrcSpan, wiredInSrcSpan, -- Something wired into the compiler - importedSrcSpan, -- Unknown place in an interface mkGeneralSrcSpan, isGoodSrcSpan, isOneLineSpan, mkSrcSpan, srcLocSpan, @@ -63,16 +61,9 @@ data SrcLoc -- 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 FastString -- 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} @@ -81,7 +72,10 @@ rare case. Things to make 'em: \begin{code} +mkSrcLoc :: FastString -> Int -> Int -> SrcLoc mkSrcLoc x line col = SrcLoc x line col + +noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc noSrcLoc = UnhelpfulLoc FSLIT("") generatedSrcLoc = UnhelpfulLoc FSLIT("") interactiveSrcLoc = UnhelpfulLoc FSLIT("") @@ -89,26 +83,24 @@ interactiveSrcLoc = UnhelpfulLoc FSLIT("") mkGeneralSrcLoc :: FastString -> SrcLoc mkGeneralSrcLoc = UnhelpfulLoc -importedSrcLoc :: FastString -> SrcLoc -importedSrcLoc mod_name = ImportedLoc mod_name - +isGoodSrcLoc :: SrcLoc -> Bool isGoodSrcLoc (SrcLoc _ _ _) = True -isGoodSrcLoc other = False +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" +srcLocLine (SrcLoc _ l _) = l +srcLocLine _other = panic "srcLocLine: unknown line" srcLocCol :: SrcLoc -> Int -srcLocCol (SrcLoc _ l c) = c -srcLocCol other = panic "srcLocCol: unknown col" +srcLocCol (SrcLoc _ _ 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 _) '\n' = SrcLoc f (l + 1) 0 advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1) advanceSrcLoc loc _ = loc -- Better than nothing \end{code} @@ -123,22 +115,19 @@ advanceSrcLoc loc _ = loc -- Better than nothing -- 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 + EQ -> True + _other -> False instance Ord SrcLoc where compare = cmpSrcLoc - + +cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering 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 (UnhelpfulLoc _) _other = LT cmpSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2) = (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2) -cmpSrcLoc (SrcLoc _ _ _) other = GT +cmpSrcLoc (SrcLoc _ _ _) _other = GT instance Outputable SrcLoc where ppr (SrcLoc src_path src_line src_col) @@ -152,7 +141,6 @@ instance Outputable SrcLoc where hcat [text "{-# LINE ", int src_line, space, char '\"', ftext src_path, text " #-}"] - ppr (ImportedLoc mod) = ptext SLIT("Defined in") <+> ftext mod ppr (UnhelpfulLoc s) = ftext s \end{code} @@ -195,8 +183,6 @@ data SrcSpan srcSpanCol :: !Int } - | ImportedSpan FastString -- Module name - | UnhelpfulSpan FastString -- Just a general indication -- also used to indicate an empty span @@ -208,13 +194,14 @@ instance Ord SrcSpan where (srcSpanStart a `compare` srcSpanStart b) `thenCmp` (srcSpanEnd a `compare` srcSpanEnd b) +noSrcSpan, wiredInSrcSpan :: SrcSpan noSrcSpan = UnhelpfulSpan FSLIT("") wiredInSrcSpan = UnhelpfulSpan FSLIT("") -importedSrcSpan = ImportedSpan mkGeneralSrcSpan :: FastString -> SrcSpan mkGeneralSrcSpan = UnhelpfulSpan +isGoodSrcSpan :: SrcSpan -> Bool isGoodSrcSpan SrcSpanOneLine{} = True isGoodSrcSpan SrcSpanMultiLine{} = True isGoodSrcSpan SrcSpanPoint{} = True @@ -235,10 +222,13 @@ isOneLineSpan s -------------------------------------------------------- -- Don't export these four; --- they panic on Imported, Unhelpful. +-- they panic on Unhelpful. -- They are for internal use only -- Urk! Some are needed for Lexer.x; see comment in export list +srcSpanStartLine, srcSpanEndLine, srcSpanStartCol, srcSpanEndCol + :: SrcSpan -> Int + srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l @@ -260,13 +250,13 @@ srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c srcSpanEndCol _ = panic "SrcLoc.srcSpanEndCol" -------------------------------------------------------- -srcSpanStart (ImportedSpan str) = ImportedLoc str +srcSpanStart, srcSpanEnd :: SrcSpan -> SrcLoc + 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) @@ -274,14 +264,11 @@ srcSpanEnd 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 @@ -297,10 +284,8 @@ mkSrcSpan loc1 loc2 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 (UnhelpfulSpan _) r = r -- this seems more useful +combineSrcSpans l (UnhelpfulSpan _) = l combineSrcSpans start end = case line1 `compare` line2 of EQ -> case col1 `compare` col2 of @@ -317,7 +302,7 @@ combineSrcSpans start end file = srcSpanFile start pprDefnLoc :: SrcSpan -> SDoc --- "defined at ..." or "imported from ..." +-- "defined at ..." pprDefnLoc loc | isGoodSrcSpan loc = ptext SLIT("Defined at") <+> ppr loc | otherwise = ppr loc @@ -332,6 +317,7 @@ instance Outputable SrcSpan where char '\"', ftext (srcSpanFile span), text " #-}"] +pprUserSpan :: SrcSpan -> SDoc pprUserSpan (SrcSpanOneLine src_path line start_col end_col) = hcat [ ftext src_path, char ':', int line, @@ -357,7 +343,6 @@ pprUserSpan (SrcSpanPoint src_path line col) char ':', int col ] -pprUserSpan (ImportedSpan mod) = ptext SLIT("Defined in") <+> ftext mod pprUserSpan (UnhelpfulSpan s) = ftext s \end{code} @@ -398,7 +383,7 @@ 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 + ppr (L _ e) = ppr e -- do we want to dump the span in debugSty mode? \end{code} @@ -428,4 +413,4 @@ isSubspanOf src parent | otherwise = srcSpanStart parent <= srcSpanStart src && srcSpanEnd parent >= srcSpanEnd src -\end{code} \ No newline at end of file +\end{code}