on 09d86de help sign in
elk/src/AST/Annotation.hs
111 lines 2.3 kB history raw
1module AST.Annotation where
3import qualified Text.Parsec.Pos as Parsec
4import qualified Text.PrettyPrint as P
5import AST.PrettyPrint
8data Annotated annotation expr
9 = A annotation expr
10 deriving (Show)
13data Region
14 = Span Position Position P.Doc
15 | None P.Doc
16 deriving (Show)
19data Position = Position
20 { line :: Int
21 , column :: Int
22 }
23 deriving (Show)
26type Located expr =
27 Annotated Region expr
30none :: (Pretty expr) => expr -> Located expr
31none e =
32 A (None (pretty e)) e
35noneNoDocs :: a -> Located a
36noneNoDocs e =
37 A (None P.empty) e
40at :: (Pretty expr)
41 => Parsec.SourcePos
42 -> Parsec.SourcePos
43 -> expr
44 -> Annotated Region expr
45at start end e =
46 A (Span (position start) (position end) (pretty e)) e
47 where
48 position loc =
49 Position (Parsec.sourceLine loc) (Parsec.sourceColumn loc)
52merge :: (Pretty expr) => Located a -> Located b -> expr -> Located expr
53merge (A s1 _) (A s2 _) e =
54 A (span (pretty e)) e
55 where
56 span =
57 case (s1,s2) of
58 (Span start _ _, Span _ end _) ->
59 Span start end
61 (Span start end _, _) ->
62 Span start end
64 (_, Span start end _) ->
65 Span start end
67 (_, _) -> None
70mergeOldDocs :: Located a -> Located b -> c -> Located c
71mergeOldDocs (A s1 _) (A s2 _) e =
72 A span e
73 where
74 span =
75 case (s1,s2) of
76 (Span start _ d1, Span _ end d2) ->
77 Span start end (P.vcat [d1, P.text "\n", d2])
79 (Span _ _ _, _) -> s1
81 (_, Span _ _ _) -> s2
83 (_, _) -> None P.empty
86sameAs :: Annotated a expr -> expr' -> Annotated a expr'
87sameAs (A annotation _) expr =
88 A annotation expr
91getRegionDocs :: Region -> P.Doc
92getRegionDocs region =
93 case region of
94 Span _ _ doc -> doc
95 None doc -> doc
98instance Pretty Region where
99 pretty span =
100 case span of
101 None _ -> P.empty
102 Span start end _ ->
103 P.text $
104 case line start == line end of
105 False -> "between lines " ++ show (line start) ++ " and " ++ show (line end)
106 True -> "on line " ++ show (line end) ++ ", column " ++
107 show (column start) ++ " to " ++ show (column end)
110instance Pretty e => Pretty (Annotated a e) where
111 pretty (A _ e) = pretty e