19859f7 · elk · git.iko.soy

git.iko.soy/elk

Work on some TODOs in canonicalization errors

commit19859f749eabe36845227cc0429deb6d8112e6d3 authorEvan Czaplicki <evancz@users.noreply.github.com> dateWed 31 Jan 2018, 22:23 (9 years ago) parent4878192

3 files changed+136−71

compare with master

unifiedsplit

src/Canonicalize/Environment.hs+34−25 src/Canonicalize/Expression.hs+17−11 src/Reporting/Error/Canonicalize.hs+85−35

src/Canonicalize/Environment.hs+34−25

@@ -154,34 +154,34 @@ addLocalBoth name region var =

154154

155155

156156findType :: R.Region -> Env -> N.Name -> Result i w Type

157−findType region (Env _ _ types _ _ _ _ _) name =

158− case Map.lookup name types of

157+findType region (Env _ _ ts _ _ _ qts _) name =

158+ case Map.lookup name ts of

159159 Just (I.Bin 1 _ tipe _ _) ->

160160 Result.ok tipe

161161

162− Just _ ->

163− error "TODO findType ambiguous unqualified"

162+ Just homes ->

163+ Result.throw (Error.AmbiguousType region Nothing name (Map.keys homes))

164164

165165 Nothing ->

166− error ("TODO findType not found: " ++ N.toString name) region

166+ Result.throw (Error.NotFoundType region name (toPossibleNames ts qts))

167167

168168

169169findTypeQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Type

170−findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =

171− case Map.lookup prefix types of

170+findTypeQual region (Env _ _ ts _ _ _ qts _) prefix name =

171+ case Map.lookup prefix qts of

172172 Just qualified ->

173173 case Map.lookup name qualified of

174174 Just (I.Bin 1 _ tipe _ _) ->

175175 Result.ok tipe

176176

177− Just more ->

178− error "TODO findTypeQual ambiguous qualified" more

177+ Just homes ->

178+ Result.throw (Error.AmbiguousType region (Just prefix) name (Map.keys homes))

179179

180180 Nothing ->

181− error "TODO findTypeQual no qualified"

181+ Result.throw (Error.NotFoundTypeQual region prefix name (toPossibleNames ts qts))

182182

183183 Nothing ->

184− error "TODO findTypeQual not found" region

184+ Result.throw (Error.NotFoundTypeQual region prefix name (toPossibleNames ts qts))

185185

186186

187187

@@ -189,34 +189,34 @@ findTypeQual region (Env _ _ _ _ _ _ types _) prefix name =

189189

190190

191191findCtor :: R.Region -> Env -> N.Name -> Result i w Ctor

192−findCtor region (Env _ _ _ ctors _ _ _ _) name =

193− case Map.lookup name ctors of

192+findCtor region (Env _ _ _ cs _ _ _ qcs) name =

193+ case Map.lookup name cs of

194194 Just (I.Bin 1 _ ctor _ _) ->

195195 Result.ok ctor

196196

197− Just _ ->

198− error ("TODO findCtor ambiguous unqualified " ++ N.toString name)

197+ Just homes ->

198+ Result.throw (Error.AmbiguousCtor region Nothing name (Map.keys homes))

199199

200200 Nothing ->

201− error ("TODO findCtor not found " ++ N.toString name) region

201+ Result.throw (Error.NotFoundCtor region name (toPossibleNames cs qcs))

202202

203203

204204findCtorQual :: R.Region -> Env -> N.Name -> N.Name -> Result i w Ctor

205−findCtorQual region (Env _ _ _ _ _ _ _ ctors) prefix name =

206− case Map.lookup prefix ctors of

205+findCtorQual region (Env _ _ _ cs _ _ _ qcs) prefix name =

206+ case Map.lookup prefix qcs of

207207 Just qualified ->

208208 case Map.lookup name qualified of

209209 Just (I.Bin 1 _ pattern _ _) ->

210210 Result.ok pattern

