2e0beda · elk · git.iko.soy

git.iko.soy/elk

Update canonicalizer for Reporting.Annotation simplification

commit2e0beda9bc2aa1721297129524d6498ec3a0793d authorEvan Czaplicki <evancz@users.noreply.github.com> dateFri 17 Nov 2017, 13:57 (9 years ago) parent212b602

9 files changed+67−67

compare with master

unifiedsplit

src/Canonicalize/Effects.hs+3−3 src/Canonicalize/Environment/Dups.hs+1−1 src/Canonicalize/Environment/Foreign.hs+2−2 src/Canonicalize/Environment/Internals.hs+1−1 src/Canonicalize/Environment/Local.hs+18−18 src/Canonicalize/Expression.hs+18−18 src/Canonicalize/Module.hs+13−13 src/Canonicalize/Pattern.hs+8−8 src/Canonicalize/Type.hs+3−3

src/Canonicalize/Effects.hs+3−3

@@ -77,7 +77,7 @@ canonicalize env decls unions effects =

7777

7878

7979canonicalizePort :: Env.Env -> Valid.Port -> Result (N.Name, Can.Port)

80−canonicalizePort env (Valid.Port (A.A region portName) tipe) =

80+canonicalizePort env (Valid.Port (A.At region portName) tipe) =

8181 do ctipe <- Type.canonicalize env tipe

8282 case Type.deepDealias ctipe of

8383 Can.TLambda outgoingType (Can.TType home name [Can.TVar _])

@@ -107,7 +107,7 @@ canonicalizePort env (Valid.Port (A.A region portName) tipe) =

107107

108108

109109verifyEffectType :: A.Located N.Name -> Map.Map N.Name a -> Result N.Name

110−verifyEffectType (A.A region name) unions =

110+verifyEffectType (A.At region name) unions =

111111 if Map.member name unions then

112112 Result.ok name

113113 else

@@ -115,7 +115,7 @@ verifyEffectType (A.A region name) unions =

115115

116116

117117toNameRegion :: A.Located Valid.Decl -> (N.Name, R.Region)

118−toNameRegion (A.A _ (Valid.Decl (A.A region name) _ _ _)) =

118+toNameRegion (A.At _ (Valid.Decl (A.At region name) _ _ _)) =

119119 (name, region)

120120

121121

src/Canonicalize/Environment/Dups.hs+1−1

@@ -99,7 +99,7 @@ detectHelp toError name values =

9999checkFields :: [(A.Located N.Name, a)] -> Result () (Map.Map N.Name a)

100100checkFields fields =

101101 let

102− toInfo (A.A region name, value) =

102+ toInfo (A.At region name, value) =

103103 Map.singleton name (OneOrMore.one (Info region () value))

104104

105105 toError name () () =

src/Canonicalize/Environment/Foreign.hs+2−2

@@ -267,7 +267,7 @@ data Exposed

267267

268268

269269verifyImport :: ImportDict -> I.Interfaces -> Src.Import -> Result Import

270−verifyImport importDict interfaces (Src.Import (A.A region name) alias exposing) =

270+verifyImport importDict interfaces (Src.Import (A.At region name) alias exposing) =

271271 case Map.lookup name importDict of

272272 Nothing ->

273273 throwImportNotFound region name (Map.elems importDict)

@@ -296,7 +296,7 @@ throwImportNotFound region name knownModules =

296296

297297

298298verifyExposed :: N.Name -> I.Interface -> A.Located Src.Exposed -> Result [(N.Name, Exposed)]

299−verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.A region exposed) =

299+verifyExposed moduleName interface@(I.Interface _ unions aliases _) (A.At region exposed) =

300300 case exposed of

301301 Src.Operator name ->

302302 verifyValue moduleName region name interface

src/Canonicalize/Environment/Internals.hs+1−1

@@ -146,7 +146,7 @@ localVarHomes =

146146

147147

148148addLocalBoth :: N.Name -> A.Located a -> VarHomes -> Result () VarHomes

149−addLocalBoth name (A.A region _) (VarHomes unqualified qualified) =

149+addLocalBoth name (A.At region _) (VarHomes unqualified qualified) =

