git.iko.soy/elk
on master help sign in
Track info for better shadowing error messages
732b5d1Evan Czaplicki
src/Canonicalize/Environment.hs+11−12
compare with master
unifiedsplit
@@ -73,8 +73,8 @@ data VarHomes =
73
73
74
74
75data UnqualifiedVarHome
75data UnqualifiedVarHome
76− = Local
76+ = Local R.Region
77− | TopLevel
77+ | TopLevel R.Region
78 | Foreign (Bag.Bag ForeignVarHome)
78 | Foreign (Bag.Bag ForeignVarHome)
79
79
80
80
@@ -129,7 +129,7 @@ addLocals :: Map.Map N.Name R.Region -> Env -> Result i w Env
129addLocals names (Env home vars types patterns binops) =
129addLocals names (Env home vars types patterns binops) =
130 do newVars <-
130 do newVars <-
131 Map.mergeA
131 Map.mergeA
132− (Map.mapMissing (\_ _ -> localVarHomes))
132+ (Map.mapMissing addLocalLeft)
133 (Map.mapMissing (\_ homes -> homes))
133 (Map.mapMissing (\_ homes -> homes))
134 (Map.zipWithAMatched addLocalBoth)
134 (Map.zipWithAMatched addLocalBoth)
135 names
135 names
@@ -137,23 +137,22 @@ addLocals names (Env home vars types patterns binops) =
137 Result.ok $ Env home newVars types patterns binops
137 Result.ok $ Env home newVars types patterns binops
138
138
139
139
140−{-# NOINLINE localVarHomes #-}
140+addLocalLeft :: N.Name -> R.Region -> VarHomes
141−localVarHomes :: VarHomes
141+addLocalLeft _ region =
142−localVarHomes =
143− VarHomes Local Map.empty
142+ VarHomes (Local region) Map.empty
144
143
145
144
146addLocalBoth :: N.Name -> R.Region -> VarHomes -> Result i w VarHomes
145addLocalBoth :: N.Name -> R.Region -> VarHomes -> Result i w VarHomes
147addLocalBoth name region (VarHomes unqualified qualified) =
146addLocalBoth name region (VarHomes unqualified qualified) =
148 case unqualified of
147 case unqualified of
149 Foreign _ ->
148 Foreign _ ->
150− Result.ok (VarHomes Local qualified)
149+ Result.ok (VarHomes (Local region) qualified)
151
150
152− Local ->
151+ Local parentRegion ->
153− Result.throw (Error.Shadowing name region)
152+ Result.throw (Error.Shadowing name parentRegion region)
154
153
155− TopLevel ->
154+ TopLevel parentRegion ->
156− Result.throw (Error.Shadowing name region)
155+ Result.throw (Error.Shadowing name parentRegion region)
157
156
158
157
159
158
src/Canonicalize/Environment/Local.hs+15−18
@@ -118,29 +118,26 @@ addVars module_ (Env.Env home vars types patterns binops) =
118 return $ Env.Env home newVars types patterns binops
118 return $ Env.Env home newVars types patterns binops
119
119
120
120
121−addVarsHelp :: Map.Map N.Name () -> Map.Map N.Name Env.VarHomes -> Map.Map N.Name Env.VarHomes
121+addVarsHelp :: Map.Map N.Name R.Region -> Map.Map N.Name Env.VarHomes -> Map.Map N.Name Env.VarHomes
122addVarsHelp localVars vars =
122addVarsHelp localVars vars =
123 let
123 let
124− varHomes =
124+ addLeft _ region =
125− Env.VarHomes Env.TopLevel Map.empty
125+ Env.VarHomes (Env.TopLevel region) Map.empty
126
126
127− addLeft _ _ =
128− varHomes
129−
130− addBoth _ _ (Env.VarHomes _ qualified) =
127+ addBoth _ region (Env.VarHomes _ qualified) =
131− Env.VarHomes Env.TopLevel qualified
128+ Env.VarHomes (Env.TopLevel region) qualified
132 in
129 in
133 merge addLeft addBoth localVars vars
130 merge addLeft addBoth localVars vars
134
131
135
132
136−collectLowerVars :: Valid.Module -> Result i (Map.Map N.Name ())
133+collectLowerVars :: Valid.Module -> Result i (Map.Map N.Name R.Region)
137collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =
134collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =
138 let
135 let
139 addDecl (A.At _ (Valid.Decl (A.At region name) _ _ _)) dict =
136 addDecl (A.At _ (Valid.Decl (A.At region name) _ _ _)) dict =
140− Dups.insert name region () dict
137+ Dups.insert name region region dict
141
138
142 addPort (Valid.Port (A.At region name) _) dict =
139 addPort (Valid.Port (A.At region name) _) dict =
143− Dups.insert name region () dict
140+ Dups.insert name region region dict
144
141
145 effectDict =
142 effectDict =
146 case effects of
143 case effects of
@@ -153,32 +150,32 @@ collectLowerVars (Valid.Module _ _ _ _ _ decls _ _ _ effects) =
153 Valid.Manager _ manager ->
150 Valid.Manager _ manager ->
154 case manager of
151 case manager of
155 Valid.Cmd (A.At region _) ->
152 Valid.Cmd (A.At region _) ->
156− Dups.one "command" region ()
153+ Dups.one "command" region region
157
154
158 Valid.Sub (A.At region _) ->
155 Valid.Sub (A.At region _) ->
159− Dups.one "subscription" region ()
156+ Dups.one "subscription" region region
160
157
161 Valid.Fx (A.At regionCmd _) (A.At regionSub _) ->
158 Valid.Fx (A.At regionCmd _) (A.At regionSub _) ->
162 Dups.union
159 Dups.union
163− (Dups.one "command" regionCmd ())
160+ (Dups.one "command" regionCmd regionCmd)
164− (Dups.one "subscription" regionSub ())
161+ (Dups.one "subscription" regionSub regionSub)
165 in
162 in
166 Dups.detect Error.DuplicateDecl $ foldr addDecl effectDict decls
163 Dups.detect Error.DuplicateDecl $ foldr addDecl effectDict decls
167
164
168
165
169−collectUpperVars :: Valid.Module -> Result i (Map.Map N.Name ())
166+collectUpperVars :: Valid.Module -> Result i (Map.Map N.Name R.Region)
170collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =
167collectUpperVars (Valid.Module _ _ _ _ _ _ unions aliases _ _) =
171 let
168 let
172 addUnion (Valid.Union _ _ ctors) dict =
169 addUnion (Valid.Union _ _ ctors) dict =
173 foldr addCtor dict ctors
170 foldr addCtor dict ctors
174
171
175 addCtor (A.At region name, _args) dict =
172 addCtor (A.At region name, _args) dict =
176− Dups.insert name region () dict
173+ Dups.insert name region region dict
177
174
178 addAlias (Valid.Alias (A.At region name) _ (A.At _ tipe)) dict =
175 addAlias (Valid.Alias (A.At region name) _ (A.At _ tipe)) dict =
179 case tipe of
176 case tipe of
180 Src.TRecord _ Nothing ->
177 Src.TRecord _ Nothing ->
181− Dups.insert name region () dict
178+ Dups.insert name region region dict
182
179
183 _ ->
180 _ ->
184 dict
181 dict
src/Canonicalize/Expression.hs+4−5
@@ -164,9 +164,8 @@ canonicalizeTupleExtras region env extras =
164 [three] ->
164 [three] ->
165 Just <$> canonicalize env three
165 Just <$> canonicalize env three
166
166
167− _ : others ->
167+ _ ->
168− let (A.At r1 _, A.At r2 _) = (head others, last others) in
169− Result.throw (Error.TupleLargerThanThree region (R.merge r1 r2))
168+ Result.throw (Error.TupleLargerThanThree region)
170
169
171
170
172
171
@@ -653,10 +652,10 @@ findVar region (Env.Env localHome vars _ _ _) maybePrefix name =
653 case maybePrefix of
652 case maybePrefix of
654 Nothing ->
653 Nothing ->
655 case unqualified of
654 case unqualified of
656− Env.Local ->
655+ Env.Local _ ->
657 logVar name (Can.VarLocal name)
656 logVar name (Can.VarLocal name)
658
657
659− Env.TopLevel ->
658+ Env.TopLevel _ ->
660 logVar name (Can.VarTopLevel localHome name)
659 logVar name (Can.VarTopLevel localHome name)
661
660
662 Env.Foreign bag ->
661 Env.Foreign bag ->
src/Canonicalize/Pattern.hs+2−3
@@ -130,9 +130,8 @@ canonicalizeTuple tupleRegion env extras =
130 [three] ->
130 [three] ->
131 Just <$> canonicalize env three
131 Just <$> canonicalize env three
132
132
133− _ : others ->
133+ _ ->
134− let (A.At r1 _, A.At r2 _) = (head others, last others) in
135− Result.throw (Error.TupleLargerThanThree tupleRegion (R.merge r1 r2))
134+ Result.throw $ Error.TupleLargerThanThree tupleRegion
136
135
137
136
138canonicalizeList :: Env.Env -> [Src.Pattern] -> Result DupsDict w [Can.Pattern]
137canonicalizeList :: Env.Env -> [Src.Pattern] -> Result DupsDict w [Can.Pattern]
src/Canonicalize/Type.hs+1−3
@@ -87,9 +87,7 @@ canonicalize env (A.At typeRegion tipe) =
87 Just <$> canonicalize env c
87 Just <$> canonicalize env c
88
88
89 _ ->
89 _ ->
90− let (A.At start _, A.At end _) = (head cs, last cs) in
91− Result.throw $
92− Error.TupleLargerThanThree typeRegion (R.merge start end)
90+ Result.throw $ Error.TupleLargerThanThree typeRegion
93
91
94
92
95
93