211211

212− Just _ ->

213− error "TODO findCtorQual ambiguous qualified"

212+ Just homes ->

213+ Result.throw (Error.AmbiguousCtor region (Just prefix) name (Map.keys homes))

214214

215215 Nothing ->

216− error "TODO findCtorQual no qualified"

216+ Result.throw (Error.NotFoundCtorQual region prefix name (toPossibleNames cs qcs))

217217

218218 Nothing ->

219− error "TODO findCtorQual not found" region

219+ Result.throw (Error.NotFoundCtorQual region prefix name (toPossibleNames cs qcs))

220220

221221

222222

@@ -229,8 +229,17 @@ findBinop region (Env _ _ _ _ binops _ _ _) name =

229229 Just (I.Bin 1 _ binop _ _) ->

230230 Result.ok binop

231231

232+ Just _ ->

233+ Result.throw (error "TODO ambiguous binop")

234+

232235 Nothing ->

233− Result.throw (error ("TODO unknown binop " ++ N.toString name) region)

236+ Result.throw (Error.NotFoundBinop region name (Map.keysSet binops))

234237

235− Just _ ->

236− Result.throw (error ("TODO ambiguous binop " ++ N.toString name) region)

238+

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) =

684684

685685

686686findVar :: R.Region -> Env.Env -> N.Name -> Result FreeLocals w Can.Expr_

687−findVar region (Env.Env localHome vars _ _ _ _ _ _) name =

688− case Map.lookup name vars of

687+findVar region (Env.Env localHome vs _ _ _ qvs _ _) name =

688+ case Map.lookup name vs of

689689 Just var ->

690690 case var of

691691 Env.Local _ ->

@@ -701,16 +701,16 @@ findVar region (Env.Env localHome vars _ _ _ _ _ _) name =

701701 else

702702 Can.VarForeign home name annotation

703703

704− Env.Foreign _ ->

705− Result.throw (error ("TODO ambiguous unqualified " ++ N.toString name) region)

704+ Env.Foreign homes ->

705+ Result.throw (Error.AmbiguousVar region Nothing name (Map.keys homes))

706706

707707 Nothing ->

708− Result.throw (error ("TODO no name " ++ N.toString name) region)

708+ Result.throw (Error.NotFoundVar region name (toPossibleNames vs qvs))

709709

710710

711711findVarQual :: R.Region -> Env.Env -> N.Name -> N.Name -> Result FreeLocals w Can.Expr_

712−findVarQual region (Env.Env localHome _ _ _ _ vars _ _) prefix name =

713− case Map.lookup prefix vars of

712+findVarQual region (Env.Env localHome vs _ _ _ qvs _ _) prefix name =

713+ case Map.lookup prefix qvs of

714714 Just qualified ->

715715 case Map.lookup name qualified of

716716 Just (I.Bin 1 home annotation _ _) ->

@@ -720,17 +720,23 @@ findVarQual region (Env.Env localHome _ _ _ _ vars _ _) prefix name =

720720 else

721721 Can.VarForeign home name annotation

722722

723− Just _ ->

724− Result.throw (error ("TODO ambiguous qualified " ++ N.toString name) region)

723+ Just homes ->

724+ Result.throw (Error.AmbiguousVar region (Just prefix) name (Map.keys homes))

725725

726726 Nothing ->

727− Result.throw (error ("TODO no qualified " ++ N.toString name) region)

727+ Result.throw (Error.NotFoundVarQual region prefix name (toPossibleNames vs qvs))

728728

729729 Nothing ->

730730 if ModuleName.isKernel prefix then

731731 Result.ok $ Can.VarKernel (ModuleName.getKernel prefix) name

732732 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+

734740

735741

736742-- FIND CTOR

src/Reporting/Error/Canonicalize.hs+85−35

@@ -5,19 +5,20 @@ module Reporting.Error.Canonicalize

55 , BadArityContext(..)

66 , InvalidPayload(..)

