@@ -1,40 +1,56 @@
11{-# LANGUAGE DeriveDataTypeable #-}
22module SourceSyntax.Location where
33
4−import qualified Text.Parsec.Pos as Parsec
54import Data.Data
5+import Text.PrettyPrint
6+import SourceSyntax.PrettyPrint
7+import qualified Text.Parsec.Pos as Parsec
68
79data SrcPos = Pos { line :: Int, column :: Int }
810 deriving (Eq, Ord, Data, Typeable)
911
10−data SrcSpan = Span SrcPos SrcPos | NoSpan
12+data SrcSpan = Span SrcPos SrcPos String | NoSpan String
1113 deriving (Eq, Ord, Data, Typeable)
1214
1315data Located e = L SrcSpan e
1416 deriving (Eq, Ord, Data, Typeable)
1517
18+none e = L (NoSpan (render $ pretty e)) e
19+noneNoDocs = L (NoSpan "")
20+
21+at start end e = L (Span (Pos (Parsec.sourceLine start) (Parsec.sourceColumn start))
22+ (Pos (Parsec.sourceLine end ) (Parsec.sourceColumn end ))
23+ (render $ pretty e)) e
24+
25+merge (L s1 _) (L s2 _) e = L (span (render $ pretty e)) e
26+ where span = case (s1,s2) of
27+ (Span start _ _, Span _ end _) -> Span start end
28+ (Span start end _, _) -> Span start end
29+ (_, Span start end _) -> Span start end
30+ (_, _) -> NoSpan
31+
32+mergeOldDocs (L s1 _) (L s2 _) e = L span e
33+ where span = case (s1,s2) of
34+ (Span start _ d1, Span _ end d2) -> Span start end (d1 ++ "\n\n" ++ d2)
35+ (Span _ _ _, _) -> s1
36+ (_, Span _ _ _) -> s2
37+ (_, _) -> NoSpan ""
38+
39+sameAs (L s _) = L s
40+
1641
1742instance Show SrcPos where
18− show (Pos r c) = "Line " ++ show r ++ ", Column " ++ show c
43+ show (Pos r c) = show r ++ "," ++ show c
1944
2045instance Show SrcSpan where
2146 show span =
2247 case span of
23− Span start end -> show start
24− NoSpan -> ""
48+ Span start end _ -> show start ++ " to " ++ show end
49+ NoSpan str -> str
2550
2651instance Show e => Show (Located e) where
27− show (L _ e) = show e
52+ show (L s e) = "L (" ++ show s ++ ") (" ++ show e ++ ")"
2853
29−none = L NoSpan
30−
31−at start end = L (Span (Pos (Parsec.sourceLine start) (Parsec.sourceColumn start))
32− (Pos (Parsec.sourceLine end ) (Parsec.sourceColumn end )))
33−
34−merge (L s1 _) (L s2 _) = L span
35− where span = case (s1,s2) of
36− (Span start _, Span _ end) -> Span start end
37− (_, NoSpan) -> s1
38− (NoSpan, _) -> s2
54+instance Pretty a => Pretty (Located a) where
55+ pretty (L _ e) = pretty e
3956
40−sameAs (L s _) = L s