150150 case unqualified of

151151 Foreign _ ->

152152 Result.ok (VarHomes Local qualified)

src/Canonicalize/Environment/Local.hs+18−18

@@ -135,10 +135,10 @@ addVarsHelp localVars vars =

135135collectLowerVars :: Valid.Module -> Result (Map.Map N.Name ())

136136collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

137137 let

138− addDecl (A.A _ (Valid.Decl (A.A region name) _ _ _)) dict =

138+ addDecl (A.At _ (Valid.Decl (A.At region name) _ _ _)) dict =

139139 Dups.insert name region () () dict

140140

141− addPort (Valid.Port (A.A region name) _) dict =

141+ addPort (Valid.Port (A.At region name) _) dict =

142142 Dups.insert name region () () dict

143143

144144 effectDict =

@@ -151,13 +151,13 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

151151

152152 Valid.Manager _ manager ->

153153 case manager of

154− Valid.Cmd (A.A region _) ->

154+ Valid.Cmd (A.At region _) ->

155155 Dups.one "command" region () ()

156156

157− Valid.Sub (A.A region _) ->

157+ Valid.Sub (A.At region _) ->

158158 Dups.one "subscription" region () ()

159159

160− Valid.Fx (A.A regionCmd _) (A.A regionSub _) ->

160+ Valid.Fx (A.At regionCmd _) (A.At regionSub _) ->

161161 Dups.union

162162 (Dups.one "command" regionCmd () ())

163163 (Dups.one "subscription" regionSub () ())

@@ -171,13 +171,13 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

171171collectUpperVars :: Valid.Module -> Result (Map.Map N.Name ())

172172collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =

173173 let

174− addUnion (Valid.Union (A.A _ name) _ ctors) dict =

174+ addUnion (Valid.Union (A.At _ name) _ ctors) dict =

175175 foldr (addCtor name) dict ctors

176176

177− addCtor tipe (A.A region name, _args) dict =

177+ addCtor tipe (A.At region name, _args) dict =

178178 Dups.insert name region (Error.UnionCtor tipe) () dict

179179

180− addAlias (Valid.Alias (A.A region name) _ (A.A _ tipe)) dict =

180+ addAlias (Valid.Alias (A.At region name) _ (A.At _ tipe)) dict =

181181 case tipe of

182182 Src.TRecord _ Nothing ->

183183 Dups.insert name region Error.RecordCtor () dict

@@ -196,11 +196,11 @@ collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =

196196addTypes :: Valid.Module -> Env.Env -> Result Env.Env

197197addTypes (Valid.Module _ _ _ _ _ _ unions aliases _ _) env =

198198 let

199− aliasToDict alias@(Valid.Alias (A.A region name) _ tipe) =

199+ aliasToDict alias@(Valid.Alias (A.At region name) _ tipe) =

200200 do args <- checkAliasFreeVars alias

201201 return $ Dups.one name region () (Left (Alias region name args tipe))

202202

203− unionToDict union@(Valid.Union (A.A region name) _ _) =

203+ unionToDict union@(Valid.Union (A.At region name) _ _) =

204204 do arity <- checkUnionFreeVars union

205205 return $ Dups.one name region () (Right arity)

206206

@@ -292,7 +292,7 @@ toNode alias@(Alias _ name _ tipe) =

292292

293293

294294getEdges :: Src.Type -> Bag.Bag N.Name

295−getEdges (A.A _ tipe) =

295+getEdges (A.At _ tipe) =

296296 case tipe of

297297 Src.TLambda arg result ->

298298 Bag.append (getEdges arg) (getEdges result)

@@ -325,9 +325,9 @@ getEdges (A.A _ tipe) =

325325

326326

327327checkUnionFreeVars :: Valid.Union -> Result Int

328−checkUnionFreeVars (Valid.Union (A.A unionRegion name) args ctors) =

328+checkUnionFreeVars (Valid.Union (A.At unionRegion name) args ctors) =

329329 let

330− addUnion (A.A region arg) dict =

330+ addUnion (A.At region arg) dict =

331331 Dups.insert arg region () region dict

332332

