module SrcLoc (
RealSrcLoc,
SrcLoc(..),
mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc,
noSrcLoc,
generatedSrcLoc,
interactiveSrcLoc,
advanceSrcLoc,
srcLocFile,
srcLocLine,
srcLocCol,
RealSrcSpan,
SrcSpan(..),
mkGeneralSrcSpan, mkSrcSpan, mkRealSrcSpan,
noSrcSpan,
wiredInSrcSpan,
srcLocSpan, realSrcLocSpan,
combineSrcSpans,
srcSpanStart, srcSpanEnd,
realSrcSpanStart, realSrcSpanEnd,
srcSpanFileName_maybe,
showUserSpan, pprUserRealSpan,
srcSpanFile,
srcSpanStartLine, srcSpanEndLine,
srcSpanStartCol, srcSpanEndCol,
isGoodSrcSpan, isOneLineSpan,
containsSpan,
Located,
RealLocated,
GenLocated(..),
noLoc,
mkGeneralLocated,
getLoc, unLoc,
eqLocated, cmpLocated, combineLocs, addCLoc,
leftmost_smallest, leftmost_largest, rightmost,
spans, isSubspanOf, sortLocated
) where
import Util
import Outputable
import FastString
import Data.Bits
import Data.Data
import Data.List
import Data.Ord
data RealSrcLoc
= SrcLoc FastString
!Int
!Int
data SrcLoc
= RealSrcLoc !RealSrcLoc
| UnhelpfulLoc FastString
deriving Show
mkSrcLoc :: FastString -> Int -> Int -> SrcLoc
mkSrcLoc x line col = RealSrcLoc (mkRealSrcLoc x line col)
mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc x line col = SrcLoc x line col
noSrcLoc, generatedSrcLoc, interactiveSrcLoc :: SrcLoc
noSrcLoc = UnhelpfulLoc (fsLit "<no location info>")
generatedSrcLoc = UnhelpfulLoc (fsLit "<compiler-generated code>")
interactiveSrcLoc = UnhelpfulLoc (fsLit "<interactive session>")
mkGeneralSrcLoc :: FastString -> SrcLoc
mkGeneralSrcLoc = UnhelpfulLoc
srcLocFile :: RealSrcLoc -> FastString
srcLocFile (SrcLoc fname _ _) = fname
srcLocLine :: RealSrcLoc -> Int
srcLocLine (SrcLoc _ l _) = l
srcLocCol :: RealSrcLoc -> Int
srcLocCol (SrcLoc _ _ c) = c
advanceSrcLoc :: RealSrcLoc -> Char -> RealSrcLoc
advanceSrcLoc (SrcLoc f l _) '\n' = SrcLoc f (l + 1) 1
advanceSrcLoc (SrcLoc f l c) '\t' = SrcLoc f l (((((c 1) `shiftR` 3) + 1)
`shiftL` 3) + 1)
advanceSrcLoc (SrcLoc f l c) _ = SrcLoc f l (c + 1)
instance Eq SrcLoc where
loc1 == loc2 = case loc1 `cmpSrcLoc` loc2 of
EQ -> True
_other -> False
instance Eq RealSrcLoc where
loc1 == loc2 = case loc1 `cmpRealSrcLoc` loc2 of
EQ -> True
_other -> False
instance Ord SrcLoc where
compare = cmpSrcLoc
instance Ord RealSrcLoc where
compare = cmpRealSrcLoc
sortLocated :: [Located a] -> [Located a]
sortLocated things = sortBy (comparing getLoc) things
cmpSrcLoc :: SrcLoc -> SrcLoc -> Ordering
cmpSrcLoc (UnhelpfulLoc s1) (UnhelpfulLoc s2) = s1 `compare` s2
cmpSrcLoc (UnhelpfulLoc _) (RealSrcLoc _) = GT
cmpSrcLoc (RealSrcLoc _) (UnhelpfulLoc _) = LT
cmpSrcLoc (RealSrcLoc l1) (RealSrcLoc l2) = (l1 `compare` l2)
cmpRealSrcLoc :: RealSrcLoc -> RealSrcLoc -> Ordering
cmpRealSrcLoc (SrcLoc s1 l1 c1) (SrcLoc s2 l2 c2)
= (s1 `compare` s2) `thenCmp` (l1 `compare` l2) `thenCmp` (c1 `compare` c2)
instance Outputable RealSrcLoc where
ppr (SrcLoc src_path src_line src_col)
= hcat [ pprFastFilePath src_path <> colon
, int src_line <> colon
, int src_col ]
instance Outputable SrcLoc where
ppr (RealSrcLoc l) = ppr l
ppr (UnhelpfulLoc s) = ftext s
instance Data RealSrcSpan where
toConstr _ = abstractConstr "RealSrcSpan"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "RealSrcSpan"
instance Data SrcSpan where
toConstr _ = abstractConstr "SrcSpan"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "SrcSpan"
data RealSrcSpan
= SrcSpanOneLine
{ 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
}
deriving (Eq, Typeable)
data SrcSpan =
RealSrcSpan !RealSrcSpan
| UnhelpfulSpan !FastString
deriving (Eq, Ord, Typeable, Show)
noSrcSpan, wiredInSrcSpan :: SrcSpan
noSrcSpan = UnhelpfulSpan (fsLit "<no location info>")
wiredInSrcSpan = UnhelpfulSpan (fsLit "<wired into compiler>")
mkGeneralSrcSpan :: FastString -> SrcSpan
mkGeneralSrcSpan = UnhelpfulSpan
srcLocSpan :: SrcLoc -> SrcSpan
srcLocSpan (UnhelpfulLoc str) = UnhelpfulSpan str
srcLocSpan (RealSrcLoc l) = RealSrcSpan (realSrcLocSpan l)
realSrcLocSpan :: RealSrcLoc -> RealSrcSpan
realSrcLocSpan (SrcLoc file line col) = SrcSpanPoint file line col
mkRealSrcSpan :: RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan 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
mkSrcSpan :: SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan (UnhelpfulLoc str) _ = UnhelpfulSpan str
mkSrcSpan _ (UnhelpfulLoc str) = UnhelpfulSpan str
mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)
= RealSrcSpan (mkRealSrcSpan loc1 loc2)
combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (UnhelpfulSpan _) r = r
combineSrcSpans l (UnhelpfulSpan _) = l
combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)
= RealSrcSpan (combineRealSrcSpans span1 span2)
combineRealSrcSpans :: RealSrcSpan -> RealSrcSpan -> RealSrcSpan
combineRealSrcSpans span1 span2
= if line_start == line_end
then if col_start == col_end
then SrcSpanPoint file line_start col_start
else SrcSpanOneLine file line_start col_start col_end
else SrcSpanMultiLine file line_start col_start line_end col_end
where
(line_start, col_start) = min (srcSpanStartLine span1, srcSpanStartCol span1)
(srcSpanStartLine span2, srcSpanStartCol span2)
(line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1)
(srcSpanEndLine span2, srcSpanEndCol span2)
file = srcSpanFile span1
isGoodSrcSpan :: SrcSpan -> Bool
isGoodSrcSpan (RealSrcSpan _) = True
isGoodSrcSpan (UnhelpfulSpan _) = False
isOneLineSpan :: SrcSpan -> Bool
isOneLineSpan (RealSrcSpan s) = srcSpanStartLine s == srcSpanEndLine s
isOneLineSpan (UnhelpfulSpan _) = False
containsSpan :: RealSrcSpan -> RealSrcSpan -> Bool
containsSpan s1 s2
= srcSpanFile s1 == srcSpanFile s2
&& (srcSpanStartLine s1, srcSpanStartCol s1)
<= (srcSpanStartLine s2, srcSpanStartCol s2)
&& (srcSpanEndLine s1, srcSpanEndCol s1)
>= (srcSpanEndLine s2, srcSpanEndCol s2)
srcSpanStartLine :: RealSrcSpan -> Int
srcSpanEndLine :: RealSrcSpan -> Int
srcSpanStartCol :: RealSrcSpan -> Int
srcSpanEndCol :: RealSrcSpan -> Int
srcSpanStartLine SrcSpanOneLine{ srcSpanLine=l } = l
srcSpanStartLine SrcSpanMultiLine{ srcSpanSLine=l } = l
srcSpanStartLine SrcSpanPoint{ srcSpanLine=l } = l
srcSpanEndLine SrcSpanOneLine{ srcSpanLine=l } = l
srcSpanEndLine SrcSpanMultiLine{ srcSpanELine=l } = l
srcSpanEndLine SrcSpanPoint{ srcSpanLine=l } = l
srcSpanStartCol SrcSpanOneLine{ srcSpanSCol=l } = l
srcSpanStartCol SrcSpanMultiLine{ srcSpanSCol=l } = l
srcSpanStartCol SrcSpanPoint{ srcSpanCol=l } = l
srcSpanEndCol SrcSpanOneLine{ srcSpanECol=c } = c
srcSpanEndCol SrcSpanMultiLine{ srcSpanECol=c } = c
srcSpanEndCol SrcSpanPoint{ srcSpanCol=c } = c
srcSpanStart :: SrcSpan -> SrcLoc
srcSpanStart (UnhelpfulSpan str) = UnhelpfulLoc str
srcSpanStart (RealSrcSpan s) = RealSrcLoc (realSrcSpanStart s)
srcSpanEnd :: SrcSpan -> SrcLoc
srcSpanEnd (UnhelpfulSpan str) = UnhelpfulLoc str
srcSpanEnd (RealSrcSpan s) = RealSrcLoc (realSrcSpanEnd s)
realSrcSpanStart :: RealSrcSpan -> RealSrcLoc
realSrcSpanStart s = mkRealSrcLoc (srcSpanFile s)
(srcSpanStartLine s)
(srcSpanStartCol s)
realSrcSpanEnd :: RealSrcSpan -> RealSrcLoc
realSrcSpanEnd s = mkRealSrcLoc (srcSpanFile s)
(srcSpanEndLine s)
(srcSpanEndCol s)
srcSpanFileName_maybe :: SrcSpan -> Maybe FastString
srcSpanFileName_maybe (RealSrcSpan s) = Just (srcSpanFile s)
srcSpanFileName_maybe (UnhelpfulSpan _) = Nothing
instance Ord RealSrcSpan where
a `compare` b =
(realSrcSpanStart a `compare` realSrcSpanStart b) `thenCmp`
(realSrcSpanEnd a `compare` realSrcSpanEnd b)
instance Show RealSrcLoc where
show (SrcLoc filename row col)
= "SrcLoc " ++ show filename ++ " " ++ show row ++ " " ++ show col
instance Show RealSrcSpan where
show (SrcSpanOneLine file l sc ec)
= "SrcSpanOneLine " ++ show file ++ " "
++ intercalate " " (map show [l,sc,ec])
show (SrcSpanMultiLine file sl sc el ec)
= "SrcSpanMultiLine " ++ show file ++ " "
++ intercalate " " (map show [sl,sc,el,ec])
show (SrcSpanPoint file l c)
= "SrcSpanPoint " ++ show file ++ " " ++ intercalate " " (map show [l,c])
instance Outputable RealSrcSpan where
ppr span = pprUserRealSpan True span
instance Outputable SrcSpan where
ppr span = pprUserSpan True span
showUserSpan :: Bool -> SrcSpan -> String
showUserSpan show_path span = showSDocSimple (pprUserSpan show_path span)
pprUserSpan :: Bool -> SrcSpan -> SDoc
pprUserSpan _ (UnhelpfulSpan s) = ftext s
pprUserSpan show_path (RealSrcSpan s) = pprUserRealSpan show_path s
pprUserRealSpan :: Bool -> RealSrcSpan -> SDoc
pprUserRealSpan show_path (SrcSpanOneLine src_path line start_col end_col)
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
, int line <> colon
, int start_col
, ppUnless (end_col start_col <= 1) (char '-' <> int (end_col 1)) ]
pprUserRealSpan show_path (SrcSpanMultiLine src_path sline scol eline ecol)
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
, parens (int sline <> comma <> int scol)
, char '-'
, parens (int eline <> comma <> int ecol') ]
where
ecol' = if ecol == 0 then ecol else ecol 1
pprUserRealSpan show_path (SrcSpanPoint src_path line col)
= hcat [ ppWhen show_path (pprFastFilePath src_path <> colon)
, int line <> colon
, int col ]
data GenLocated l e = L l e
deriving (Eq, Ord, Typeable, Data)
type Located e = GenLocated SrcSpan e
type RealLocated e = GenLocated RealSrcSpan e
unLoc :: GenLocated l e -> e
unLoc (L _ e) = e
getLoc :: GenLocated l e -> l
getLoc (L l _) = l
noLoc :: e -> Located e
noLoc e = L noSrcSpan e
mkGeneralLocated :: String -> e -> Located e
mkGeneralLocated s e = L (mkGeneralSrcSpan (fsLit s)) 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
eqLocated :: Eq a => Located a -> Located a -> Bool
eqLocated a b = unLoc a == unLoc b
cmpLocated :: Ord a => Located a -> Located a -> Ordering
cmpLocated a b = unLoc a `compare` unLoc b
instance Functor (GenLocated l) where
fmap f (L l e) = L l (f e)
instance (Outputable l, Outputable e) => Outputable (GenLocated l e) where
ppr (L l e) =
ifPprDebug (braces (ppr l))
$$ ppr e
leftmost_smallest, leftmost_largest, rightmost :: SrcSpan -> SrcSpan -> Ordering
rightmost = flip compare
leftmost_smallest = compare
leftmost_largest a b = (srcSpanStart a `compare` srcSpanStart b)
`thenCmp`
(srcSpanEnd b `compare` srcSpanEnd a)
spans :: SrcSpan -> (Int, Int) -> Bool
spans (UnhelpfulSpan _) _ = panic "spans UnhelpfulSpan"
spans (RealSrcSpan span) (l,c) = realSrcSpanStart span <= loc && loc <= realSrcSpanEnd span
where loc = mkRealSrcLoc (srcSpanFile span) l c
isSubspanOf :: SrcSpan
-> SrcSpan
-> Bool
isSubspanOf src parent
| srcSpanFileName_maybe parent /= srcSpanFileName_maybe src = False
| otherwise = srcSpanStart parent <= srcSpanStart src &&
srcSpanEnd parent >= srcSpanEnd src