on master help sign in
Merge pull request #1156 from elm-lang/dev
8428174Evan Czaplicki
src/Canonicalize/Setup.hs+3−3
@@ -151,11 +151,11 @@ valueToPatches region moduleName interface value =
151 |> Result.err
151 |> Result.err
152 in
152 in
153 case value of
153 case value of
154− Var.Value x
154+ Var.Value x ->
155− | Map.notMember x (Module.iTypes interface) ->
155+ if Map.notMember x (Module.iTypes interface) then
156 notFound Var.getValues x
156 notFound Var.getValues x
157
157
158− | otherwise ->
158+ else
159 Result.ok [patch Env.Value x]
159 Result.ok [patch Env.Value x]
160
160
161 Var.Alias x ->
161 Var.Alias x ->
src/Reporting/Error/Syntax.hs+44−10
@@ -23,8 +23,10 @@ data Error
23 | DuplicateValueDeclaration String
23 | DuplicateValueDeclaration String
24 | DuplicateTypeDeclaration String
24 | DuplicateTypeDeclaration String
25 | DuplicateDefinition String
25 | DuplicateDefinition String
26− | UnboundTypeVarsInAlias String [String] String [String]
27− | UnboundTypeVarsInUnion String [String] String [String]
26+ | UnboundTypeVarsInUnion String [String] [String]
27+ | UnboundTypeVarsInAlias String [String] [String]
28+ | UnusedTypeVarsInAlias String [String] [String]
29+ | MessyTypeVarsInAlias String [String] [String] [String]
28
30
29
31
30-- TO REPORT
32-- TO REPORT
@@ -148,27 +150,59 @@ toReport _localizer err =
148 ++ "`, and give each of them a unique name."
150 ++ "`, and give each of them a unique name."
149 )
151 )
150
152
151− UnboundTypeVarsInAlias typeName givenVars tvar tvars ->
153+ UnboundTypeVarsInUnion typeName givenVars unbound ->
152− unboundTypeVars "type alias" typeName givenVars tvar tvars
154+ unboundTypeVars "type" typeName givenVars unbound
153
155
154− UnboundTypeVarsInUnion typeName givenVars tvar tvars ->
156+ UnboundTypeVarsInAlias typeName givenVars unbound ->
155− unboundTypeVars "type" typeName givenVars tvar tvars
157+ unboundTypeVars "type alias" typeName givenVars unbound
156
158
159+ UnusedTypeVarsInAlias typeName givenVars unused ->
160+ Report.report
161+ "UNUSED TYPE VARIABLES"
162+ Nothing
163+ ( "Type alias `" ++ typeName ++ "` cannot have unused type variables: "
164+ ++ Help.commaSep unused
165+ )
166+ ( Help.stack
167+ [ text "You probably need to change the declaration like this:"
168+ , dullyellow $ hsep $
169+ map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ ["=", "…"])
170+ ]
171+ )
172+
173+ MessyTypeVarsInAlias typeName givenVars unused unbound ->
174+ Report.report
175+ "TYPE VARIABLE PROBLEMS"
176+ Nothing
177+ ( "Type alias `" ++ typeName ++ "` has some problems with type variables."
178+ )
179+ ( Help.stack
180+ [ Help.reflowParagraph $
181+ "The declaration says it uses certain type variables ("
182+ ++ Help.commaSep unused ++ ") but they do not appear in the aliased type. "
183+ ++ "Furthermore, the aliased type says it uses type variables ("
184+ ++ Help.commaSep unbound
185+ ++ ") that do not appear in the declaration."
186+ , text "You probably need to change the declaration like this:"
187+ , dullyellow $ hsep $
188+ map text ("type" : "alias" : typeName : filter (`notElem` unused) givenVars ++ unbound ++ ["=", "…"])
189+ ]
190+ )
157
191
158
192
159−unboundTypeVars :: String -> String -> [String] -> String -> [String] -> Report.Report
193+unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
160−unboundTypeVars declKind typeName givenVars tvar tvars =
194+unboundTypeVars declKind typeName givenVars unboundVars@(tvar:_) =
161 Report.report
195 Report.report
162 "UNBOUND TYPE VARIABLES"
196 "UNBOUND TYPE VARIABLES"
163 Nothing
197 Nothing
164 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
198 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
165− ++ Help.commaSep (tvar:tvars)
199+ ++ Help.commaSep unboundVars
166 )
200 )
167 ( Help.stack
201 ( Help.stack
168 [ text "You probably need to change the declaration like this:"
202 [ text "You probably need to change the declaration like this:"
169 , hsep $
203 , hsep $
170 map text (declKind : typeName : givenVars)
204 map text (declKind : typeName : givenVars)
171− ++ map (dullyellow . text) (tvar : tvars)
205+ ++ map (dullyellow . text) unboundVars
172 ++ map text ["=", "…"]
206 ++ map text ["=", "…"]
173 , Help.reflowParagraph $
207 , Help.reflowParagraph $
174 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ tvar ++ "` is an Int and\
208 "Here's why. Imagine one `" ++ typeName ++ "` where `" ++ tvar ++ "` is an Int and\
src/Validate.hs+33−27
@@ -392,48 +392,54 @@ checkDecl isRoot (A.A (region,_) decl) =
392 return ()
392 return ()
393
393
394 D.Datatype name boundVars ctors ->
394 D.Datatype name boundVars ctors ->
395− let frees = concatMap freeVars (concatMap snd ctors)
395+ case diff boundVars (concatMap freeVars (concatMap snd ctors)) of
396− in
397− case findUnbound boundVars frees of
398− [] ->
396+ (_, []) ->
399 return ()
397 return ()
400
398
401− unbound ->
399+ (_, unbound) ->
402− let
403− (v:vs) = Set.toList (Set.fromList unbound)
404− in
405− Result.throw region
400+ Result.throw region
406− (Error.UnboundTypeVarsInUnion name boundVars v vs)
401+ (Error.UnboundTypeVarsInUnion name boundVars unbound)
407
402
408 D.TypeAlias name boundVars tipe ->
403 D.TypeAlias name boundVars tipe ->
409− case findUnbound boundVars (freeVars tipe) of
404+ case diff boundVars (freeVars tipe) of
410− [] ->
405+ ([], []) ->
411 return ()
406 return ()
412
407
413− unbound ->
408+ ([], unbound) ->
414− let
415− (v:vs) = Set.toList (Set.fromList unbound)
416− in
417− Result.throw region
409+ Result.throw region
418− (Error.UnboundTypeVarsInAlias name boundVars v vs)
410+ (Error.UnboundTypeVarsInAlias name boundVars unbound)
411+
412+ (unused, []) ->
413+ Result.throw region
414+ (Error.UnusedTypeVarsInAlias name boundVars unused)
415+
416+ (unused, unbound) ->
417+ Result.throw region
418+ (Error.MessyTypeVarsInAlias name boundVars unused unbound)
419
419
420 D.Port _ ->
420 D.Port _ ->
421− if isRoot
421+ if isRoot then
422− then return ()
422+ return ()
423+
424+ else
423− else Result.throw region Error.UnexpectedPort
425+ Result.throw region Error.UnexpectedPort
424
426
425 D.Fixity _ _ _ ->
427 D.Fixity _ _ _ ->
426 return ()
428 return ()
427
429
428
430
429−findUnbound :: [String] -> [A.Located String] -> [String]
431+diff :: [String] -> [A.Located String] -> ([String], [String])
430−findUnbound boundVars frees =
432+diff left right =
433+ let
434+ leftSet =
431− let bounds = Set.fromList boundVars
435+ Set.fromList left
432
436
433− isUnbound x =
437+ rightSet =
434− Set.notMember x bounds
438+ Set.fromList (map A.drop right)
435 in
439 in
436− filter isUnbound (map A.drop frees)
440+ ( Set.toList (Set.difference leftSet rightSet)
441+ , Set.toList (Set.difference rightSet leftSet)
442+ )
437
443
438
444
439
445