333333 toError badArg () () =

@@ -343,16 +343,16 @@ checkUnionFreeVars (Valid.Union (A.A unionRegion name) args ctors) =

343343 Result.ok (length args)

344344

345345 unbound ->

346− let toLoc (arg, region) = A.A region arg in

346+ let toLoc (arg, region) = A.At region arg in

347347 Result.throw unionRegion $

348348 Error.TypeVarsUnboundInUnion name (map A.drop args) (map toLoc unbound)

349349

350350

351351

352352checkAliasFreeVars :: Valid.Alias -> Result [N.Name]

353−checkAliasFreeVars (Valid.Alias (A.A aliasRegion name) args tipe) =

353+checkAliasFreeVars (Valid.Alias (A.At aliasRegion name) args tipe) =

354354 let

355− addAlias (A.A region arg) dict =

355+ addAlias (A.At region arg) dict =

356356 Dups.insert arg region () region dict

357357

358358 toError badArg () () =

@@ -364,7 +364,7 @@ checkAliasFreeVars (Valid.Alias (A.A aliasRegion name) args tipe) =

364364 if Map.size boundVars == overlap && Map.size freeVars == overlap

365365 then Result.ok (map A.drop args)

366366 else

367− let toLoc (arg, region) = A.A region arg in

367+ let toLoc (arg, region) = A.At region arg in

368368 Result.throw aliasRegion $

369369 Error.TypeVarsMessedUpInAlias name

370370 (map A.drop args)

@@ -373,7 +373,7 @@ checkAliasFreeVars (Valid.Alias (A.A aliasRegion name) args tipe) =

373373

374374

375375addFreeVars :: Src.Type -> Map.Map N.Name R.Region -> Map.Map N.Name R.Region

376−addFreeVars (A.A region tipe) freeVars =

376+addFreeVars (A.At region tipe) freeVars =

377377 case tipe of

378378 Src.TLambda arg result ->

379379 addFreeVars arg (addFreeVars result freeVars)

src/Canonicalize/Expression.hs+18−18

@@ -47,8 +47,8 @@ type FreeLocals =

4747

4848

4949canonicalize :: Env.Env -> Valid.Expr -> Result FreeLocals Can.Expr

50−canonicalize env (A.A region expression) =

51− A.A region <$>

50+canonicalize env (A.At region expression) =

51+ A.At region <$>

5252 case expression of

5353 Valid.Str string ->

5454 Result.ok (Can.Str string)

@@ -113,10 +113,10 @@ canonicalize env (A.A region expression) =

113113 <$> canonicalize env record

114114 <*> Result.ok field

115115

116− Valid.Update (A.A reg name) fields ->

116+ Valid.Update (A.At reg name) fields ->

117117 do fieldDict <- Result.untracked $ Dups.checkFields fields

118118 name_ <- Env.findVar reg env Nothing name

119− Can.Update (A.A reg name_)

119+ Can.Update (A.At reg name_)

120120 <$> traverse (canonicalize env) fieldDict

121121

122122 Valid.Record fields ->

@@ -150,7 +150,7 @@ canonicalizeTupleExtras region env extras =

150150 Just <$> canonicalize env three

151151

152152 _ : others ->

153− let (A.A r1 _, A.A r2 _) = (head others, last others) in

153+ let (A.At r1 _, A.At r2 _) = (head others, last others) in

154154 Result.throw region (Error.TupleLargerThanThree (R.merge r1 r2))

155155

156156

@@ -187,7 +187,7 @@ canonicalizeCaseBranch env (pattern, expr) =

187187canonicalizeBinops :: R.Region -> Env.Env -> [(Valid.Expr, A.Located N.Name)] -> Valid.Expr -> Result FreeLocals Can.Expr

188188canonicalizeBinops overallRegion env ops final =

189189 let

190− canonicalizeHelp (expr, A.A region op) =

190+ canonicalizeHelp (expr, A.At region op) =

191191 (,)

192192 <$> canonicalize env expr

193193 <*> Env.findBinop region env op

@@ -316,8 +316,8 @@ removeLocals unused boundNames (Result.Result freeLocals warnings answer) =

316316

