git.iko.soy/elk
on master help sign in
Work on some TODOs in canonicalization errors
19859f7Evan Czaplicki
src/Canonicalize/Environment.hs+34−25
compare with master
unifiedsplit
@@ -154,34 +154,34 @@ addLocalBoth name region var =
154
154
155
155
156findType :: R.Region -> Env -> N.Name -> Result i w Type
156findType :: R.Region -> Env -> N.Name -> Result i w Type
157−findType region (Env _ _ types _ _ _ _ _) name =
157+findType region (Env _ _ ts _ _ _ qts _) name =
158− case Map.lookup name types of
158+ case Map.lookup name ts of
159 Just (I.Bin 1 _ tipe _ _) ->
159 Just (I.Bin 1 _ tipe _ _) ->
160 Result.ok tipe
160 Result.ok tipe
161
161
162− Just _ ->
162+ Just homes ->
163− error "TODO findType ambiguous unqualified"
163+ Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))
164
164
165 Nothing ->
165 Nothing ->
166− error ("TODO findType not found: " ++ N.toString name) region
166+ Result.throw (Error.NotFoundType region name (toPossibleNames ts qts))
167
167
168
168
169findTypeQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Type
169findTypeQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Type
170−findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =
170+findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =
171− case Map.lookup prefix types of
171+ case Map.lookup prefix qts of
172 Just qualified ->
172 Just qualified ->
173 case Map.lookup name qualified of
173 case Map.lookup name qualified of
174 Just (I.Bin 1 _ tipe _ _) ->
174 Just (I.Bin 1 _ tipe _ _) ->
175 Result.ok tipe
175 Result.ok tipe
176
176
177− Just more ->
177+ Just homes ->
178− error "TODO findTypeQual ambiguous qualified" more
178+ Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))
179
179
180 Nothing ->
180 Nothing ->
181− error "TODO findTypeQual no qualified"
181+ Result.throw (Error.NotFoundTypeQual region prefix name (toPossibleNames ts qts))
182
182
183 Nothing ->
183 Nothing ->
184− error "TODO findTypeQual not found" region
184+ Result.throw (Error.NotFoundTypeQual region prefix name (toPossibleNames ts qts))
185
185
186
186
187
187
@@ -189,34 +189,34 @@ findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =
189
189
190
190
191findCtor :: R.Region -> Env -> N.Name -> Result i w Ctor
191findCtor :: R.Region -> Env -> N.Name -> Result i w Ctor
192−findCtor region (Env _ _ _ ctors _ _ _ _) name =
192+findCtor region (Env _ _ _ cs _ _ _ qcs) name =
193− case Map.lookup name ctors of
193+ case Map.lookup name cs of
194 Just (I.Bin 1 _ ctor _ _) ->
194 Just (I.Bin 1 _ ctor _ _) ->
195 Result.ok ctor
195 Result.ok ctor
196
196
197− Just _ ->
197+ Just homes ->
198− error ("TODO findCtor ambiguous unqualified " ++ N.toString name)
198+ Result.throw (Error.AmbiguousCtor region Nothing name (Map.keys homes))
199
199
200 Nothing ->
200 Nothing ->
201− error ("TODO findCtor not found " ++ N.toString name) region
201+ Result.throw (Error.NotFoundCtor region name (toPossibleNames cs qcs))
202
202
203
203
204findCtorQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Ctor
204findCtorQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Ctor
205−findCtorQual region (Env _ _ _ _ _ _ _ ctors) prefix name =
205+findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =
206− case Map.lookup prefix ctors of
206+ case Map.lookup prefix qcs of
207 Just qualified ->
207 Just qualified ->
208 case Map.lookup name qualified of
208 case Map.lookup name qualified of
209 Just (I.Bin 1 _ pattern _ _) ->
209 Just (I.Bin 1 _ pattern _ _) ->
210 Result.ok pattern
210 Result.ok pattern
211
211
212− Just _ ->
212+ Just homes ->
213− error "TODO findCtorQual ambiguous qualified"
213+ Result.throw (Error.AmbiguousCtor region (Just prefix) name (Map.keys homes))
214
214
215 Nothing ->
215 Nothing ->
216− error "TODO findCtorQual no qualified"
216+ Result.throw (Error.NotFoundCtorQual region prefix name (toPossibleNames cs qcs))
217
217
218 Nothing ->
218 Nothing ->
219− error "TODO findCtorQual not found" region
219+ Result.throw (Error.NotFoundCtorQual region prefix name (toPossibleNames cs qcs))
220
220
221
221
222
222
@@ -229,8 +229,17 @@ findBinop region (Env _ _ _ _ binops _ _ _) name =
229 Just (I.Bin 1 _ binop _ _) ->
229 Just (I.Bin 1 _ binop _ _) ->
230 Result.ok binop
230 Result.ok binop
231
231
232+ Just _ ->
233+ Result.throw (error "TODO ambiguous binop")
234+
232 Nothing ->
235 Nothing ->
233− Result.throw (error ("TODO unknown binop " ++ N.toString name) region)
236+ Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))
234
237
235− Just _ ->
238+
236− Result.throw (error ("TODO ambiguous binop " ++ N.toString name) region)
239+
240+-- TO POSSIBLE NAMES
241+
242+
243+toPossibleNames :: Exposed a -> Qualified a -> Error.PossibleNames
244+toPossibleNames exposed qualified =
245+ Error.PossibleNames (Map.keysSet exposed) (Map.map Map.keysSet qualified)
src/Canonicalize/Expression.hs+17−11
@@ -684,8 +684,8 @@ delayedUsage (Result.Result k) =
684
684
685
685
686findVar :: R.Region -> Env.Env -> N.Name -> Result FreeLocals w Can.Expr_
686findVar :: R.Region -> Env.Env -> N.Name -> Result FreeLocals w Can.Expr_
687−findVar region (Env.Env localHome vars _ _ _ _ _ _) name =
687+findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =
688− case Map.lookup name vars of
688+ case Map.lookup name vs of
689 Just var ->
689 Just var ->
690 case var of
690 case var of
691 Env.Local _ ->
691 Env.Local _ ->
@@ -701,16 +701,16 @@ findVar region (Env.Env localHome vars _ _ _ _ _ _) name =
701 else
701 else
702 Can.VarForeign home name annotation
702 Can.VarForeign home name annotation
703
703
704− Env.Foreign _ ->
704+ Env.Foreign homes ->
705− Result.throw (error ("TODO ambiguous unqualified " ++ N.toString name) region)
705+ Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))
706
706
707 Nothing ->
707 Nothing ->
708− Result.throw (error ("TODO no name " ++ N.toString name) region)
708+ Result.throw (Error.NotFoundVar region name (toPossibleNames vs qvs))
709
709
710
710
711findVarQual :: R.Region -> Env.Env -> N.Name -> N.Name -> Result FreeLocals w Can.Expr_
711findVarQual :: R.Region -> Env.Env -> N.Name -> N.Name -> Result FreeLocals w Can.Expr_
712−findVarQual region (Env.Env localHome _ _ _ _ vars _ _) prefix name =
712+findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =
713− case Map.lookup prefix vars of
713+ case Map.lookup prefix qvs of
714 Just qualified ->
714 Just qualified ->
715 case Map.lookup name qualified of
715 case Map.lookup name qualified of
716 Just (I.Bin 1 home annotation _ _) ->
716 Just (I.Bin 1 home annotation _ _) ->
@@ -720,17 +720,23 @@ findVarQual region (Env.Env localHome _ _ _ _ vars _ _) prefix name =
720 else
720 else
721 Can.VarForeign home name annotation
721 Can.VarForeign home name annotation
722
722
723− Just _ ->
723+ Just homes ->
724− Result.throw (error ("TODO ambiguous qualified " ++ N.toString name) region)
724+ Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))
725
725
726 Nothing ->
726 Nothing ->
727− Result.throw (error ("TODO no qualified " ++ N.toString name) region)
727+ Result.throw (Error.NotFoundVarQual region prefix name (toPossibleNames vs qvs))
728
728
729 Nothing ->
729 Nothing ->
730 if ModuleName.isKernel prefix then
730 if ModuleName.isKernel prefix then
731 Result.ok $ Can.VarKernel (ModuleName.getKernel prefix) name
731 Result.ok $ Can.VarKernel (ModuleName.getKernel prefix) name
732 else
732 else
733− Result.throw (error ("TODO no name " ++ N.toString name) region)
733+ Result.throw (Error.NotFoundVarQual region prefix name (toPossibleNames vs qvs))
734+
735+
736+toPossibleNames :: Map.Map N.Name Env.Var -> Env.Qualified Can.Annotation -> Error.PossibleNames
737+toPossibleNames exposed qualified =
738+ Error.PossibleNames (Map.keysSet exposed) (Map.map Map.keysSet qualified)
739+
734
740
735
741
736-- FIND CTOR
742-- FIND CTOR
src/Reporting/Error/Canonicalize.hs+85−35
@@ -5,19 +5,20 @@ module Reporting.Error.Canonicalize
5 , BadArityContext(..)
5 , BadArityContext(..)
6 , InvalidPayload(..)
6 , InvalidPayload(..)
7 , DuplicatePatternContext(..)
7 , DuplicatePatternContext(..)
8− , variable
8+ , PossibleNames(..)
9 , VarKind(..)
9 , VarKind(..)
10− , VarProblem(..)
11 , toReport
10 , toReport
12 )
11 )
13 where
12 where
14
13
15
14
16import qualified Data.Char as Char
15import qualified Data.Char as Char
17−import Data.Text (Text)
16+import qualified Data.Map as Map
17+import qualified Data.Set as Set
18
18
19import qualified AST.Canonical as Can
19import qualified AST.Canonical as Can
20import qualified AST.Source as Src
20import qualified AST.Source as Src
21+import qualified AST.Module.Name as ModuleName
21import qualified Data.Index as Index
22import qualified Data.Index as Index
22import qualified Elm.Name as N
23import qualified Elm.Name as N
23import qualified Reporting.Annotation as A
24import qualified Reporting.Annotation as A
@@ -34,8 +35,11 @@ import Reporting.Helpers ( Doc, (<>) )
34
35
35
36
36data Error
37data Error
37− = Var VarError
38− | AnnotationTooShort R.Region N.Name Index.ZeroBased Int
38+ = AnnotationTooShort R.Region N.Name Index.ZeroBased Int
39+ | AmbiguousVar R.Region (Maybe N.Name) N.Name [ModuleName.Canonical]
40+ | AmbiguousType R.Region (Maybe N.Name) N.Name [ModuleName.Canonical]
41+ | AmbiguousCtor R.Region (Maybe N.Name) N.Name [ModuleName.Canonical]
42+ | AmbiguousBinop R.Region N.Name [ModuleName.Canonical]
39 | BadArity R.Region BadArityContext N.Name Int Int
43 | BadArity R.Region BadArityContext N.Name Int Int
40 | Binop R.Region N.Name N.Name
44 | Binop R.Region N.Name N.Name
41 | DuplicateDecl N.Name R.Region R.Region
45 | DuplicateDecl N.Name R.Region R.Region
@@ -55,6 +59,13 @@ data Error
55 | ImportNotFound R.Region N.Name [N.Name]
59 | ImportNotFound R.Region N.Name [N.Name]
56 | ImportOpenAlias R.Region N.Name
60 | ImportOpenAlias R.Region N.Name
57 | ImportExposingNotFound R.Region N.Name N.Name [N.Name]
61 | ImportExposingNotFound R.Region N.Name N.Name [N.Name]
62+ | NotFoundVar R.Region N.Name PossibleNames
63+ | NotFoundType R.Region N.Name PossibleNames
64+ | NotFoundCtor R.Region N.Name PossibleNames
65+ | NotFoundBinop R.Region N.Name (Set.Set N.Name)
66+ | NotFoundVarQual R.Region N.Name N.Name PossibleNames
67+ | NotFoundTypeQual R.Region N.Name N.Name PossibleNames
68+ | NotFoundCtorQual R.Region N.Name N.Name PossibleNames
58 | PatternHasRecordCtor R.Region N.Name
69 | PatternHasRecordCtor R.Region N.Name
59 | PortPayloadInvalid R.Region N.Name Can.Type InvalidPayload
70 | PortPayloadInvalid R.Region N.Name Can.Type InvalidPayload
60 | PortTypeInvalid R.Region N.Name Can.Type
71 | PortTypeInvalid R.Region N.Name Can.Type
@@ -87,31 +98,13 @@ data InvalidPayload
87 | UnsupportedType N.Name
98 | UnsupportedType N.Name
88
99
89
100
90−
101+data PossibleNames =
91−-- VARIABLES
102+ PossibleNames
92−
103+ { _locals :: Set.Set N.Name
93−
104+ , _quals :: Map.Map N.Name (Set.Set N.Name)
94−data VarError =
95− VarError
96− { _kind :: VarKind
97− , _name :: Text
98− , _problem :: VarProblem
99− , _suggestions :: [Text]
100 }
105 }
101
106
102
107
103−data VarProblem
104− = Ambiguous
105− | UnknownQualifier Text Text
106− | QualifiedUnknown Text Text
107− | ExposedUnknown
108−
109−
110−variable :: VarKind -> Text -> VarProblem -> [Text] -> Error
111−variable kind name problem suggestions =
112− Var (VarError kind name problem suggestions)
113−
114−
115
108
116-- KIND
109-- KIND
117
110
@@ -146,9 +139,6 @@ toKindInfo kind name =
146toReport :: Code.Source -> RenderType.Localizer -> Error -> Report.Report
139toReport :: Code.Source -> RenderType.Localizer -> Error -> Report.Report
147toReport source localizer err =
140toReport source localizer err =
148 case err of
141 case err of
149− Var varError ->
150− error "TODO" varError
151−
152 AnnotationTooShort region name index leftovers ->
142 AnnotationTooShort region name index leftovers ->
153 let
143 let
154 numTypeArgs = Index.toHuman index
144 numTypeArgs = Index.toHuman index
@@ -168,6 +158,18 @@ toReport source localizer err =
168 <> " be deleted? Maybe some parentheses are missing?"
158 <> " be deleted? Maybe some parentheses are missing?"
169 )
159 )
170
160
161+ AmbiguousVar region maybePrefix name possibleHomes ->
162+ error "TODO" region maybePrefix name possibleHomes
163+
164+ AmbiguousType region maybePrefix name possibleHomes ->
165+ error "TODO" region maybePrefix name possibleHomes
166+
167+ AmbiguousCtor region maybePrefix name possibleHomes ->
168+ error "TODO" region maybePrefix name possibleHomes
169+
170+ AmbiguousBinop region name possibleHomes ->
171+ error "TODO" region name possibleHomes
172+
171 BadArity region badArityContext name expected actual ->
173 BadArity region badArityContext name expected actual ->
172 let
174 let
173 thing =
175 thing =
@@ -257,11 +259,28 @@ toReport source localizer err =
257 DPDestruct ->
259 DPDestruct ->
258 "This pattern contains multiple `" <> N.toString name <> "` variables."
260 "This pattern contains multiple `" <> N.toString name <> "` variables."
259
261
260− EffectNotFound _ _ ->
262+ EffectNotFound region name ->
261− error "TODO EffectNotFound"
263+ Report.Report "EFFECT PROBLEM" region [] $
264+ Report.toCodeSnippet source region Nothing
265+ (
266+ H.reflow $
267+ "You have declared that `" ++ N.toString name ++ "` is an effect type:"
268+ ,
269+ H.reflow $
270+ "But I cannot find a union type named `" ++ N.toString name ++ "` in this file!"
271+ )
272+
273+ EffectFunctionNotFound region name ->
274+ Report.Report "EFFECT PROBLEM" region [] $
275+ Report.toCodeSnippet source region Nothing
276+ (
277+ H.reflow $
278+ "This kind of effect module must define a `" ++ N.toString name ++ "` function."
279+ ,
280+ H.reflow $
281+ "But I cannot find `" ++ N.toString name ++ "` in this file!"
282+ )
262
283
263− EffectFunctionNotFound _ _ ->
264− error "TODO EffectFunctionNotFound"
265
284
266 ExportDuplicate name r1 r2 ->
285 ExportDuplicate name r1 r2 ->
267 let
286 let
@@ -295,7 +314,16 @@ toReport source localizer err =
295 ]
314 ]
296
315
297 ExportOpenAlias region name ->
316 ExportOpenAlias region name ->
298− error "TODO" region name
317+ Report.Report "BAD EXPORT" region [] $
318+ Report.toCodeSnippet source region Nothing
319+ (
320+ H.reflow $
321+ "The (..) syntax is for exposing union type constructors. It cannot be used with a type alias like `"
322+ ++ N.toString name ++ "` though."
323+ ,
324+ H.reflow $
325+ "Remove the (..) and you should be fine!"
326+ )
299
327
300 ImportCtorByName region ctor tipe ->
328 ImportCtorByName region ctor tipe ->
301 Report.Report "BAD IMPORT" region [] $
329 Report.Report "BAD IMPORT" region [] $
@@ -351,6 +379,27 @@ toReport source localizer err =
351 H.maybeYouWant Nothing suggestions
379 H.maybeYouWant Nothing suggestions
352 )
380 )
353
381
382+ NotFoundVar region name possibleNames ->
383+ error "TODO" region name possibleNames
384+
385+ NotFoundType region name possibleNames ->
386+ error "TODO" region name possibleNames
387+
388+ NotFoundCtor region name possibleNames ->
389+ error "TODO" region name possibleNames
390+
391+ NotFoundBinop region name locals ->
392+ error "TODO" region name locals
393+
394+ NotFoundVarQual region prefix name possibleNames ->
395+ error "TODO" region prefix name possibleNames
396+
397+ NotFoundTypeQual region prefix name possibleNames ->
398+ error "TODO" region prefix name possibleNames
399+
400+ NotFoundCtorQual region prefix name possibleNames ->
401+ error "TODO" region prefix name possibleNames
402+
354 PatternHasRecordCtor region name ->
403 PatternHasRecordCtor region name ->
355 Report.Report "BAD PATTERN" region [] $
404 Report.Report "BAD PATTERN" region [] $
356 Report.toCodeSnippet source region Nothing
405 Report.toCodeSnippet source region Nothing
@@ -453,6 +502,7 @@ toReport source localizer err =
453 H.reflow $
502 H.reflow $
454 "The `" <> N.toString name <> "` value has a direct use of `" <> N.toString name <> "` in its definition."
503 "The `" <> N.toString name <> "` value has a direct use of `" <> N.toString name <> "` in its definition."
455 ,
504 ,
505+ -- TODO see if shadowing rules out mutation attempts
456 H.stack
506 H.stack
457 [ H.reflow $
507 [ H.reflow $
458 "To know what `" <> N.toString name
508 "To know what `" <> N.toString name