git.iko.soy/elk
on master help sign in
switch to smaller/safer representation for canonical env
56e3d05Evan Czaplicki
compiler/src/Canonicalize/Environment.hs+50−20
compare with master
unifiedsplit
@@ -4,6 +4,8 @@ module Canonicalize.Environment
4 ( Env(..)
4 ( Env(..)
5 , Exposed
5 , Exposed
6 , Qualified
6 , Qualified
7+ , Info(..)
8+ , mergeInfo
7 , Var(..)
9 , Var(..)
8 , Type(..)
10 , Type(..)
9 , Ctor(..)
11 , Ctor(..)
@@ -20,8 +22,8 @@ module Canonicalize.Environment
20
22
21import qualified Data.Map.Merge.Strict as Map
23import qualified Data.Map.Merge.Strict as Map
22import qualified Data.Map.Strict as Map
24import qualified Data.Map.Strict as Map
23−import qualified Data.Map.Strict.Internal as I
24import qualified Data.Name as Name
25import qualified Data.Name as Name
26+import qualified Data.OneOrMore as OneOrMore
25
27
26import qualified AST.Utils.Binop as Binop
28import qualified AST.Utils.Binop as Binop
27import qualified AST.Canonical as Can
29import qualified AST.Canonical as Can
@@ -58,11 +60,34 @@ data Env =
58
60
59
61
60type Exposed a =
62type Exposed a =
61− Map.Map Name.Name (Map.Map ModuleName.Canonical a)
63+ Map.Map Name.Name (Info a)
62
64
63
65
64type Qualified a =
66type Qualified a =
65− Map.Map Name.Name (Map.Map Name.Name (Map.Map ModuleName.Canonical a))
67+ Map.Map Name.Name (Map.Map Name.Name (Info a))
68+
69+
70+
71+-- INFO
72+
73+
74+data Info a
75+ = Specific ModuleName.Canonical a
76+ | Ambiguous ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
77+
78+
79+mergeInfo :: Info a -> Info a -> Info a
80+mergeInfo info1 info2 =
81+ case info1 of
82+ Specific h1 _ ->
83+ case info2 of
84+ Specific h2 _ -> Ambiguous h1 (OneOrMore.one h2)
85+ Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more (OneOrMore.one h2) hs2)
86+
87+ Ambiguous h1 hs1 ->
88+ case info2 of
89+ Specific h2 _ -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.one h2))
90+ Ambiguous h2 hs2 -> Ambiguous h1 (OneOrMore.more hs1 (OneOrMore.more (OneOrMore.one h2) hs2))
66
91
67
92
68
93
@@ -72,7 +97,8 @@ type Qualified a =
72data Var
97data Var
73 = Local A.Region
98 = Local A.Region
74 | TopLevel A.Region
99 | TopLevel A.Region
75− | Foreign (Map.Map ModuleName.Canonical Can.Annotation)
100+ | Foreign ModuleName.Canonical Can.Annotation
101+ | Foreigns ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
76
102
77
103
78
104
@@ -139,7 +165,10 @@ addLocalLeft _ region =
139addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
165addLocalBoth :: Name.Name -> A.Region -> Var -> Result i w Var
140addLocalBoth name region var =
166addLocalBoth name region var =
141 case var of
167 case var of
142− Foreign _ ->
168+ Foreign _ _ ->
169+ Result.ok (Local region)
170+
171+ Foreigns _ _ ->
143 Result.ok (Local region)
172 Result.ok (Local region)
144
173
145 Local parentRegion ->
174 Local parentRegion ->
@@ -150,17 +179,18 @@ addLocalBoth name region var =
150
179
151
180
152
181
182+
153-- FIND TYPE
183-- FIND TYPE
154
184
155
185
156findType :: A.Region -> Env -> Name.Name -> Result i w Type
186findType :: A.Region -> Env -> Name.Name -> Result i w Type
157findType region (Env _ _ ts _ _ _ qts _) name =
187findType region (Env _ _ ts _ _ _ qts _) name =
158 case Map.lookup name ts of
188 case Map.lookup name ts of
159− Just (I.Bin 1 _ tipe _ _) ->
189+ Just (Specific _ tipe) ->
160 Result.ok tipe
190 Result.ok tipe
161
191
162− Just homes ->
192+ Just (Ambiguous h hs) ->
163− Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))
193+ Result.throw (Error.AmbiguousType region Nothing name h hs)
164
194
165 Nothing ->
195 Nothing ->
166 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
196 Result.throw (Error.NotFoundType region Nothing name (toPossibleNames ts qts))
@@ -171,11 +201,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
171 case Map.lookup prefix qts of
201 case Map.lookup prefix qts of
172 Just qualified ->
202 Just qualified ->
173 case Map.lookup name qualified of
203 case Map.lookup name qualified of
174− Just (I.Bin 1 _ tipe _ _) ->
204+ Just (Specific _ tipe) ->
175 Result.ok tipe
205 Result.ok tipe
176
206
177− Just homes ->
207+ Just (Ambiguous h hs) ->
178− Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))
208+ Result.throw (Error.AmbiguousType region (Just prefix) name h hs)
179
209
180 Nothing ->
210 Nothing ->
181 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
211 Result.throw (Error.NotFoundType region (Just prefix) name (toPossibleNames ts qts))
@@ -191,11 +221,11 @@ findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
191findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
221findCtor :: A.Region -> Env -> Name.Name -> Result i w Ctor
192findCtor region (Env _ _ _ cs _ _ _ qcs) name =
222findCtor region (Env _ _ _ cs _ _ _ qcs) name =
193 case Map.lookup name cs of
223 case Map.lookup name cs of
194− Just (I.Bin 1 _ ctor _ _) ->
224+ Just (Specific _ ctor) ->
195 Result.ok ctor
225 Result.ok ctor
196
226
197− Just homes ->
227+ Just (Ambiguous h hs) ->
198− Result.throw (Error.AmbiguousVariant region Nothing name (Map.keys homes))
228+ Result.throw (Error.AmbiguousVariant region Nothing name h hs)
199
229
200 Nothing ->
230 Nothing ->
201 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
231 Result.throw (Error.NotFoundVariant region Nothing name (toPossibleNames cs qcs))
@@ -206,11 +236,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
206 case Map.lookup prefix qcs of
236 case Map.lookup prefix qcs of
207 Just qualified ->
237 Just qualified ->
208 case Map.lookup name qualified of
238 case Map.lookup name qualified of
209− Just (I.Bin 1 _ pattern _ _) ->
239+ Just (Specific _ pattern) ->
210 Result.ok pattern
240 Result.ok pattern
211
241
212− Just homes ->
242+ Just (Ambiguous h hs) ->
213− Result.throw (Error.AmbiguousVariant region (Just prefix) name (Map.keys homes))
243+ Result.throw (Error.AmbiguousVariant region (Just prefix) name h hs)
214
244
215 Nothing ->
245 Nothing ->
216 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
246 Result.throw (Error.NotFoundVariant region (Just prefix) name (toPossibleNames cs qcs))
@@ -226,11 +256,11 @@ findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
226findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
256findBinop :: A.Region -> Env -> Name.Name -> Result i w Binop
227findBinop region (Env _ _ _ _ binops _ _ _) name =
257findBinop region (Env _ _ _ _ binops _ _ _) name =
228 case Map.lookup name binops of
258 case Map.lookup name binops of
229− Just (I.Bin 1 _ binop _ _) ->
259+ Just (Specific _ binop) ->
230 Result.ok binop
260 Result.ok binop
231
261
232− Just homes ->
262+ Just (Ambiguous h hs) ->
233− Result.throw (Error.AmbiguousBinop region name (Map.keys homes))
263+ Result.throw (Error.AmbiguousBinop region name h hs)
234
264
235 Nothing ->
265 Nothing ->
236 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))
266 Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))
compiler/src/Canonicalize/Environment/Foreign.hs+42−30
@@ -35,7 +35,14 @@ type Result i w a =
35createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
35createInitialEnv :: ModuleName.Canonical -> Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Result i w Env.Env
36createInitialEnv home ifaces imports =
36createInitialEnv home ifaces imports =
37 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)
37 do (State vs ts cs bs qvs qts qcs) <- foldM (addImport ifaces) emptyState (toSafeImports home imports)
38− Result.ok (Env.Env home (Map.map Env.Foreign vs) ts cs bs qvs qts qcs)
38+ Result.ok (Env.Env home (Map.map infoToVar vs) ts cs bs qvs qts qcs)
39+
40+
41+infoToVar :: Env.Info Can.Annotation -> Env.Var
42+infoToVar info =
43+ case info of
44+ Env.Specific home tipe -> Env.Foreign home tipe
45+ Env.Ambiguous h hs -> Env.Foreigns h hs
39
46
40
47
41
48
@@ -61,7 +68,7 @@ emptyState =
61
68
62emptyTypes :: Env.Exposed Env.Type
69emptyTypes :: Env.Exposed Env.Type
63emptyTypes =
70emptyTypes =
64− Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))
71+ Map.singleton "List" (Env.Specific ModuleName.list (Env.Union 1 ModuleName.list))
65
72
66
73
67
74
@@ -102,8 +109,8 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
102 (Map.mapMaybeWithKey (unionToType home) unions)
109 (Map.mapMaybeWithKey (unionToType home) unions)
103 (Map.mapMaybeWithKey (aliasToType home) aliases)
110 (Map.mapMaybeWithKey (aliasToType home) aliases)
104
111
105− !vars = Map.map (Map.singleton home) defs
112+ !vars = Map.map (Env.Specific home) defs
106− !types = Map.map (Map.singleton home . fst) rawTypeInfo
113+ !types = Map.map (Env.Specific home . fst) rawTypeInfo
107 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
114 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
108
115
109 !qvs2 = addQualified prefix vars qvs
116 !qvs2 = addQualified prefix vars qvs
@@ -129,7 +136,7 @@ addImport ifaces (State vs ts cs bs qvs qts qcs) (Src.Import (A.At _ name) maybe
129
136
130addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
137addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
131addExposed =
138addExposed =
132− Map.unionWith Map.union
139+ Map.unionWith Env.mergeInfo
133
140
134
141
135addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
142addQualified :: Name.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
@@ -150,7 +157,7 @@ unionToTypeHelp :: ModuleName.Canonical -> Name.Name -> Can.Union -> (Env.Type,
150unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
157unionToTypeHelp home name union@(Can.Union vars ctors _ _) =
151 let
158 let
152 addCtor dict (Can.Ctor ctor index _ args) =
159 addCtor dict (Can.Ctor ctor index _ args) =
153− Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict
160+ Map.insert ctor (Env.Specific home (Env.Ctor home name union index args)) dict
154 in
161 in
155 ( Env.Union (length vars) home
162 ( Env.Union (length vars) home
156 , List.foldl' addCtor Map.empty ctors
163 , List.foldl' addCtor Map.empty ctors
@@ -181,7 +188,7 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
181 (Can.TAlias home name avars (Can.Filled tipe))
188 (Can.TAlias home name avars (Can.Filled tipe))
182 (Can.fieldsToList fields)
189 (Can.fieldsToList fields)
183 in
190 in
184− Map.singleton name (Map.singleton home (Env.RecordCtor home vars alias))
191+ Map.singleton name (Env.Specific home (Env.RecordCtor home vars alias))
185
192
186 _ ->
193 _ ->
187 Map.empty
194 Map.empty
@@ -192,9 +199,9 @@ aliasToTypeHelp home name (Can.Alias vars tipe) =
192-- BINOP
199-- BINOP
193
200
194
201
195−binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop
202+binopToBinop :: ModuleName.Canonical -> Name.Name -> I.Binop -> Env.Info Env.Binop
196binopToBinop home op (I.Binop name annotation associativity precedence) =
203binopToBinop home op (I.Binop name annotation associativity precedence) =
197− Map.singleton home (Env.Binop op home name annotation associativity precedence)
204+ Env.Specific home (Env.Binop op home name annotation associativity precedence)
198
205
199
206
200
207
@@ -214,7 +221,7 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
214 Src.Lower (A.At region name) ->
221 Src.Lower (A.At region name) ->
215 case Map.lookup name vars of
222 case Map.lookup name vars of
216 Just info ->
223 Just info ->
217− Result.ok (State (Map.insertWith Map.union name info vs) ts cs bs qvs qts qcs)
224+ Result.ok (State (Map.insertWith Env.mergeInfo name info vs) ts cs bs qvs qts qcs)
218
225
219 Nothing ->
226 Nothing ->
220 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
227 Result.throw (Error.ImportExposingNotFound region home name (Map.keys vars))
@@ -227,23 +234,23 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
227 case tipe of
234 case tipe of
228 Env.Union _ _ ->
235 Env.Union _ _ ->
229 let
236 let
230− !ts2 = Map.insert name (Map.singleton home tipe) ts
237+ !ts2 = Map.insert name (Env.Specific home tipe) ts
231 in
238 in
232 Result.ok (State vs ts2 cs bs qvs qts qcs)
239 Result.ok (State vs ts2 cs bs qvs qts qcs)
233
240
234 Env.Alias _ _ _ _ ->
241 Env.Alias _ _ _ _ ->
235 let
242 let
236− !ts2 = Map.insert name (Map.singleton home tipe) ts
243+ !ts2 = Map.insert name (Env.Specific home tipe) ts
237 !cs2 = addExposed cs ctors
244 !cs2 = addExposed cs ctors
238 in
245 in
239 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
246 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
240
247
241 Nothing ->
248 Nothing ->
242− case Map.lookup name (toCtors types) of
249+ case checkForCtorMistake name types of
243− Just tipe ->
250+ tipe:_ ->
244 Result.throw $ Error.ImportCtorByName region name tipe
251 Result.throw $ Error.ImportCtorByName region name tipe
245
252
246− Nothing ->
253+ [] ->
247 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
254 Result.throw $ Error.ImportExposingNotFound region home name (Map.keys types)
248
255
249 Src.Public dotDotRegion ->
256 Src.Public dotDotRegion ->
@@ -252,7 +259,7 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
252 case tipe of
259 case tipe of
253 Env.Union _ _ ->
260 Env.Union _ _ ->
254 let
261 let
255− !ts2 = Map.insert name (Map.singleton home tipe) ts
262+ !ts2 = Map.insert name (Env.Specific home tipe) ts
256 !cs2 = addExposed cs ctors
263 !cs2 = addExposed cs ctors
257 in
264 in
258 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
265 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
@@ -275,18 +282,23 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) exposed =
275 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
282 Result.throw (Error.ImportExposingNotFound region home op (Map.keys binops))
276
283
277
284
278−
279−toCtors :: Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> Map.Map Name.Name Name.Name
285+checkForCtorMistake :: Name.Name -> Map.Map Name.Name (Env.Type, Env.Exposed Env.Ctor) -> [Name.Name]
280−toCtors types =
286+checkForCtorMistake givenName types =
281− Map.foldr addCtors Map.empty types
287+ Map.foldr addMatches [] types
282 where
288 where
283− addCtors (_, exposedCtors) dict =
289+ addMatches (_, exposedCtors) matches =
284− Map.foldrWithKey addCtor dict exposedCtors
290+ Map.foldrWithKey addMatch matches exposedCtors
285−
291+
286− addCtor ctorName homes dict =
292+ addMatch ctorName info matches =
293+ if ctorName /= givenName
294+ then matches
295+ else
287− case Map.elems homes of
296+ case info of
288− [Env.Ctor _ tipeName _ _ _] ->
297+ Env.Specific _ (Env.Ctor _ tipeName _ _ _) ->
289− Map.insert ctorName tipeName dict
298+ tipeName : matches
290−
299+
291− _ ->
300+ Env.Specific _ (Env.RecordCtor _ _ _) ->
292− dict
301+ matches
302+
303+ Env.Ambiguous _ _ ->
304+ matches
compiler/src/Canonicalize/Environment/Local.hs+5−5
@@ -110,7 +110,7 @@ addTypes (Src.Module _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs qvs
110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)
110addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> A.Located Src.Union -> Result i w (Env.Exposed Env.Type)
111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =
111addUnion home types union@(A.At _ (Src.Union (A.At _ name) _ _)) =
112 do arity <- checkUnionFreeVars union
112 do arity <- checkUnionFreeVars union
113− let one = Map.singleton home (Env.Union arity home)
113+ let one = Env.Specific home (Env.Union arity home)
114 Result.ok $ Map.insert name one types
114 Result.ok $ Map.insert name one types
115
115
116
116
@@ -133,7 +133,7 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =
133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->
133 Graph.AcyclicSCC alias@(A.At _ (Src.Alias (A.At _ name) _ tipe)) ->
134 do args <- checkAliasFreeVars alias
134 do args <- checkAliasFreeVars alias
135 ctype <- Type.canonicalize env tipe
135 ctype <- Type.canonicalize env tipe
136− let one = Map.singleton home (Env.Alias (length args) home args ctype)
136+ let one = Env.Specific home (Env.Alias (length args) home args ctype)
137 let ts1 = Map.insert name one ts
137 let ts1 = Map.insert name one ts
138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
138 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
139
139
@@ -281,7 +281,7 @@ addCtors (Src.Module _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts cs bs
281 )
281 )
282
282
283
283
284−type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)
284+type CtorDups = Dups.Dict (Env.Info Env.Ctor)
285
285
286
286
287
287
@@ -297,7 +297,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (A.At _ (Src.Alias (A.At regi
297 ,
297 ,
298 case ctipe of
298 case ctipe of
299 Can.TRecord fields Nothing ->
299 Can.TRecord fields Nothing ->
300− Dups.one name region (Map.singleton home (toRecordCtor home name vars fields))
300+ Dups.one name region (Env.Specific home (toRecordCtor home name vars fields))
301
301
302 _ ->
302 _ ->
303 Dups.none
303 Dups.none
@@ -351,5 +351,5 @@ toOpts ctors =
351
351
352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
352toCtor :: ModuleName.Canonical -> Name.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
353toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
354− Dups.one name region $ Map.singleton home $
354+ Dups.one name region $ Env.Specific home $
355 Env.Ctor home typeName union index args
355 Env.Ctor home typeName union index args
compiler/src/Canonicalize/Expression.hs+6−7
@@ -14,7 +14,6 @@ import Control.Monad (foldM)
14import qualified Data.Graph as Graph
14import qualified Data.Graph as Graph
15import qualified Data.List as List
15import qualified Data.List as List
16import qualified Data.Map.Strict as Map
16import qualified Data.Map.Strict as Map
17−import qualified Data.Map.Strict.Internal as I
18import qualified Data.Name as Name
17import qualified Data.Name as Name
19
18
20import qualified AST.Canonical as Can
19import qualified AST.Canonical as Can
@@ -696,15 +695,15 @@ findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =
696 Env.TopLevel _ ->
695 Env.TopLevel _ ->
697 logVar name (Can.VarTopLevel localHome name)
696 logVar name (Can.VarTopLevel localHome name)
698
697
699− Env.Foreign (I.Bin 1 home annotation _ _) ->
698+ Env.Foreign home annotation ->
700 Result.ok $
699 Result.ok $
701 if home == ModuleName.debug then
700 if home == ModuleName.debug then
702 Can.VarDebug localHome name annotation
701 Can.VarDebug localHome name annotation
703 else
702 else
704 Can.VarForeign home name annotation
703 Can.VarForeign home name annotation
705
704
706− Env.Foreign homes ->
705+ Env.Foreigns h hs ->
707− Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))
706+ Result.throw (Error.AmbiguousVar region Nothing name h hs)
708
707
709 Nothing ->
708 Nothing ->
710 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
709 Result.throw (Error.NotFoundVar region Nothing name (toPossibleNames vs qvs))
@@ -715,15 +714,15 @@ findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =
715 case Map.lookup prefix qvs of
714 case Map.lookup prefix qvs of
716 Just qualified ->
715 Just qualified ->
717 case Map.lookup name qualified of
716 case Map.lookup name qualified of
718− Just (I.Bin 1 home annotation _ _) ->
717+ Just (Env.Specific home annotation) ->
719 Result.ok $
718 Result.ok $
720 if home == ModuleName.debug then
719 if home == ModuleName.debug then
721 Can.VarDebug localHome name annotation
720 Can.VarDebug localHome name annotation
722 else
721 else
723 Can.VarForeign home name annotation
722 Can.VarForeign home name annotation
724
723
725− Just homes ->
724+ Just (Env.Ambiguous h hs) ->
726− Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))
725+ Result.throw (Error.AmbiguousVar region (Just prefix) name h hs)
727
726
728 Nothing ->
727 Nothing ->
729 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))
728 Result.throw (Error.NotFoundVar region (Just prefix) name (toPossibleNames vs qvs))
compiler/src/Reporting/Error/Canonicalize.hs+19−14
@@ -14,8 +14,10 @@ module Reporting.Error.Canonicalize
14
14
15
15
16import qualified Data.Char as Char
16import qualified Data.Char as Char
17+import qualified Data.List as List
17import qualified Data.Map as Map
18import qualified Data.Map as Map
18import qualified Data.Name as Name
19import qualified Data.Name as Name
20+import qualified Data.OneOrMore as OneOrMore
19import qualified Data.Set as Set
21import qualified Data.Set as Set
20
22
21import qualified AST.Canonical as Can
23import qualified AST.Canonical as Can
@@ -37,10 +39,10 @@ import qualified Reporting.Suggest as Suggest
37
39
38data Error
40data Error
39 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
41 = AnnotationTooShort A.Region Name.Name Index.ZeroBased Int
40− | AmbiguousVar A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
42+ | AmbiguousVar A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
41− | AmbiguousType A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
43+ | AmbiguousType A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
42− | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name [ModuleName.Canonical]
44+ | AmbiguousVariant A.Region (Maybe Name.Name) Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
43− | AmbiguousBinop A.Region Name.Name [ModuleName.Canonical]
45+ | AmbiguousBinop A.Region Name.Name ModuleName.Canonical (OneOrMore.OneOrMore ModuleName.Canonical)
44 | BadArity A.Region BadArityContext Name.Name Int Int
46 | BadArity A.Region BadArityContext Name.Name Int Int
45 | Binop A.Region Name.Name Name.Name
47 | Binop A.Region Name.Name Name.Name
46 | DuplicateDecl Name.Name A.Region A.Region
48 | DuplicateDecl Name.Name A.Region A.Region
@@ -164,17 +166,17 @@ toReport source err =
164 <> " be deleted? Maybe some parentheses are missing?"
166 <> " be deleted? Maybe some parentheses are missing?"
165 )
167 )
166
168
167− AmbiguousVar region maybePrefix name possibleHomes ->
169+ AmbiguousVar region maybePrefix name h hs ->
168− ambiguousName source region maybePrefix name possibleHomes "variable"
170+ ambiguousName source region maybePrefix name h hs "variable"
169
171
170− AmbiguousType region maybePrefix name possibleHomes ->
172+ AmbiguousType region maybePrefix name h hs ->
171− ambiguousName source region maybePrefix name possibleHomes "type"
173+ ambiguousName source region maybePrefix name h hs "type"
172
174
173− AmbiguousVariant region maybePrefix name possibleHomes ->
175+ AmbiguousVariant region maybePrefix name h hs ->
174− ambiguousName source region maybePrefix name possibleHomes "variant"
176+ ambiguousName source region maybePrefix name h hs "variant"
175
177
176− AmbiguousBinop region name possibleHomes ->
178+ AmbiguousBinop region name h hs ->
177− ambiguousName source region Nothing name possibleHomes "operator"
179+ ambiguousName source region Nothing name h hs "operator"
178
180
179 BadArity region badArityContext name expected actual ->
181 BadArity region badArityContext name expected actual ->
180 let
182 let
@@ -974,8 +976,11 @@ nameClash source r1 r2 messageThatEndsWithPunctuation =
974-- AMBIGUOUS NAME
976-- AMBIGUOUS NAME
975
977
976
978
977−ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> [ModuleName.Canonical] -> String -> Report.Report
979+ambiguousName :: Code.Source -> A.Region -> Maybe Name.Name -> Name.Name -> ModuleName.Canonical -> OneOrMore.OneOrMore ModuleName.Canonical -> String -> Report.Report
978−ambiguousName source region maybePrefix name possibleHomes thing =
980+ambiguousName source region maybePrefix name h hs thing =
981+ let
982+ possibleHomes = List.sort (h : OneOrMore.destruct (:) hs)
983+ in
979 Report.Report "AMBIGUOUS NAME" region [] $
984 Report.Report "AMBIGUOUS NAME" region [] $
980 Code.toSnippet source region Nothing $
985 Code.toSnippet source region Nothing $
981 case maybePrefix of
986 case maybePrefix of