317317

318318toUnusedWarning :: Warning.Unused -> (N.Name, A.Located a) -> A.Located Warning.Warning

319−toUnusedWarning unused (name, A.A region _) =

320− A.A region (Warning.UnusedVariable unused name)

319+toUnusedWarning unused (name, A.At region _) =

320+ A.At region (Warning.UnusedVariable unused name)

321321

322322

323323

@@ -331,15 +331,15 @@ type Bindings =

331331addBindings :: (Valid.Def, Int) -> Bindings -> Bindings

332332addBindings (def, key) bindings =

333333 case def of

334− Valid.Define defRegion (A.A region name) _ _ _ ->

335− Dups.insert name region () (A.A defRegion key) bindings

334+ Valid.Define defRegion (A.At region name) _ _ _ ->

335+ Dups.insert name region () (A.At defRegion key) bindings

336336

337337 Valid.Destruct defRegion pattern _ ->

338− addBindingsHelp (A.A defRegion key) pattern bindings

338+ addBindingsHelp (A.At defRegion key) pattern bindings

339339

340340

341341addBindingsHelp :: A.Located Int -> Src.Pattern -> Bindings -> Bindings

342−addBindingsHelp key (A.A region pattern) bindings =

342+addBindingsHelp key (A.At region pattern) bindings =

343343 case pattern of

344344 Src.PAnything ->

345345 bindings

@@ -349,7 +349,7 @@ addBindingsHelp key (A.A region pattern) bindings =

349349

350350 Src.PRecord fields ->

351351 let

352− addField (A.A fieldRegion name) dict =

352+ addField (A.At fieldRegion name) dict =

353353 Dups.insert name fieldRegion () key dict

354354 in

355355 foldr addField bindings fields

@@ -369,7 +369,7 @@ addBindingsHelp key (A.A region pattern) bindings =

369369 Src.PCons first rest ->

370370 addBindingsHelp key rest (addBindingsHelp key first bindings)

371371

372− Src.PAlias ptrn (A.A reg name) ->

372+ Src.PAlias ptrn (A.At reg name) ->

373373 addBindingsHelp key ptrn (Dups.insert name reg () key bindings)

374374

375375 Src.PChr _ ->

@@ -397,7 +397,7 @@ data Binding

397397defToNode :: Map.Map N.Name Int -> Env.Env -> (Valid.Def, Int) -> Result () (Node, Int, [Int])

398398defToNode defKeys env (def, key) =

399399 case def of

400− Valid.Define region aname@(A.A _ name) srcArgs body Nothing ->

400+ Valid.Define region aname@(A.At _ name) srcArgs body Nothing ->

401401 do (args, destructors) <-

402402 Pattern.verify (Error.DPFuncArgs name) $

403403 Index.indexedTraverse (Pattern.canonicalizeArg env) srcArgs

@@ -415,7 +415,7 @@ defToNode defKeys env (def, key) =

415415 toNode defKeys key destructors $

416416 Destruct region cpattern destructors <$> canonicalize env body

417417

418− Valid.Define region aname@(A.A _ name) srcArgs body (Just tipe) ->

418+ Valid.Define region aname@(A.At _ name) srcArgs body (Just tipe) ->

419419 do (Can.Forall freeVars ctipe) <- Type.toAnnotation env tipe

420420 ((args, resultType), destructors) <-

421421 Pattern.verify (Error.DPFuncArgs name) $

@@ -465,7 +465,7 @@ gatherTypedArgs env name srcArgs tipe index revTypedArgs =

465465 typedArg : revTypedArgs

466466

467467 _ ->

468− let (A.A start _, A.A end _) = (head srcArgs, last srcArgs) in

468+ let (A.At start _, A.At end _) = (head srcArgs, last srcArgs) in

469469 Result.throw (R.merge start end) $

470470 Error.AnnotationTooShort name index (length srcArgs)

471471

@@ -481,7 +481,7 @@ detectCycles letRegion sccs body =

481481 Result.ok body

482482

483483 scc : subSccs ->

484− A.A letRegion <$>

484+ A.At letRegion <$>

485485 case scc of

