ae0bf2b · elk · git.iko.soy

git.iko.soy/elk

Stop tracking category of dups

Turns out it doesn’t make that one error message better, so it’s better to not allocate a spot for it.

commitae0bf2b5ec4b21433eebbf16b42e6f9f6d2354fc authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 19 Dec 2017, 18:39 (9 years ago) parentd91a33e

5 files changed+49−56

compare with master

unifiedsplit

src/Canonicalize/Environment/Dups.hs+21−22 src/Canonicalize/Environment/Local.hs+17−23 src/Canonicalize/Expression.hs+5−5 src/Canonicalize/Module.hs+3−3 src/Canonicalize/Pattern.hs+3−3

src/Canonicalize/Environment/Dups.hs+21−22

@@ -27,14 +27,13 @@ import qualified Reporting.Result as Result

2727-- DUPLICATE TRACKER

2828

2929

30−type Dict category value =

31− Map.Map N.Name (OneOrMore.OneOrMore (Info category value))

30+type Dict value =

31+ Map.Map N.Name (OneOrMore.OneOrMore (Info value))

3232

3333

34−data Info category value =

34+data Info value =

3535 Info

3636 { _region :: R.Region

37− , _category :: category

3837 , _value :: value

3938 }

4039

@@ -43,24 +42,24 @@ data Info category value =

4342-- DETECT

4443

4544

46−type ToError c =

47− N.Name -> R.Region -> c -> R.Region -> c -> Error.Error

45+type ToError =

46+ N.Name -> R.Region -> R.Region -> Error.Error

4847

4948

50−detect :: ToError c -> Dict c v -> Result.Result i w Error.Error (Map.Map N.Name v)

49+detect :: ToError -> Dict a -> Result.Result i w Error.Error (Map.Map N.Name a)

5150detect toError dict =

5251 Map.traverseWithKey (detectHelp toError) dict

5352

5453

55−detectHelp :: ToError c -> N.Name -> OneOrMore.OneOrMore (Info c v) -> Result.Result i w Error.Error v

54+detectHelp :: ToError -> N.Name -> OneOrMore.OneOrMore (Info a) -> Result.Result i w Error.Error a

5655detectHelp toError name values =

5756 case values of

58− OneOrMore.One (Info _ _ value) ->

57+ OneOrMore.One (Info _ value) ->

5958 return value

6059

6160 OneOrMore.More _ _ ->

62− let (Info r1 c1 _ : Info r2 c2 _ : _) = OneOrMore.toList values in

63− Result.throw (toError name r1 c1 r2 c2)

61+ let (Info r1 _ : Info r2 _ : _) = OneOrMore.toList values in

62+ Result.throw (toError name r1 r2)

6463

6564

6665

@@ -72,35 +71,35 @@ checkFields fields =

7271 detect Error.DuplicateField (foldr addField none fields)

7372

7473

75−addField :: (A.Located N.Name, a) -> Dict () a -> Dict () a

74+addField :: (A.Located N.Name, a) -> Dict a -> Dict a

7675addField (A.At region name, value) dups =

77− Map.insertWith OneOrMore.more name (OneOrMore.one (Info region () value)) dups

76+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dups

7877

7978

8079

8180-- BUILDING DICTIONARIES

8281

8382

84−none :: Dict c v

83+none :: Dict a

8584none =

8685 Map.empty

8786

8887

89−one :: N.Name -> R.Region -> category -> value -> Dict category value

90−one name region category value =

91− Map.singleton name (OneOrMore.one (Info region category value))

88+one :: N.Name -> R.Region -> value -> Dict value

89+one name region value =

90+ Map.singleton name (OneOrMore.one (Info region value))

9291

9392

94−insert :: N.Name -> R.Region -> c -> v -> Dict c v -> Dict c v

95−insert name region category value dict =

96− Map.insertWith OneOrMore.more name (OneOrMore.one (Info region category value)) dict

93+insert :: N.Name -> R.Region -> a -> Dict a -> Dict a

94+insert name region value dict =

95+ Map.insertWith OneOrMore.more name (OneOrMore.one (Info region value)) dict

9796

9897

99−union :: Dict c v -> Dict c v -> Dict c v

98+union :: Dict a -> Dict a -> Dict a

10099union a b =

101100 Map.unionWith OneOrMore.more a b

102101

103102

104−unions :: [Dict c v] -> Dict c v

103+unions :: [Dict a] -> Dict a

105104unions dicts =

106105 Map.unionsWith OneOrMore.more dicts

src/Canonicalize/Environment/Local.hs+17−23

@@ -137,10 +137,10 @@ collectLowerVars :: Valid.Module -> Result i (Map.Map N.Name ())

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

138138 let

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

140− Dups.insert name region () () dict

140+ Dups.insert name region () dict

141141

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

143− Dups.insert name region () () dict

143+ Dups.insert name region () dict

144144

145145 effectDict =

146146 case effects of

@@ -153,15 +153,15 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

153153 Valid.Manager _ manager ->

154154 case manager of

155155 Valid.Cmd (A.At region _) ->

156− Dups.one "command" region () ()

156+ Dups.one "command" region ()

157157

158158 Valid.Sub (A.At region _) ->

159− Dups.one "subscription" region () ()

159+ Dups.one "subscription" region ()

160160

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

162162 Dups.union

163− (Dups.one "command" regionCmd () ())

164− (Dups.one "subscription" regionSub () ())

163+ (Dups.one "command" regionCmd ())

164+ (Dups.one "subscription" regionSub ())

165165 in

166166 Dups.detect Error.DuplicateDecl $ foldr addDecl effectDict decls

167167

@@ -169,16 +169,16 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =

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

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

171171 let

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

173− foldr (addCtor name) dict ctors

