Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
342f4742
Commit
342f4742
authored
Apr 07, 2011
by
Ian Lynagh
Browse files
Merge remote branch 'origin/patch-4404'
parents
ae9ef751
41dc5190
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/hsSyn/HsUtils.lhs
View file @
342f4742
...
...
@@ -61,7 +61,10 @@ module HsUtils(
collectSigTysFromPats, collectSigTysFromPat,
hsTyClDeclBinders, hsTyClDeclsBinders,
hsForeignDeclsBinders, hsGroupBinders
hsForeignDeclsBinders, hsGroupBinders,
-- Collecting implicit binders
lStmtsImplicits, hsValBindsImplicits, lPatImplicits
) where
import HsDecls
...
...
@@ -81,8 +84,11 @@ import NameSet
import BasicTypes
import SrcLoc
import FastString
import Outputable
import Util
import Bag
import Data.Either
\end{code}
...
...
@@ -615,6 +621,81 @@ hsConDeclsBinders cons
\end{code}
%************************************************************************
%* *
Collecting binders the user did not write
%* *
%************************************************************************
The job of this family of functions is to run through binding sites and find the set of all Names
that were defined "implicitly", without being explicitly written by the user.
The main purpose is to find names introduced by record wildcards so that we can avoid
warning the user when they don't use those names (#4404)
\begin{code}
lStmtsImplicits :: [LStmtLR Name idR] -> NameSet
lStmtsImplicits = hs_lstmts
where
hs_lstmts :: [LStmtLR Name idR] -> NameSet
hs_lstmts = foldr (\stmt rest -> unionNameSets (hs_stmt (unLoc stmt)) rest) emptyNameSet
hs_stmt (BindStmt pat _ _ _) = lPatImplicits pat
hs_stmt (LetStmt binds) = hs_local_binds binds
hs_stmt (ExprStmt _ _ _) = emptyNameSet
hs_stmt (ParStmt xs) = hs_lstmts $ concatMap fst xs
hs_stmt (TransformStmt stmts _ _ _) = hs_lstmts stmts
hs_stmt (GroupStmt stmts _ _ _) = hs_lstmts stmts
hs_stmt (RecStmt { recS_stmts = ss }) = hs_lstmts ss
hs_local_binds (HsValBinds val_binds) = hsValBindsImplicits val_binds
hs_local_binds (HsIPBinds _) = emptyNameSet
hs_local_binds EmptyLocalBinds = emptyNameSet
hsValBindsImplicits :: HsValBindsLR Name idR -> NameSet
hsValBindsImplicits (ValBindsOut binds _)
= unionManyNameSets [foldBag unionNameSets (hs_bind . unLoc) emptyNameSet hs_binds | (_rec, hs_binds) <- binds]
where
hs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
hs_bind _ = emptyNameSet
hsValBindsImplicits (ValBindsIn {}) = pprPanic "hsValBindsImplicits: ValBindsIn" empty
lPatImplicits :: LPat Name -> NameSet
lPatImplicits = hs_lpat
where
hs_lpat (L _ pat) = hs_pat pat
hs_lpats = foldr (\pat rest -> hs_lpat pat `unionNameSets` rest) emptyNameSet
hs_pat (LazyPat pat) = hs_lpat pat
hs_pat (BangPat pat) = hs_lpat pat
hs_pat (AsPat _ pat) = hs_lpat pat
hs_pat (ViewPat _ pat _) = hs_lpat pat
hs_pat (ParPat pat) = hs_lpat pat
hs_pat (ListPat pats _) = hs_lpats pats
hs_pat (PArrPat pats _) = hs_lpats pats
hs_pat (TuplePat pats _ _) = hs_lpats pats
hs_pat (SigPatIn pat _) = hs_lpat pat
hs_pat (SigPatOut pat _) = hs_lpat pat
hs_pat (CoPat _ pat _) = hs_pat pat
hs_pat (ConPatIn _ ps) = details ps
hs_pat (ConPatOut {pat_args=ps}) = details ps
hs_pat _ = emptyNameSet
details (PrefixCon ps) = hs_lpats ps
details (RecCon fs) = hs_lpats explicit `unionNameSets` mkNameSet (collectPatsBinders implicit)
where (explicit, implicit) = partitionEithers [if pat_explicit then Left pat else Right pat
| (i, fld) <- [0..] `zip` rec_flds fs
, let pat = hsRecFieldArg fld
pat_explicit = maybe True (i<) (rec_dotdot fs)]
details (InfixCon p1 p2) = hs_lpat p1 `unionNameSets` hs_lpat p2
\end{code}
%************************************************************************
%* *
Collecting type signatures from patterns
...
...
compiler/rename/RnBinds.lhs
View file @
342f4742
...
...
@@ -357,7 +357,9 @@ rnLocalValBindsAndThen binds@(ValBindsIn _ sigs) thing_inside
-- let x = x in 3
-- should report 'x' unused
; let real_uses = findUses dus result_fvs
; warnUnusedLocalBinds bound_names real_uses
-- Insert fake uses for variables introduced implicitly by wildcards (#4404)
implicit_uses = hsValBindsImplicits binds'
; warnUnusedLocalBinds bound_names (real_uses `unionNameSets` implicit_uses)
; let
-- The variables "used" in the val binds are:
...
...
compiler/rename/RnExpr.lhs
View file @
342f4742
...
...
@@ -874,13 +874,15 @@ rnRecStmtsAndThen s cont
-- ...bring them and their fixities into scope
; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv)
-- Fake uses of variables introduced implicitly (warning suppression, see #4404)
implicit_uses = lStmtsImplicits (map fst new_lhs_and_fv)
; bindLocalNamesFV bound_names $
addLocalFixities fix_env bound_names $ do
-- (C) do the right-hand-sides and thing-inside
{ segs <- rn_rec_stmts bound_names new_lhs_and_fv
; (res, fvs) <- cont segs
; warnUnusedLocalBinds bound_names fvs
; warnUnusedLocalBinds bound_names
(
fvs
`unionNameSets` implicit_uses)
; return (res, fvs) }}
-- get all the fixity decls in any Let stmt
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment