git.iko.soy/elk
on master help sign in
Mess with Canonical Env a bit to handle duplicate imports better

In the old one, having two imports triggered the “this is ambiguous error” so I changed it to match 0.18 behavior

commitfd172c9db89e2abad83183f4a1d60c08fa395546 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 24 Jan 2018, 20:50 (9 years ago) parent4cdb58d
4 files changed+43−52
compare with master
unifiedsplit
src/Canonicalize/Environment.hs+11−16 src/Canonicalize/Environment/Foreign.hs+14−15 src/Canonicalize/Environment/Local.hs+8−9 src/Canonicalize/Expression.hs+10−12
src/Canonicalize/Environment.hs+11−16
@@ -5,7 +5,6 @@ module Canonicalize.Environment
55 , Exposed
66 , Qualified
77 , Var(..)
8− , ForeignVar(..)
98 , Type(..)
109 , Ctor(..)
1110 , addLocals
@@ -19,14 +18,14 @@ module Canonicalize.Environment
1918 where
2019
2120
22−import qualified Data.Map.Strict as Map
2321import qualified Data.Map.Merge.Strict as Map
22+import qualified Data.Map.Strict as Map
23+import qualified Data.Map.Strict.Internal as I
2424
2525import qualified AST.Utils.Binop as Binop
2626import qualified AST.Canonical as Can
2727import qualified AST.Module.Name as ModuleName
2828import qualified Data.Index as Index
29−import qualified Data.OneOrMore as OneOrMore
3029import qualified Elm.Name as N
3130import qualified Reporting.Error.Canonicalize as Error
3231import qualified Reporting.Region as R
@@ -52,18 +51,18 @@ data Env =
5251 , _types :: Exposed Type
5352 , _ctors :: Exposed Ctor
5453 , _binops :: Exposed Binop
55− , _q_vars :: Qualified ForeignVar
54+ , _q_vars :: Qualified Can.Annotation
5655 , _q_types :: Qualified Type
5756 , _q_ctors :: Qualified Ctor
5857 }
5958
6059
6160type Exposed a =
62− Map.Map N.Name (OneOrMore.OneOrMore a)
61+ Map.Map N.Name (Map.Map ModuleName.Canonical a)
6362
6463
6564type Qualified a =
66− Map.Map N.Name (Map.Map N.Name (OneOrMore.OneOrMore a))
65+ Map.Map N.Name (Map.Map N.Name (Map.Map ModuleName.Canonical a))
6766
6867
6968
@@ -73,11 +72,7 @@ type Qualified a =
7372data Var
7473 = Local R.Region
7574 | TopLevel R.Region
76− | Foreign (OneOrMore.OneOrMore ForeignVar)
77−
78−
79−data ForeignVar =
80− ForeignVar ModuleName.Canonical Can.Annotation
75+ | Foreign (Map.Map ModuleName.Canonical Can.Annotation)
8176
8277
8378
@@ -161,7 +156,7 @@ addLocalBoth name region var =
161156findType :: R.Region -> Env -> N.Name -> Result i w Type
162157findType region (Env _ _ types _ _ _ _ _) name =
163158 case Map.lookup name types of
164− Just (OneOrMore.One tipe) ->
159+ Just (I.Bin 1 _ tipe _ _) ->
165160 Result.ok tipe
166161
167162 Just _ ->
@@ -176,7 +171,7 @@ findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =
176171 case Map.lookup prefix types of
177172 Just qualified ->
178173 case Map.lookup name qualified of
179− Just (OneOrMore.One tipe) ->
174+ Just (I.Bin 1 _ tipe _ _) ->
180175 Result.ok tipe
181176
182177 Just more ->
@@ -196,7 +191,7 @@ findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =
196191findCtor :: R.Region -> Env -> N.Name -> Result i w Ctor
197192findCtor region (Env _ _ _ ctors _ _ _ _) name =
198193 case Map.lookup name ctors of
199− Just (OneOrMore.One ctor) ->
194+ Just (I.Bin 1 _ ctor _ _) ->
200195 Result.ok ctor
201196
202197 Just _ ->
@@ -211,7 +206,7 @@ findCtorQual region (Env _ _ _ _ _ _ _ ctors) prefix name =
211206 case Map.lookup prefix ctors of
212207 Just qualified ->
213208 case Map.lookup name qualified of
214− Just (OneOrMore.One pattern) ->
209+ Just (I.Bin 1 _ pattern _ _) ->
215210 Result.ok pattern
216211
217212 Just _ ->
@@ -231,7 +226,7 @@ findCtorQual region (Env _ _ _ _ _ _ _ ctors) prefix name =
231226findBinop :: R.Region -> Env -> N.Name -> Result i w Binop
232227findBinop region (Env _ _ _ _ binops _ _ _) name =
233228 case Map.lookup name binops of
234− Just (OneOrMore.One binop) ->
229+ Just (I.Bin 1 _ binop _ _) ->
235230 Result.ok binop
236231
237232 Nothing ->
src/Canonicalize/Environment/Foreign.hs+14−15
@@ -14,7 +14,6 @@ import qualified AST.Source as Src
1414import qualified AST.Module.Name as ModuleName
1515import qualified Canonicalize.Environment as Env
1616import qualified Data.List as List
17−import qualified Data.OneOrMore as OneOrMore
1817import qualified Elm.Interface as I
1918import qualified Elm.Name as N
2019import qualified Reporting.Annotation as A
@@ -58,11 +57,11 @@ isNotKernel (Src.Import (A.At _ name) _ _) =
5857
5958data State =
6059 State
61− { _vars :: Env.Exposed Env.ForeignVar
60+ { _vars :: Env.Exposed Can.Annotation
6261 , _types :: Env.Exposed Env.Type
6362 , _ctors :: Env.Exposed Env.Ctor
6463 , _binops :: Env.Exposed Env.Binop
65− , _q_vars :: Env.Qualified Env.ForeignVar
64+ , _q_vars :: Env.Qualified Can.Annotation
6665 , _q_types :: Env.Qualified Env.Type
6766 , _q_ctors :: Env.Qualified Env.Ctor
6867 }
@@ -75,7 +74,7 @@ emptyState =
7574
7675emptyTypes :: Env.Exposed Env.Type
7776emptyTypes =
78− Map.singleton "List" (OneOrMore.one (Env.Union 1 ModuleName.list))
77+ Map.singleton "List" (Map.singleton ModuleName.list (Env.Union 1 ModuleName.list))
7978
8079
8180
@@ -90,8 +89,8 @@ addImport (State vs ts cs bs qvs qts qcs) (Import home (I.Interface defs unions
9089 (Map.mapWithKey (unionToType home) unions)
9190 (Map.mapWithKey (aliasToType home) aliases)
9291
93− !vars = Map.map (OneOrMore.one . Env.ForeignVar home) defs
94− !types = Map.map (OneOrMore.one . fst) rawTypeInfo
92+ !vars = Map.map (Map.singleton home) defs
93+ !types = Map.map (Map.singleton home . fst) rawTypeInfo
9594 !ctors = Map.foldr (addExposed . snd) Map.empty rawTypeInfo
9695
9796 !qvs2 = addQualified prefix vars qvs
@@ -117,7 +116,7 @@ addImport (State vs ts cs bs qvs qts qcs) (Import home (I.Interface defs unions
117116
118117addExposed :: Env.Exposed a -> Env.Exposed a -> Env.Exposed a
119118addExposed =
120− Map.unionWith OneOrMore.more
119+ Map.unionWith Map.union
121120
122121
123122addQualified :: N.Name -> Env.Exposed a -> Env.Qualified a -> Env.Qualified a
@@ -133,7 +132,7 @@ unionToType :: ModuleName.Canonical -> N.Name -> Can.Union -> (Env.Type, Env.Exp
133132unionToType home name union@(Can.Union vars ctors _ _) =
134133 let
135134 addCtor dict (Can.Ctor ctor index _ args) =
136− Map.insert ctor (OneOrMore.one (Env.Ctor home name union index args)) dict
135+ Map.insert ctor (Map.singleton home (Env.Ctor home name union index args)) dict
137136 in
138137 ( Env.Union (length vars) home
139138 , List.foldl' addCtor Map.empty ctors
@@ -150,13 +149,13 @@ aliasToType home name (Can.Alias vars tipe maybeRecordArgs) =
150149 Map.empty
151150
152151 Just _ ->
153− Map.singleton name (OneOrMore.one (Env.RecordCtor home vars tipe))
152+ Map.singleton name (Map.singleton home (Env.RecordCtor home vars tipe))
154153 )
155154
156155
157−binopToBinop :: ModuleName.Canonical -> N.Name -> I.Binop -> OneOrMore.OneOrMore Env.Binop
156+binopToBinop :: ModuleName.Canonical -> N.Name -> I.Binop -> Map.Map ModuleName.Canonical Env.Binop
158157binopToBinop home op (I.Binop name annotation associativity precedence) =
159− OneOrMore.one (Env.Binop op home name annotation associativity precedence)
158+ Map.singleton home (Env.Binop op home name annotation associativity precedence)
160159
161160
162161
@@ -165,7 +164,7 @@ binopToBinop home op (I.Binop name annotation associativity precedence) =
165164
166165addExposedValue
167166 :: ModuleName.Canonical
168− -> Env.Exposed Env.ForeignVar
167+ -> Env.Exposed Can.Annotation
169168 -> Map.Map N.Name (Env.Type, Env.Exposed Env.Ctor)
170169 -> Map.Map N.Name I.Binop
171170 -> State
@@ -189,13 +188,13 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg
189188 case tipe of
190189 Env.Union _ _ ->
191190 let
192− !ts2 = Map.insert name (OneOrMore.one tipe) ts
191+ !ts2 = Map.insert name (Map.singleton home tipe) ts
193192 in
194193 Result.ok (State vs ts2 cs bs qvs qts qcs)
195194
196195 Env.Alias _ _ _ _ ->
197196 let
198− !ts2 = Map.insert name (OneOrMore.one tipe) ts
197+ !ts2 = Map.insert name (Map.singleton home tipe) ts
199198 !cs2 = addExposed cs ctors
200199 in
201200 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
@@ -209,7 +208,7 @@ addExposedValue home vars types binops (State vs ts cs bs qvs qts qcs) (A.At reg
209208 case tipe of
210209 Env.Union _ _ ->
211210 let
212− !ts2 = Map.insert name (OneOrMore.one tipe) ts
211+ !ts2 = Map.insert name (Map.singleton home tipe) ts
213212 !cs2 = addExposed cs ctors
214213 in
215214 Result.ok (State vs ts2 cs2 bs qvs qts qcs)
src/Canonicalize/Environment/Local.hs+8−9
@@ -19,7 +19,6 @@ import qualified Canonicalize.Environment as Env
1919import qualified Canonicalize.Environment.Dups as Dups
2020import qualified Canonicalize.Type as Type
2121import qualified Data.Index as Index
22−import qualified Data.OneOrMore as OneOrMore
2322import qualified Elm.Name as N
2423import qualified Reporting.Annotation as A
2524import qualified Reporting.Error.Canonicalize as Error
@@ -113,8 +112,8 @@ addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) (Env.Env home vs ts cs bs
113112addUnion :: ModuleName.Canonical -> Env.Exposed Env.Type -> Valid.Union -> Result i w (Env.Exposed Env.Type)
114113addUnion home types union@(Valid.Union (A.At _ name) _ _) =
115114 do arity <- checkUnionFreeVars union
116− let one = OneOrMore.one (Env.Union arity home)
117− Result.ok $ Map.insertWith OneOrMore.more name one types
115+ let one = Map.singleton home (Env.Union arity home)
116+ Result.ok $ Map.insertWith Map.union name one types
118117
119118
120119
@@ -136,8 +135,8 @@ addAlias env@(Env.Env home vs ts cs bs qvs qts qcs) scc =
136135 Graph.AcyclicSCC alias@(Valid.Alias (A.At _ name) _ tipe) ->
137136 do args <- checkAliasFreeVars alias
138137 ctype <- Type.canonicalize env tipe
139− let one = OneOrMore.one (Env.Alias (length args) home args ctype)
140− let ts1 = Map.insertWith OneOrMore.more name one ts
138+ let one = Map.singleton home (Env.Alias (length args) home args ctype)
139+ let ts1 = Map.insertWith Map.union name one ts
141140 Result.ok $ Env.Env home vs ts1 cs bs qvs qts qcs
142141
143142 Graph.CyclicSCC [] ->
@@ -274,7 +273,7 @@ addCtors (Valid.Module _ _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts c
274273 (Dups.unions (map snd unionInfo))
275274 (Dups.unions (map snd aliasInfo))
276275
277− let cs2 = Map.unionWith OneOrMore.more cs ctors
276+ let cs2 = Map.unionWith Map.union cs ctors
278277
279278 Result.ok
280279 ( Env.Env home vs ts cs2 bs qvs qts qcs
@@ -283,7 +282,7 @@ addCtors (Valid.Module _ _ _ _ _ _ unions aliases _ _) env@(Env.Env home vs ts c
283282 )
284283
285284
286−type CtorDups = Dups.Dict (OneOrMore.OneOrMore Env.Ctor)
285+type CtorDups = Dups.Dict (Map.Map ModuleName.Canonical Env.Ctor)
287286
288287
289288
@@ -305,7 +304,7 @@ canonicalizeAlias env@(Env.Env home _ _ _ _ _ _ _) (Valid.Alias (A.At region nam
305304
306305 Result.ok
307306 ( (name, alias)
308− , Dups.one name region (OneOrMore.one ctor)
307+ , Dups.one name region (Map.singleton home ctor)
309308 )
310309
311310 _ ->
@@ -351,5 +350,5 @@ toOpts ctors =
351350
352351toCtor :: ModuleName.Canonical -> N.Name -> Can.Union -> A.Located Can.Ctor -> CtorDups
353352toCtor home typeName union (A.At region (Can.Ctor name index _ args)) =
354− Dups.one name region $ OneOrMore.one $
353+ Dups.one name region $ Map.singleton home $
355354 Env.Ctor home typeName union index args
src/Canonicalize/Expression.hs+10−12
@@ -14,6 +14,7 @@ import Control.Monad (foldM)
1414import qualified Data.Graph as Graph
1515import qualified Data.List as List
1616import qualified Data.Map.Strict as Map
17+import qualified Data.Map.Strict.Internal as I
1718import qualified Data.Text as Text
1819
1920import qualified AST.Canonical as Can
@@ -27,7 +28,6 @@ import qualified Canonicalize.Environment.Dups as Dups
2728import qualified Canonicalize.Pattern as Pattern
2829import qualified Canonicalize.Type as Type
2930import qualified Data.Index as Index
30−import qualified Data.OneOrMore as OneOrMore
3131import qualified Elm.Name as N
3232import qualified Reporting.Annotation as A
3333import qualified Reporting.Error.Canonicalize as Error
@@ -695,17 +695,15 @@ findVar region (Env.Env localHome vars _ _ _ _ _ _) name =
695695 Env.TopLevel _ ->
696696 logVar name (Can.VarTopLevel localHome name)
697697
698− Env.Foreign bag ->
699− case bag of
700− OneOrMore.One (Env.ForeignVar home annotation) ->
701− Result.ok $
702− if home == ModuleName.debug then
703− Can.VarDebug localHome name annotation
704− else
705− Can.VarForeign home name annotation
698+ Env.Foreign (I.Bin 1 home annotation _ _) ->
699+ Result.ok $
700+ if home == ModuleName.debug then
701+ Can.VarDebug localHome name annotation
702+ else
703+ Can.VarForeign home name annotation
706704
707− OneOrMore.More _ _ ->
708− Result.throw (error ("TODO ambiguous unqualified " ++ N.toString name) region)
705+ Env.Foreign _ ->
706+ Result.throw (error ("TODO ambiguous unqualified " ++ N.toString name) region)
709707
710708 Nothing ->
711709 Result.throw (error ("TODO no name " ++ N.toString name) region)
@@ -716,7 +714,7 @@ findVarQual region (Env.Env localHome _ _ _ _ vars _ _) prefix name =
716714 case Map.lookup prefix vars of
717715 Just qualified ->
718716 case Map.lookup name qualified of
719− Just (OneOrMore.One (Env.ForeignVar home annotation)) ->
717+ Just (I.Bin 1 home annotation _ _) ->
720718 Result.ok $
721719 if home == ModuleName.debug then
722720 Can.VarDebug localHome name annotation