172+ addUnion (Valid.Union _ _ ctors) dict =

173+ foldr addCtor dict ctors

174174

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

176− Dups.insert name region (Error.UnionCtor tipe) () dict

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

176+ Dups.insert name region () dict

177177

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

179179 case tipe of

180180 Src.TRecord _ Nothing ->

181− Dups.insert name region Error.RecordCtor () dict

181+ Dups.insert name region () dict

182182

183183 _ ->

184184 dict

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

196196 let

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

198198 do args <- checkAliasFreeVars alias

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

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

200200

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

202202 do arity <- checkUnionFreeVars union

203− return $ Dups.one name region () (Right arity)

203+ return $ Dups.one name region (Right arity)

204204

205205 combineDicts dicts1 dicts2 =

206206 Dups.union (Dups.unions dicts1) (Dups.unions dicts2)

@@ -323,15 +323,12 @@ checkUnionFreeVars :: Valid.Union -> Result i Int

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

324324 let

325325 addUnion (A.At region arg) dict =

326− Dups.insert arg region () region dict

327−

328− toError =

329− Error.DuplicateUnionArg name (map A.toValue args)

326+ Dups.insert arg region region dict

330327

331328 addCtorFreeVars (_, tipes) freeVars =

332329 foldr addFreeVars freeVars tipes

333330 in

334− do boundVars <- Dups.detect toError (foldr addUnion Dups.none args)

331+ do boundVars <- Dups.detect (Error.DuplicateUnionArg name) (foldr addUnion Dups.none args)

335332 let freeVars = foldr addCtorFreeVars Map.empty ctors

336333 case Map.toList (Map.difference freeVars boundVars) of

337334 [] ->

@@ -348,12 +345,9 @@ checkAliasFreeVars :: Valid.Alias -> Result i [N.Name]

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

349346 let

350347 addAlias (A.At region arg) dict =

351− Dups.insert arg region () region dict

352−

353− toError =

354− Error.DuplicateAliasArg name (map A.toValue args)

348+ Dups.insert arg region region dict

355349 in

356− do boundVars <- Dups.detect toError (foldr addAlias Dups.none args)

350+ do boundVars <- Dups.detect (Error.DuplicateAliasArg name) (foldr addAlias Dups.none args)

357351 let freeVars = addFreeVars tipe Map.empty

358352 let overlap = Map.size (Map.intersection boundVars freeVars)

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

src/Canonicalize/Expression.hs+5−5

@@ -313,14 +313,14 @@ canonicalizeLet letRegion env defs body =

313313

314314

315315type Bindings =

316− Dups.Dict () (A.Located Int)

316+ Dups.Dict (A.Located Int)

317317

318318

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

320320addBindings (def, key) bindings =

321321 case def of

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

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

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

324324

325325 Valid.Destruct defRegion pattern _ ->

326326 addBindingsHelp (A.At defRegion key) pattern bindings

@@ -333,12 +333,12 @@ addBindingsHelp key (A.At region pattern) bindings =

333333 bindings

334334

335335 Src.PVar name ->

336− Dups.insert name region () key bindings

336+ Dups.insert name region key bindings

337337

338338 Src.PRecord fields ->

339339 let

340340 addField (A.At fieldRegion name) dict =

341− Dups.insert name fieldRegion () key dict

341+ Dups.insert name fieldRegion key dict

342342 in

343343 foldr addField bindings fields

344344

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

358358 addBindingsHelp key rest (addBindingsHelp key first bindings)

359359

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

361− addBindingsHelp key ptrn (Dups.insert name reg () key bindings)

361+ addBindingsHelp key ptrn (Dups.insert name reg key bindings)

362362

363363 Src.PChr _ ->

364364 bindings

src/Canonicalize/Module.hs+3−3

@@ -291,7 +291,7 @@ checkExposed

291291 -> Map.Map N.Name binop

292292 -> Can.Effects

293293 -> A.Located Src.Exposed

294− -> Result i w (Dups.Dict () (A.Located Can.Export))

294+ -> Result i w (Dups.Dict (A.Located Can.Export))

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

296296 case exposed of

297297 Src.Lower name ->

@@ -345,6 +345,6 @@ checkPorts effects name =

345345 Just []

346346

347347

348−ok :: N.Name -> R.Region -> Can.Export -> Result i w (Dups.Dict () (A.Located Can.Export))

348+ok :: N.Name -> R.Region -> Can.Export -> Result i w (Dups.Dict (A.Located Can.Export))

349349ok name region export =

350− Result.ok $ Dups.one name region () (A.At region export)

350+ Result.ok $ Dups.one name region (A.At region export)

src/Canonicalize/Pattern.hs+3−3

@@ -59,7 +59,7 @@ verify context (Result.Result k) =

5959

6060

6161type DupsDict =

62− Dups.Dict () R.Region

62+ Dups.Dict R.Region

6363

6464

6565canonicalize :: Env.Env -> Src.Pattern -> Result DupsDict w Can.Pattern

@@ -154,14 +154,14 @@ canonicalizeList env list =

154154logVar :: N.Name -> R.Region -> a -> Result DupsDict w a

155155logVar name region value =

156156 Result.Result $ \bindings warnings _ ok ->

157− ok (Dups.insert name region () region bindings) warnings value

157+ ok (Dups.insert name region region bindings) warnings value

158158

159159

160160logFields :: [A.Located N.Name] -> a -> Result DupsDict w a

161161logFields fields value =

162162 let

163163 addField (A.At region name) dict =

164− Dups.insert name region () region dict

164+ Dups.insert name region region dict

165165 in

166166 Result.Result $ \bindings warnings _ ok ->

167167 ok (foldr addField bindings fields) warnings value