on 9cda2b2 help sign in
elk/src/AST/Annotation.hs
74 lines 2.1 kB history raw
1{-# OPTIONS_GHC -W #-}
2module AST.Annotation where
4import qualified Text.Parsec.Pos as Parsec
5import qualified Text.PrettyPrint as P
6import AST.PrettyPrint
8data Annotated annotation expr = A annotation expr
9 deriving (Show)
11data Region
12 = Span Position Position P.Doc
13 | None P.Doc
14 deriving (Show)
16data Position = Position
17 { line :: Int
18 , column :: Int
19 } deriving (Show)
21type Located expr = Annotated Region expr
23none e = A (None (pretty e)) e
24noneNoDocs e = A (None P.empty) e
26at :: (Pretty expr) => Parsec.SourcePos -> Parsec.SourcePos -> expr
27 -> Annotated Region expr
28at start end e =
29 A (Span (position start) (position end) (pretty e)) e
30 where
31 position loc = Position (Parsec.sourceLine loc) (Parsec.sourceColumn loc)
33merge (A s1 _) (A s2 _) e =
34 A (span (pretty e)) e
35 where
36 span = case (s1,s2) of
37 (Span start _ _, Span _ end _) -> Span start end
38 (Span start end _, _) -> Span start end
39 (_, Span start end _) -> Span start end
40 (_, _) -> None
42mergeOldDocs (A s1 _) (A s2 _) e =
43 A span e
44 where
45 span = case (s1,s2) of
46 (Span start _ d1, Span _ end d2) ->
47 Span start end (P.vcat [d1, P.text "\n", d2])
49 (Span _ _ _, _) -> s1
50 (_, Span _ _ _) -> s2
51 (_, _) -> None P.empty
53sameAs :: Annotated a expr -> expr' -> Annotated a expr'
54sameAs (A annotation _) expr = A annotation expr
56getRegionDocs region =
57 case region of
58 Span _ _ doc -> doc
59 None doc -> doc
61instance Pretty Region where
62 pretty span =
63 case span of
64 None _ -> P.empty
65 Span start end _ ->
66 P.text $
67 case line start == line end of
68 False -> "between lines " ++ show (line start) ++ " and " ++ show (line end)
69 True -> "on line " ++ show (line end) ++ ", column " ++
70 show (column start) ++ " to " ++ show (column end)
72instance Pretty e => Pretty (Annotated a e) where
73 pretty (A _ e) = pretty e