on master help sign in
Merge pull request #1156 from elm-lang/dev

Dev

commit842817404c108f76b788254ebaf1947863605613 authorEvan Czaplicki <info@elm-lang.org> dateWed 11 Nov 2015, 14:27 (11 years ago) parent3d438121529666
3 files changed+80−40
src/Canonicalize/Setup.hs+3−3 src/Reporting/Error/Syntax.hs+44−10 src/Validate.hs+33−27
src/Canonicalize/Setup.hs+3−3
@@ -151,11 +151,11 @@ valueToPatches region moduleName interface value =
151151 |> Result.err
152152 in
153153 case value of
154− Var.Value x
155− | Map.notMember x (Module.iTypes interface) ->
154+ Var.Value x ->
155+ if Map.notMember x (Module.iTypes interface) then
156156 notFound Var.getValues x
157157
158− | otherwise ->
158+ else
159159 Result.ok [patch Env.Value x]
160160
161161 Var.Alias x ->
src/Reporting/Error/Syntax.hs+44−10
@@ -23,8 +23,10 @@ data Error
2323 | DuplicateValueDeclaration String
2424 | DuplicateTypeDeclaration String
2525 | 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]
2830
2931
3032-- TO REPORT
@@ -148,27 +150,59 @@ toReport _localizer err =
148150 ++ "`, and give each of them a unique name."
149151 )
150152
151− UnboundTypeVarsInAlias typeName givenVars tvar tvars ->
152− unboundTypeVars "type alias" typeName givenVars tvar tvars
153+ UnboundTypeVarsInUnion typeName givenVars unbound ->
154+ unboundTypeVars "type" typeName givenVars unbound
153155
154− UnboundTypeVarsInUnion typeName givenVars tvar tvars ->
155− unboundTypeVars "type" typeName givenVars tvar tvars
156+ UnboundTypeVarsInAlias typeName givenVars unbound ->
157+ unboundTypeVars "type alias" typeName givenVars unbound
156158
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+ )
157191
158192
159−unboundTypeVars :: String -> String -> [String] -> String -> [String] -> Report.Report
160−unboundTypeVars declKind typeName givenVars tvar tvars =
193+unboundTypeVars :: String -> String -> [String] -> [String] -> Report.Report
194+unboundTypeVars declKind typeName givenVars unboundVars@(tvar:_) =
161195 Report.report
162196 "UNBOUND TYPE VARIABLES"
163197 Nothing
164198 ( Help.capitalize declKind ++ " `" ++ typeName ++ "` must declare its use of type variable"
165− ++ Help.commaSep (tvar:tvars)
199+ ++ Help.commaSep unboundVars
166200 )
167201 ( Help.stack
168202 [ text "You probably need to change the declaration like this:"
169203 , hsep $
170204 map text (declKind : typeName : givenVars)
171− ++ map (dullyellow . text) (tvar : tvars)
205+ ++ map (dullyellow . text) unboundVars
172206 ++ map text ["=", "…"]
173207 , Help.reflowParagraph $
174208 "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) =
392392 return ()
393393
394394 D.Datatype name boundVars ctors ->
395− let frees = concatMap freeVars (concatMap snd ctors)
396− in
397− case findUnbound boundVars frees of
398− [] ->
395+ case diff boundVars (concatMap freeVars (concatMap snd ctors)) of
396+ (_, []) ->
399397 return ()
400398
401− unbound ->
402− let
403− (v:vs) = Set.toList (Set.fromList unbound)
404− in
405− Result.throw region
406− (Error.UnboundTypeVarsInUnion name boundVars v vs)
399+ (_, unbound) ->
400+ Result.throw region
401+ (Error.UnboundTypeVarsInUnion name boundVars unbound)
407402
408403 D.TypeAlias name boundVars tipe ->
409− case findUnbound boundVars (freeVars tipe) of
410− [] ->
404+ case diff boundVars (freeVars tipe) of
405+ ([], []) ->
411406 return ()
412407
413− unbound ->
414− let
415− (v:vs) = Set.toList (Set.fromList unbound)
416− in
417− Result.throw region
418− (Error.UnboundTypeVarsInAlias name boundVars v vs)
408+ ([], unbound) ->
409+ Result.throw region
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)
419419
420420 D.Port _ ->
421− if isRoot
422− then return ()
423− else Result.throw region Error.UnexpectedPort
421+ if isRoot then
422+ return ()
423+
424+ else
425+ Result.throw region Error.UnexpectedPort
424426
425427 D.Fixity _ _ _ ->
426428 return ()
427429
428430
429−findUnbound :: [String] -> [A.Located String] -> [String]
430−findUnbound boundVars frees =
431− let bounds = Set.fromList boundVars
431+diff :: [String] -> [A.Located String] -> ([String], [String])
432+diff left right =
433+ let
434+ leftSet =
435+ Set.fromList left
432436
433− isUnbound x =
434− Set.notMember x bounds
437+ rightSet =
438+ Set.fromList (map A.drop right)
435439 in
436− filter isUnbound (map A.drop frees)
440+ ( Set.toList (Set.difference leftSet rightSet)
441+ , Set.toList (Set.difference rightSet leftSet)
442+ )
437443
438444
439445