486486 Graph.AcyclicSCC (Node binding freeLocals) ->

487487 case binding of

src/Canonicalize/Module.hs+13−13

@@ -79,13 +79,13 @@ canonicalize pkg importDict interfaces module_@(Valid.Module name _ _ exports im

7979

8080

8181toDocs :: Valid.Module -> A.Located (Maybe Can.Docs)

82−toDocs (Valid.Module _ (A.A region maybeOverview) comments _ _ _ _ _ _ _) =

82+toDocs (Valid.Module _ (A.At region maybeOverview) comments _ _ _ _ _ _ _) =

8383 case maybeOverview of

8484 Nothing ->

85− A.A region Nothing

85+ A.At region Nothing

8686

8787 Just overview ->

88− A.A region (Just (Can.Docs overview comments))

88+ A.At region (Just (Can.Docs overview comments))

8989

9090

9191

@@ -93,13 +93,13 @@ toDocs (Valid.Module _ (A.A region maybeOverview) comments _ _ _ _ _ _ _) =

9393

9494

9595canonicalizeAlias :: Env.Env -> Valid.Alias -> Result ( N.Name, Can.Alias )

96−canonicalizeAlias env (Valid.Alias (A.A _ name) args tipe) =

96+canonicalizeAlias env (Valid.Alias (A.At _ name) args tipe) =

9797 do ctipe <- Type.canonicalize env tipe

9898 return (name, Can.Alias (map A.drop args) ctipe (toRecordCtorInfo tipe))

9999

100100

101101toRecordCtorInfo :: Src.Type -> Maybe [N.Name]

102−toRecordCtorInfo (A.A _ tipe) =

102+toRecordCtorInfo (A.At _ tipe) =

103103 case tipe of

104104 Src.TRecord fields Nothing ->

105105 Just (map (A.drop . fst) fields)

@@ -113,9 +113,9 @@ toRecordCtorInfo (A.A _ tipe) =

113113

114114

115115canonicalizeUnion :: Env.Env -> Valid.Union -> Result ( N.Name, Can.Union )

116−canonicalizeUnion env (Valid.Union (A.A _ name) args ctors) =

116+canonicalizeUnion env (Valid.Union (A.At _ name) args ctors) =

117117 let

118− canonicalizeCtor (A.A _ ctor, tipes) =

118+ canonicalizeCtor (A.At _ ctor, tipes) =

119119 do ctipes <- traverse (Type.canonicalize env) tipes

120120 return (ctor, ctipes)

121121 in

@@ -128,7 +128,7 @@ canonicalizeUnion env (Valid.Union (A.A _ name) args ctors) =

128128

129129

130130canonicalizeBinop :: Valid.Binop -> ( N.Name, Can.Binop )

131−canonicalizeBinop (Valid.Binop (A.A _ op) associativity precedence func) =

131+canonicalizeBinop (Valid.Binop (A.At _ op) associativity precedence func) =

132132 ( op, Can.Binop_ associativity precedence func )

133133

134134

@@ -162,7 +162,7 @@ detectCycles sccs =

162162

163163

164164toNode :: Env.Env -> A.Located Valid.Decl -> Result (Can.Def, N.Name, [N.Name])

165−toNode env (A.A _ (Valid.Decl aname@(A.A _ name) srcArgs body maybeType)) =

165+toNode env (A.At _ (Valid.Decl aname@(A.At _ name) srcArgs body maybeType)) =

166166 case maybeType of

167167 Nothing ->

168168 do (args, destructors) <-

@@ -206,10 +206,10 @@ detectBadCycles def defs =

206206detectBadCyclesHelp :: Can.Def -> Maybe N.Name

207207detectBadCyclesHelp def =

208208 case def of

209− Can.Def (A.A _ name) [] _ _ ->

209+ Can.Def (A.At _ name) [] _ _ ->

210210 Just name

211211

212− Can.TypedDef (A.A _ name) _ [] _ _ _ ->

212+ Can.TypedDef (A.At _ name) _ [] _ _ _ ->

213213 Just name

214214

215215 _ ->

@@ -241,7 +241,7 @@ canonicalizeExports decls unions aliases binops effects exposing =

241241

242242

243243declToName :: A.Located Valid.Decl -> ( N.Name, () )

244−declToName (A.A _ (Valid.Decl (A.A _ name) _ _ _)) =

244+declToName (A.At _ (Valid.Decl (A.At _ name) _ _ _)) =

245245 ( name, () )

246246

247247

@@ -253,7 +253,7 @@ checkExposed

253253 -> Can.Effects

254254 -> A.Located Src.Exposed

255255 -> Result (Dups.Dict () Can.Export)

256−checkExposed decls unions aliases binops effects (A.A region exposed) =

256+checkExposed decls unions aliases binops effects (A.At region exposed) =

257257 case exposed of

258258 Src.Lower name ->

259259 if Map.member name decls then

src/Canonicalize/Pattern.hs+8−8

@@ -67,21 +67,21 @@ canonicalize env index pattern =

6767

6868

6969process :: Env.Env -> Can.Destructor -> Src.Pattern -> Result Bindings Can.Pattern

70−process env destructor (A.A region pattern) =

71− A.A region <$>

70+process env destructor (A.At region pattern) =

71+ A.At region <$>

7272 case pattern of

7373 Src.PAnything ->

7474 Result.ok Can.PAnything

7575

7676 Src.PVar name ->

7777 Result.accumulate

78− (Dups.one name region () (A.A region destructor))

78+ (Dups.one name region () (A.At region destructor))

7979 (Can.PVar name)

8080

8181 Src.PRecord fields ->

8282 let

83− addField (A.A reg name) dict =

84− Dups.insert name reg () (A.A reg (Can.DField name destructor)) dict

83+ addField (A.At reg name) dict =

84+ Dups.insert name reg () (A.At reg (Can.DField name destructor)) dict

8585 in

8686 Result.accumulate

8787 (foldr addField Dups.none fields)

@@ -119,10 +119,10 @@ process env destructor (A.A region pattern) =

119119 <$> process env (Can.DIndex Index.first destructor) first

120120 <*> process env (Can.DIndex Index.second destructor) rest

121121

122− Src.PAlias ptrn (A.A reg name) ->

122+ Src.PAlias ptrn (A.At reg name) ->

123123 do cpattern <- process env destructor ptrn

124124 Result.accumulate

125− (Dups.one name reg () (A.A reg destructor))

125+ (Dups.one name reg () (A.At reg destructor))

126126 (Can.PAlias cpattern name)

127127

128128 Src.PChr chr ->

@@ -145,7 +145,7 @@ processTuple tupleRegion env destructor extras =

145145 Just <$> process env (Can.DIndex Index.third destructor) three

146146

147147 _ : others ->

148− let (A.A r1 _, A.A r2 _) = (head others, last others) in

148+ let (A.At r1 _, A.At r2 _) = (head others, last others) in

149149 Result.throw tupleRegion (Error.TupleLargerThanThree (R.merge r1 r2))

150150

151151

src/Canonicalize/Type.hs+3−3

@@ -45,7 +45,7 @@ toAnnotation env srcType =

4545

4646

4747canonicalize :: Env.Env -> Src.Type -> Result () Can.Type

48−canonicalize env (A.A typeRegion tipe) =

48+canonicalize env (A.At typeRegion tipe) =

4949 case tipe of

5050 Src.TVar x ->

5151 Result.ok (Can.TVar x)

@@ -89,7 +89,7 @@ canonicalize env (A.A typeRegion tipe) =

8989 Just <$> canonicalize env c

9090

9191 _ ->

92− let (A.A start _, A.A end _) = (head cs, last cs) in

92+ let (A.At start _, A.At end _) = (head cs, last cs) in

9393 Result.throw typeRegion $

9494 Error.TupleLargerThanThree (R.merge start end)

9595

@@ -110,7 +110,7 @@ checkArgs argsType expected region name args answer =

110110 else

111111 let

112112 extras = drop expected args

113− (A.A start _, A.A end _) = (head extras, last extras)

113+ (A.At start _, A.At end _) = (head extras, last extras)

114114 in

115115 Error.TooMany argsType name expected actual (R.merge start end)

116116