git.iko.soy/elk
on master help sign in
Collapse Reporting.Region into Reporting.Annotation
commitdba8208358e170149a8e1faa367b815f4c980cef authorEvan Czaplicki <evancz@users.noreply.github.com> dateThu 27 Dec 2018, 11:47 (8 years ago) parent962f413
2 files changed+67−117
compare with master
unifiedsplit
compiler/src/Reporting/Annotation.hs+67−24 compiler/src/Reporting/Region.hs−93
compiler/src/Reporting/Annotation.hs+67−24
@@ -1,60 +1,103 @@
11{-# OPTIONS_GHC -Wall #-}
22module Reporting.Annotation
33 ( Located(..)
4− , at, merge
5− , map
4+ , Position(..)
5+ , Region(..)
6+ , traverse
67 , toValue
8+ , merge
9+ , at
710 , toRegion
8− , traverse
11+ , mergeRegions
12+ , zero
13+ , one
914 )
1015 where
1116
1217
13−import Prelude hiding (map, traverse)
14−import qualified Reporting.Region as R
18+import Prelude hiding (traverse)
19+import Control.Monad (liftM2)
20+import Data.Binary (Binary, get, put)
21+import Data.Word (Word16)
1522
1623
1724
18−-- ANNOTATION
25+-- LOCATED
1926
2027
2128data Located a =
22− At R.Region a
29+ At Region a -- TODO see if unpacking region is helpful
2330
2431
32+instance Functor Located where
33+ fmap f (At region a) =
34+ At region (f a)
2535
26−-- CREATE
36+
37+traverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)
38+traverse func (At region value) =
39+ At region <$> func value
2740
2841
29−at :: R.Position -> R.Position -> a -> Located a
30−at start end value =
31− At (R.Region start end) value
42+toValue :: Located a -> a
43+toValue (At _ value) =
44+ value
3245
3346
3447merge :: Located a -> Located b -> value -> Located value
35−merge (At region1 _) (At region2 _) value =
36− At (R.merge region1 region2) value
48+merge (At r1 _) (At r2 _) value =
49+ At (mergeRegions r1 r2) value
3750
3851
3952
40−-- MANIPULATE
53+-- POSITION
4154
4255
43−map :: (a -> b) -> Located a -> Located b
44−map f (At info value) =
45− At info (f value)
56+data Position =
57+ Position
58+ {-# UNPACK #-} !Word16
59+ {-# UNPACK #-} !Word16
60+ deriving (Eq)
61+
62+
63+at :: Position -> Position -> a -> Located a
64+at start end a =
65+ At (Region start end) a
4666
4767
48−toValue :: Located a -> a
49−toValue (At _ value) =
50− value
5168
69+-- REGION
5270
53−toRegion :: Located a -> R.Region
71+
72+data Region = Region Position Position
73+ deriving (Eq)
74+
75+
76+toRegion :: Located a -> Region
5477toRegion (At region _) =
5578 region
5679
5780
58−traverse :: (Functor f) => (a -> f b) -> Located a -> f (Located b)
59−traverse func (At region value) =
60− At region <$> func value
81+mergeRegions :: Region -> Region -> Region
82+mergeRegions (Region start _) (Region _ end) =
83+ Region start end
84+
85+
86+zero :: Region
87+zero =
88+ Region (Position 0 0) (Position 0 0)
89+
90+
91+one :: Region
92+one =
93+ Region (Position 1 1) (Position 1 1)
94+
95+
96+instance Binary Region where
97+ put (Region a b) = put a >> put b
98+ get = liftM2 Region get get
99+
100+
101+instance Binary Position where
102+ put (Position a b) = put a >> put b
103+ get = liftM2 Position get get
compiler/src/Reporting/Region.hsdeleted−93
@@ -1,93 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Reporting.Region
3− ( Region(..)
4− , Position(..)
5− , zero
6− , one
7− , merge
8− , encode
9− )
10− where
11−
12−
13−import qualified Json.Encode as Json
14−import Data.Binary (Binary, get, put)
15−
16−
17−
18−-- REGION
19−
20−
21−data Region =
22− Region
23− { _start :: !Position
24− , _end :: !Position
25− }
26− deriving (Eq, Ord)
27−
28−
29−data Position =
30− Position
31− { _line :: !Int
32− , _column :: !Int
33− }
34− deriving (Eq, Ord)
35−
36−
37−merge :: Region -> Region -> Region
38−merge (Region start _) (Region _ end) =
39− Region start end
40−
41−
42−{-# NOINLINE zero #-}
43−zero :: Region
44−zero =
45− Region (Position 0 0) (Position 0 0)
46−
47−
48−{-# NOINLINE one #-}
49−one :: Region
50−one =
51− Region (Position 1 1) (Position 1 1)
52−
53−
54−
55−-- JSON
56−
57−
58−encode :: Region -> Json.Value
59−encode (Region start end) =
60− Json.object
61− [ ("start", encodePosition start)
62− , ("end", encodePosition end)
63− ]
64−
65−
66−encodePosition :: Position -> Json.Value
67−encodePosition (Position line column) =
68− Json.object
69− [ ("line", Json.int line)
70− , ("column", Json.int column)
71− ]
72−
73−
74−
75−-- BINARY
76−
77−
78−instance Binary Region where
79− get =
80− Region <$> get <*> get
81−
82− put (Region start end) =
83− do put start
84− put end
85−
86−
87−instance Binary Position where
88− get =
89− Position <$> get <*> get
90−
91− put (Position line column) =
92− do put line
93− put column