git.iko.soy/elk
on master help sign in
Update interfaces to be more precise in new compilation scheme
6636a97Evan Czaplicki
compiler/src/Elm/Interface.hs+90−65
compare with master
unifiedsplit
@@ -1,62 +1,59 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2module Elm.Interface
2module Elm.Interface
3− ( Interfaces
4− , Interface(..)
3+ ( Interface(..)
5− , Union
4+ , Union(..)
6− , Alias
5+ , Alias(..)
7 , Binop(..)
6 , Binop(..)
8 , fromModule
7 , fromModule
9 , toPublicUnion
8 , toPublicUnion
10 , toPublicAlias
9 , toPublicAlias
11− , toUnionInternals
10+ , DependencyInterface(..)
12− , toAliasInternals
11+ , public
12+ , private
13+ , privatize
13 )
14 )
14 where
15 where
15
16
16
17
17−import Control.Monad (liftM4)
18+import Control.Monad (liftM, liftM2, liftM4, liftM5)
18import Data.Binary
19import Data.Binary
19−import Data.Map ((!))
20+import Data.Map.Strict ((!))
20−import qualified Data.Map as Map
21+import qualified Data.Map.Strict as Map
21import qualified Data.Map.Merge.Strict as Map
22import qualified Data.Map.Merge.Strict as Map
22import qualified Data.Name as Name
23import qualified Data.Name as Name
23
24
24import qualified AST.Canonical as Can
25import qualified AST.Canonical as Can
25import qualified AST.Utils.Binop as Binop
26import qualified AST.Utils.Binop as Binop
26−import qualified Elm.ModuleName as ModuleName
27+import qualified Elm.Package as Pkg
27import qualified Reporting.Annotation as A
28import qualified Reporting.Annotation as A
28
29
29
30
30
31
31−-- INTERFACES
32−
33−
34−type Interfaces =
35− Map.Map ModuleName.Canonical Interface
36−
37−
38−
39-- INTERFACE
32-- INTERFACE
40
33
41
34
42data Interface =
35data Interface =
43 Interface
36 Interface
37+ { _home :: Pkg.Name
44− { _types :: Map.Map Name.Name Can.Annotation
38+ , _values :: Map.Map Name.Name Can.Annotation
45 , _unions :: Map.Map Name.Name Union
39 , _unions :: Map.Map Name.Name Union
46 , _aliases :: Map.Map Name.Name Alias
40 , _aliases :: Map.Map Name.Name Alias
47 , _binops :: Map.Map Name.Name Binop
41 , _binops :: Map.Map Name.Name Binop
48 }
42 }
43+ deriving (Eq)
49
44
50
45
51data Union
46data Union
52 = OpenUnion Can.Union
47 = OpenUnion Can.Union
53 | ClosedUnion Can.Union
48 | ClosedUnion Can.Union
54 | PrivateUnion Can.Union
49 | PrivateUnion Can.Union
50+ deriving (Eq)
55
51
56
52
57data Alias
53data Alias
58 = PublicAlias Can.Alias
54 = PublicAlias Can.Alias
59 | PrivateAlias Can.Alias
55 | PrivateAlias Can.Alias
56+ deriving (Eq)
60
57
61
58
62data Binop =
59data Binop =
@@ -66,24 +63,26 @@ data Binop =
66 , _op_associativity :: Binop.Associativity
63 , _op_associativity :: Binop.Associativity
67 , _op_precedence :: Binop.Precedence
64 , _op_precedence :: Binop.Precedence
68 }
65 }
66+ deriving (Eq)
69
67
70
68
71
69
72-- FROM MODULE
70-- FROM MODULE
73
71
74
72
75−fromModule :: Map.Map Name.Name Can.Annotation -> Can.Module -> Interface
73+fromModule :: Pkg.Name -> Can.Module -> Map.Map Name.Name Can.Annotation -> Interface
76−fromModule types (Can.Module _ _ exports _ unions aliases binops _) =
74+fromModule home (Can.Module _ exports _ unions aliases binops _) annotations =
77 Interface
75 Interface
78− { _types = privatize exports types
76+ { _home = home
77+ , _values = restrict exports annotations
79− , _unions = privatizeUnions exports unions
78+ , _unions = restrictUnions exports unions
80− , _aliases = privatizeAliases exports aliases
79+ , _aliases = restrictAliases exports aliases
81− , _binops = privatize exports (Map.map (toOp types) binops)
80+ , _binops = restrict exports (Map.map (toOp annotations) binops)
82 }
81 }
83
82
84
83
85−privatize :: Can.Exports -> Map.Map Name.Name a -> Map.Map Name.Name a
84+restrict :: Can.Exports -> Map.Map Name.Name a -> Map.Map Name.Name a
86−privatize exports dict =
85+restrict exports dict =
87 case exports of
86 case exports of
88 Can.ExportEverything _ ->
87 Can.ExportEverything _ ->
89 dict
88 dict
@@ -97,8 +96,8 @@ toOp types (Can.Binop_ associativity precedence name) =
97 Binop name (types ! name) associativity precedence
96 Binop name (types ! name) associativity precedence
98
97
99
98
100−privatizeUnions :: Can.Exports -> Map.Map Name.Name Can.Union -> Map.Map Name.Name Union
99+restrictUnions :: Can.Exports -> Map.Map Name.Name Can.Union -> Map.Map Name.Name Union
101−privatizeUnions exports unions =
100+restrictUnions exports unions =
102 case exports of
101 case exports of
103 Can.ExportEverything _ ->
102 Can.ExportEverything _ ->
104 Map.map OpenUnion unions
103 Map.map OpenUnion unions
@@ -107,16 +106,16 @@ privatizeUnions exports unions =
107 Map.merge onLeft onRight onBoth explicitExports unions
106 Map.merge onLeft onRight onBoth explicitExports unions
108 where
107 where
109 onLeft = Map.dropMissing
108 onLeft = Map.dropMissing
110− onRight = Map.mapMissing (\_ u -> PrivateUnion u)
109+ onRight = Map.mapMissing (\_ union -> PrivateUnion union)
111− onBoth = Map.zipWithMatched $ \_ e u ->
110+ onBoth = Map.zipWithMatched $ \_ (A.At _ export) union ->
112− case A.toValue e of
111+ case export of
113− Can.ExportUnionOpen -> OpenUnion u
112+ Can.ExportUnionOpen -> OpenUnion union
114− Can.ExportUnionClosed -> ClosedUnion u
113+ Can.ExportUnionClosed -> ClosedUnion union
115− _ -> error "impossible exports discovered in privatizeUnions"
114+ _ -> error "impossible exports discovered in restrictUnions"
116
115
117
116
118−privatizeAliases :: Can.Exports -> Map.Map Name.Name Can.Alias -> Map.Map Name.Name Alias
117+restrictAliases :: Can.Exports -> Map.Map Name.Name Can.Alias -> Map.Map Name.Name Alias
119−privatizeAliases exports aliases =
118+restrictAliases exports aliases =
120 case exports of
119 case exports of
121 Can.ExportEverything _ ->
120 Can.ExportEverything _ ->
122 Map.map PublicAlias aliases
121 Map.map PublicAlias aliases
@@ -130,61 +129,74 @@ privatizeAliases exports aliases =
130
129
131
130
132
131
133−-- PUBLICIZE
132+-- TO PUBLIC
134
133
135
134
136toPublicUnion :: Union -> Maybe Can.Union
135toPublicUnion :: Union -> Maybe Can.Union
137toPublicUnion iUnion =
136toPublicUnion iUnion =
138 case iUnion of
137 case iUnion of
139− OpenUnion union ->
138+ OpenUnion union -> Just union
140− Just union
141−
142− ClosedUnion (Can.Union vars _ _ opts) ->
139+ ClosedUnion (Can.Union vars _ _ opts) -> Just (Can.Union vars [] 0 opts)
143− Just (Can.Union vars [] 0 opts)
144−
145− PrivateUnion _ ->
140+ PrivateUnion _ -> Nothing
146− Nothing
147
141
148
142
149toPublicAlias :: Alias -> Maybe Can.Alias
143toPublicAlias :: Alias -> Maybe Can.Alias
150toPublicAlias iAlias =
144toPublicAlias iAlias =
151 case iAlias of
145 case iAlias of
152− PublicAlias alias ->
146+ PublicAlias alias -> Just alias
153− Just alias
147+ PrivateAlias _ -> Nothing
148+
149+
150+
151+-- DEPENDENCY INTERFACE
152+
153+
154+data DependencyInterface
155+ = Public Interface
156+ | Private (Map.Map Name.Name Can.Union) (Map.Map Name.Name Can.Alias)
154
157
155− PrivateAlias _ ->
156− Nothing
157
158
159+public :: Interface -> DependencyInterface
160+public =
161+ Public
158
162
159
163
160−-- INTERNALS
164+private :: Interface -> DependencyInterface
165+private (Interface _ _ unions aliases _) =
166+ Private
167+ (Map.map extractUnion unions)
168+ (Map.map extractAlias aliases)
161
169
162
170
163−toUnionInternals :: Union -> Can.Union
171+extractUnion :: Union -> Can.Union
164−toUnionInternals iUnion =
172+extractUnion iUnion =
165 case iUnion of
173 case iUnion of
166 OpenUnion union -> union
174 OpenUnion union -> union
167 ClosedUnion union -> union
175 ClosedUnion union -> union
168 PrivateUnion union -> union
176 PrivateUnion union -> union
169
177
170
178
171−toAliasInternals :: Alias -> Can.Alias
179+extractAlias :: Alias -> Can.Alias
172−toAliasInternals iAlias =
180+extractAlias iAlias =
173 case iAlias of
181 case iAlias of
174 PublicAlias alias -> alias
182 PublicAlias alias -> alias
175 PrivateAlias alias -> alias
183 PrivateAlias alias -> alias
176
184
177
185
186+privatize :: DependencyInterface -> DependencyInterface
187+privatize di =
188+ case di of
189+ Public i -> private i
190+ Private _ _ -> di
191+
192+
178
193
179-- BINARY
194-- BINARY
180
195
181
196
182instance Binary Interface where
197instance Binary Interface where
183− get =
184− liftM4 Interface get get get get
198+ get = liftM5 Interface get get get get get
185−
186− put (Interface a b c d) =
199+ put (Interface a b c d e) = put a >> put b >> put c >> put d >> put e
187− put a >> put b >> put c >> put d
188
200
189
201
190instance Binary Union where
202instance Binary Union where
@@ -197,9 +209,9 @@ instance Binary Union where
197 get =
209 get =
198 do n <- getWord8
210 do n <- getWord8
199 case n of
211 case n of
200− 0 -> OpenUnion <$> get
212+ 0 -> liftM OpenUnion get
201− 1 -> ClosedUnion <$> get
213+ 1 -> liftM ClosedUnion get
202− 2 -> PrivateUnion <$> get
214+ 2 -> liftM PrivateUnion get
203 _ -> error "binary encoding of Union was corrupted"
215 _ -> error "binary encoding of Union was corrupted"
204
216
205
217
@@ -212,8 +224,8 @@ instance Binary Alias where
212 get =
224 get =
213 do n <- getWord8
225 do n <- getWord8
214 case n of
226 case n of
215− 0 -> PublicAlias <$> get
227+ 0 -> liftM PublicAlias get
216− 1 -> PrivateAlias <$> get
228+ 1 -> liftM PrivateAlias get
217 _ -> error "binary encoding of Alias was corrupted"
229 _ -> error "binary encoding of Alias was corrupted"
218
230
219
231
@@ -224,3 +236,16 @@ instance Binary Binop where
224 put (Binop a b c d) =
236 put (Binop a b c d) =
225 put a >> put b >> put c >> put d
237 put a >> put b >> put c >> put d
226
238
239+
240+instance Binary DependencyInterface where
241+ put union =
242+ case union of
243+ Public a -> putWord8 0 >> put a
244+ Private a b -> putWord8 1 >> put a >> put b
245+
246+ get =
247+ do n <- getWord8
248+ case n of
249+ 0 -> liftM Public get
250+ 1 -> liftM2 Private get get
251+ _ -> error "binary encoding of DependencyInterface was corrupted"