77 , DuplicatePatternContext(..)

8− , variable

8+ , PossibleNames(..)

99 , VarKind(..)

10− , VarProblem(..)

1110 , toReport

1211 )

1312 where

1413

1514

1615import qualified Data.Char as Char

17−import Data.Text (Text)

16+import qualified Data.Map as Map

17+import qualified Data.Set as Set

1818

1919import qualified AST.Canonical as Can

2020import qualified AST.Source as Src

21+import qualified AST.Module.Name as ModuleName

2122import qualified Data.Index as Index

2223import qualified Elm.Name as N

2324import qualified Reporting.Annotation as A

@@ -34,8 +35,11 @@ import Reporting.Helpers ( Doc, (<>) )

3435

3536

3637data 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]

3943 | BadArity R.Region BadArityContext N.Name Int Int

4044 | Binop R.Region N.Name N.Name

4145 | DuplicateDecl N.Name R.Region R.Region

@@ -55,6 +59,13 @@ data Error

5559 | ImportNotFound R.Region N.Name [N.Name]

5660 | ImportOpenAlias R.Region N.Name

5761 | 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

5869 | PatternHasRecordCtor R.Region N.Name

5970 | PortPayloadInvalid R.Region N.Name Can.Type InvalidPayload

6071 | PortTypeInvalid R.Region N.Name Can.Type

@@ -87,31 +98,13 @@ data InvalidPayload

8798 | UnsupportedType N.Name

8899

89100

90−

91−-- VARIABLES

92−

93−

94−data VarError =

95− VarError

96− { _kind :: VarKind

97− , _name :: Text

98− , _problem :: VarProblem

99− , _suggestions :: [Text]

101+data PossibleNames =

102+ PossibleNames

103+ { _locals :: Set.Set N.Name

104+ , _quals :: Map.Map N.Name (Set.Set N.Name)

100105 }

101106

102107

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−

115108

116109-- KIND

117110

@@ -146,9 +139,6 @@ toKindInfo kind name =

146139toReport :: Code.Source -> RenderType.Localizer -> Error -> Report.Report

147140toReport source localizer err =

148141 case err of

149− Var varError ->

150− error "TODO" varError

151−

152142 AnnotationTooShort region name index leftovers ->

153143 let

154144 numTypeArgs = Index.toHuman index

@@ -168,6 +158,18 @@ toReport source localizer err =

168158 <> " be deleted? Maybe some parentheses are missing?"

169159 )

170160

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+

171173 BadArity region badArityContext name expected actual ->

172174 let

173175 thing =

@@ -257,11 +259,28 @@ toReport source localizer err =

257259 DPDestruct ->

258260 "This pattern contains multiple `" <> N.toString name <> "` variables."

259261

260− EffectNotFound _ _ ->

261− error "TODO EffectNotFound"

262+ EffectNotFound region name ->

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+ )

262283

263− EffectFunctionNotFound _ _ ->

264− error "TODO EffectFunctionNotFound"

265284

266285 ExportDuplicate name r1 r2 ->

267286 let

@@ -295,7 +314,16 @@ toReport source localizer err =

295314 ]

296315

297316 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+ )

299327

300328 ImportCtorByName region ctor tipe ->

301329 Report.Report "BAD IMPORT" region [] $

@@ -351,6 +379,27 @@ toReport source localizer err =

351379 H.maybeYouWant Nothing suggestions

352380 )

353381

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+

354403 PatternHasRecordCtor region name ->

355404 Report.Report "BAD PATTERN" region [] $

356405 Report.toCodeSnippet source region Nothing

@@ -453,6 +502,7 @@ toReport source localizer err =

453502 H.reflow $

454503 "The `" <> N.toString name <> "` value has a direct use of `" <> N.toString name <> "` in its definition."

455504 ,

505+ -- TODO see if shadowing rules out mutation attempts

456506 H.stack

457507 [ H.reflow $

458508 "To know what `" <> N.toString name