Pattern matching between identical let-bindings produce no shadowing errors

[EMattfolk]

Description

Patterns between variable declarations in let-bindings seem to confuse the compiler's ability to detecting shadowing

To Reproduce

module A (a) where

a :: Int
a =
  let
    b = 1
    _ = 1
    b = 1
  in
  b

As long as a pattern match is between two identical declarations it doesn't complain

Expected behavior

A shadowing warning/error

PureScript version

0.15.14

[nwolverson]

From recollection the shadowing/unused warnings are calculated against the bindings in the original form without the construction of mutually recursive binding groups (where the pattern binding is partitioning this into 2 binding groups). There may be a test around this for unused, at least I was aware of it at the time and considered it not blocking.

[EMattfolk]

Is there a good way to fix this? I'd be more than happy to help out. We had an outage in production due to another bug that was triggered because we had two declarations with the same name like in the example. The wrong declaration was used in the actual code and a warning would likely have made it apparent that there was a bug.

[MonoidMusician]

I haven't looked into it thoroughly yet, but I believe this is the relevant chunk of code:

purescript/src/Language/PureScript/Linter.hs

Lines 39 to 79 in 5589e81

	lintDeclaration :: Declaration -> m ()
	lintDeclaration = tell . f
	where
	(warningsInDecl, _, _, _, _) = everythingWithScope (\_ _ -> mempty) stepE stepB (\_ _ -> mempty) stepDo
	f :: Declaration -> MultipleErrors
	f (TypeClassDeclaration _ name args _ _ decs) = addHint (ErrorInTypeClassDeclaration name) (foldMap (f' (S.fromList $ fst <$> args)) decs)
	f dec = f' S.empty dec
	f' :: S.Set Text -> Declaration -> MultipleErrors
	f' s dec@(ValueDeclaration vd) =
	addHint (ErrorInValueDeclaration (valdeclIdent vd)) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)
	f' s (TypeDeclaration td@(TypeDeclarationData (ss, _) _ _)) =
	addHint (ErrorInTypeDeclaration (tydeclIdent td)) (checkTypeVars ss s (tydeclType td))
	f' s dec = warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec
	stepE :: S.Set ScopedIdent -> Expr -> MultipleErrors
	stepE s (Abs (VarBinder ss name) _) | name `inScope` s = errorMessage' ss (ShadowedName name)
	stepE s (Let _ ds' _) = foldMap go ds'
	where
	go d | Just i <- getDeclIdent d
	, inScope i s = errorMessage' (declSourceSpan d) (ShadowedName i)
	| otherwise = mempty
	stepE _ _ = mempty
	stepB :: S.Set ScopedIdent -> Binder -> MultipleErrors
	stepB s (VarBinder ss name)
	| name `inScope` s
	= errorMessage' ss (ShadowedName name)
	stepB s (NamedBinder ss name _)
	| inScope name s
	= errorMessage' ss (ShadowedName name)
	stepB _ _ = mempty
	stepDo :: S.Set ScopedIdent -> DoNotationElement -> MultipleErrors
	stepDo s (DoNotationLet ds') = foldMap go ds'
	where
	go d
	| Just i <- getDeclIdent d, i `inScope` s = errorMessage' (declSourceSpan d) (ShadowedName i)
	| otherwise = mempty
	stepDo _ _ = mempty

The interesting functions there are in AST/Traversals.hs:

purescript/src/Language/PureScript/AST/Traversals.hs

Lines 544 to 666 in 5589e81

	inScope :: Ident -> S.Set ScopedIdent -> Bool
	inScope i s = (LocalIdent i `S.member` s) || (ToplevelIdent i `S.member` s)
	everythingWithScope
	:: forall r
	. (Monoid r)
	=> (S.Set ScopedIdent -> Declaration -> r)
	-> (S.Set ScopedIdent -> Expr -> r)
	-> (S.Set ScopedIdent -> Binder -> r)
	-> (S.Set ScopedIdent -> CaseAlternative -> r)
	-> (S.Set ScopedIdent -> DoNotationElement -> r)
	-> ( S.Set ScopedIdent -> Declaration -> r
	, S.Set ScopedIdent -> Expr -> r
	, S.Set ScopedIdent -> Binder -> r
	, S.Set ScopedIdent -> CaseAlternative -> r
	, S.Set ScopedIdent -> DoNotationElement -> r
	)
	everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
	where
	f'' :: S.Set ScopedIdent -> Declaration -> r
	f'' s a = f s a <> f' s a
	f' :: S.Set ScopedIdent -> Declaration -> r
	f' s (DataBindingGroupDeclaration ds) =
	let s' = S.union s (S.fromList (map ToplevelIdent (mapMaybe getDeclIdent (NEL.toList ds))))
	in foldMap (f'' s') ds
	f' s (ValueDecl _ name _ bs val) =
	let s' = S.insert (ToplevelIdent name) s
	s'' = S.union s' (S.fromList (concatMap localBinderNames bs))
	in foldMap (h'' s') bs <> foldMap (l' s'') val
	f' s (BindingGroupDeclaration ds) =
	let s' = S.union s (S.fromList (NEL.toList (fmap (\((_, name), _, _) -> ToplevelIdent name) ds)))
	in foldMap (\(_, _, val) -> g'' s' val) ds
	f' s (TypeClassDeclaration _ _ _ _ _ ds) = foldMap (f'' s) ds
	f' s (TypeInstanceDeclaration _ _ _ _ _ _ _ _ (ExplicitInstance ds)) = foldMap (f'' s) ds
	f' _ _ = mempty
	g'' :: S.Set ScopedIdent -> Expr -> r
	g'' s a = g s a <> g' s a
	g' :: S.Set ScopedIdent -> Expr -> r
	g' s (Literal _ l) = lit g'' s l
	g' s (UnaryMinus _ v1) = g'' s v1
	g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
	g' s (Parens v1) = g'' s v1
	g' s (Accessor _ v1) = g'' s v1
	g' s (ObjectUpdate obj vs) = g'' s obj <> foldMap (g'' s . snd) vs
	g' s (ObjectUpdateNested obj vs) = g'' s obj <> foldMap (g'' s) vs
	g' s (Abs b v1) =
	let s' = S.union (S.fromList (localBinderNames b)) s
	in h'' s b <> g'' s' v1
	g' s (App v1 v2) = g'' s v1 <> g'' s v2
	g' s (VisibleTypeApp v _) = g'' s v
	g' s (Unused v) = g'' s v
	g' s (IfThenElse v1 v2 v3) = g'' s v1 <> g'' s v2 <> g'' s v3
	g' s (Case vs alts) = foldMap (g'' s) vs <> foldMap (i'' s) alts
	g' s (TypedValue _ v1 _) = g'' s v1
	g' s (Let _ ds v1) =
	let s' = S.union s (S.fromList (map LocalIdent (mapMaybe getDeclIdent ds)))
	in foldMap (f'' s') ds <> g'' s' v1
	g' s (Do _ es) = fold . snd . mapAccumL j'' s $ es
	g' s (Ado _ es v1) =
	let s' = S.union s (foldMap (fst . j'' s) es)
	in g'' s' v1
	g' s (PositionedValue _ _ v1) = g'' s v1
	g' _ _ = mempty
	h'' :: S.Set ScopedIdent -> Binder -> r
	h'' s a = h s a <> h' s a
	h' :: S.Set ScopedIdent -> Binder -> r
	h' s (LiteralBinder _ l) = lit h'' s l
	h' s (ConstructorBinder _ _ bs) = foldMap (h'' s) bs
	h' s (BinaryNoParensBinder b1 b2 b3) = foldMap (h'' s) [b1, b2, b3]
	h' s (ParensInBinder b) = h'' s b
	h' s (NamedBinder _ name b1) = h'' (S.insert (LocalIdent name) s) b1
	h' s (PositionedBinder _ _ b1) = h'' s b1
	h' s (TypedBinder _ b1) = h'' s b1
	h' _ _ = mempty
	lit :: (S.Set ScopedIdent -> a -> r) -> S.Set ScopedIdent -> Literal a -> r
	lit go s (ArrayLiteral as) = foldMap (go s) as
	lit go s (ObjectLiteral as) = foldMap (go s . snd) as
	lit _ _ _ = mempty
	i'' :: S.Set ScopedIdent -> CaseAlternative -> r
	i'' s a = i s a <> i' s a
	i' :: S.Set ScopedIdent -> CaseAlternative -> r
	i' s (CaseAlternative bs gs) =
	let s' = S.union s (S.fromList (concatMap localBinderNames bs))
	in foldMap (h'' s) bs <> foldMap (l' s') gs
	j'' :: S.Set ScopedIdent -> DoNotationElement -> (S.Set ScopedIdent, r)
	j'' s a = let (s', r) = j' s a in (s', j s a <> r)
	j' :: S.Set ScopedIdent -> DoNotationElement -> (S.Set ScopedIdent, r)
	j' s (DoNotationValue v) = (s, g'' s v)
	j' s (DoNotationBind b v) =
	let s' = S.union (S.fromList (localBinderNames b)) s
	in (s', h'' s b <> g'' s v)
	j' s (DoNotationLet ds) =
	let s' = S.union s (S.fromList (map LocalIdent (mapMaybe getDeclIdent ds)))
	in (s', foldMap (f'' s') ds)
	j' s (PositionedDoNotationElement _ _ e1) = j'' s e1
	k' :: S.Set ScopedIdent -> Guard -> (S.Set ScopedIdent, r)
	k' s (ConditionGuard e) = (s, g'' s e)
	k' s (PatternGuard b e) =
	let s' = S.union (S.fromList (localBinderNames b)) s
	in (s', h'' s b <> g'' s' e)
	l' s (GuardedExpr [] e) = g'' s e
	l' s (GuardedExpr (grd:gs) e) =
	let (s', r) = k' s grd
	in r <> l' s' (GuardedExpr gs e)
	getDeclIdent :: Declaration -> Maybe Ident
	getDeclIdent (ValueDeclaration vd) = Just (valdeclIdent vd)
	getDeclIdent (TypeDeclaration td) = Just (tydeclIdent td)
	getDeclIdent _ = Nothing
	localBinderNames = map LocalIdent . binderNames

[nwolverson]

The issue is that currently

purescript/src/Language/PureScript/Make.hs

Line 114 in 5589e81

regrouped <- createBindingGroups moduleName . collapseBindingGroups $ deguarded

which creates the binding groups in these let blocks runs after the linter at the moment (which is mostly running pre-desugar, I guess).