ae0bf2b · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Stop tracking category of dups

ae0bf2bEvan Czaplicki9 years ago

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

compare with master

unifiedsplit

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

27-- DUPLICATE TRACKER

30−type Dict category value =

30+type Dict value =

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

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

34−data Info category value =

34+data Info value =

35 Info

36 { _region :: R.Region

37− , _category :: category

38 , _value :: value

37 , _value :: value

39 }

38 }

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

43-- DETECT

42-- DETECT

46−type ToError c =

45+type ToError =

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

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

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)

51detect toError dict =

50detect toError dict =

52 Map.traverseWithKey (detectHelp toError) dict

51 Map.traverseWithKey (detectHelp toError) dict

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

56detectHelp toError name values =

55detectHelp toError name values =

57 case values of

56 case values of

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

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

59 return value

58 return value

61 OneOrMore.More _ _ ->

60 OneOrMore.More _ _ ->

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

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

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

62+ Result.throw (toError name r1 r2)

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

72 detect Error.DuplicateField (foldr addField none fields)

71 detect Error.DuplicateField (foldr addField none fields)

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

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

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

75addField (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

81-- BUILDING DICTIONARIES

80-- BUILDING DICTIONARIES

84−none :: Dict c v

83+none :: Dict a

85none =

84none =

86 Map.empty

85 Map.empty

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

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

90−one name region category value =

89+one name region value =

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

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

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

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

95−insert name region category value dict =

94+insert name region value dict =

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

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

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

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

100union a b =

99union a b =

101 Map.unionWith OneOrMore.more a b

100 Map.unionWith OneOrMore.more a b

102

101

103

102

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

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

105unions dicts =

104unions dicts =

106 Map.unionsWith OneOrMore.more dicts

105 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 ())

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

138 let

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

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

140+ Dups.insert name region () dict

141

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

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

143+ Dups.insert name region () dict

144

145 effectDict =

146 case effects of

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

153 Valid.Manager _ manager ->

154 case manager of

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

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

156+ Dups.one "command" region ()

157

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

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

159+ Dups.one "subscription" region ()

160

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

162 Dups.union

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

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

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

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

165 in

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

167

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

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

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

171 let

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

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

173− foldr (addCtor name) dict ctors

173+ foldr addCtor dict ctors

174

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

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

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

176+ Dups.insert name region () dict

177

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

179 case tipe of

180 Src.TRecord _ Nothing ->

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

181+ Dups.insert name region () dict

182

183 _ ->

184 dict

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

196 let

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

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

200

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

202 do arity <- checkUnionFreeVars union

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

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

204

205 combineDicts dicts1 dicts2 =

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

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

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

324 let

325 addUnion (A.At region arg) dict =

326− Dups.insert arg region () region dict

326+ Dups.insert arg region region dict

327−

328− toError =

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

330

327

331 addCtorFreeVars (_, tipes) freeVars =

328 addCtorFreeVars (_, tipes) freeVars =

332 foldr addFreeVars freeVars tipes

329 foldr addFreeVars freeVars tipes

333 in

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

335 let freeVars = foldr addCtorFreeVars Map.empty ctors

332 let freeVars = foldr addCtorFreeVars Map.empty ctors

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

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

337 [] ->

334 [] ->

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

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

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

349 let

346 let

350 addAlias (A.At region arg) dict =

347 addAlias (A.At region arg) dict =

351− Dups.insert arg region () region dict

348+ Dups.insert arg region region dict

352−

353− toError =

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

355 in

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

357 let freeVars = addFreeVars tipe Map.empty

351 let freeVars = addFreeVars tipe Map.empty

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

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

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

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

src/Canonicalize/Expression.hs+5−5

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

313

314

315type Bindings =

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

316+ Dups.Dict (A.Located Int)

317

318

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

320addBindings (def, key) bindings =

321 case def of

322 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

324

325 Valid.Destruct defRegion pattern _ ->

326 addBindingsHelp (A.At defRegion key) pattern bindings

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

333 bindings

334

335 Src.PVar name ->

336− Dups.insert name region () key bindings

336+ Dups.insert name region key bindings

337

338 Src.PRecord fields ->

339 let

340 addField (A.At fieldRegion name) dict =

341− Dups.insert name fieldRegion () key dict

341+ Dups.insert name fieldRegion key dict

342 in

343 foldr addField bindings fields

344

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

358 addBindingsHelp key rest (addBindingsHelp key first bindings)

359

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

362

363 Src.PChr _ ->

364 bindings

src/Canonicalize/Module.hs+3−3

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

291 -> Map.Map N.Name binop

292 -> Can.Effects

293 -> A.Located Src.Exposed

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

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

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

296 case exposed of

297 Src.Lower name ->

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

345 Just []

346

347

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

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

61type DupsDict =

62− Dups.Dict () R.Region

62+ Dups.Dict R.Region

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

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

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

155logVar name region value =

156 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

158

159

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

161logFields fields value =

162 let

163 addField (A.At region name) dict =

164− Dups.insert name region () region dict

164+ Dups.insert name region region dict

165 in

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

167 ok (foldr addField bindings fields) warnings value