Commit 10ffbfd2 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Fix Trac #5192: missing case in hsValBindsImplicits

This fixes the bug, adds some comments, and a tiny bit of refactoring
parent 7f021f25
......@@ -69,23 +69,23 @@ data HsLocalBindsLR idL idR -- Bindings in a 'let' expression
type HsValBinds id = HsValBindsLR id id
data HsValBindsLR idL idR -- Value bindings (not implicit parameters)
= ValBindsIn -- Before renaming
= ValBindsIn -- Before renaming RHS; idR is always RdrName
(LHsBindsLR idL idR) [LSig idR] -- Not dependency analysed
-- Recursive by default
| ValBindsOut -- After renaming
| ValBindsOut -- After renaming RHS; idR can be Name or Id
[(RecFlag, LHsBinds idL)] -- Dependency analysed, later bindings
-- in the list may depend on earlier
-- ones.
[LSig Name]
deriving (Data, Typeable)
type LHsBinds id = Bag (LHsBind id)
type LHsBind id = Located (HsBind id)
type HsBind id = HsBindLR id id
type LHsBind id = LHsBindLR id id
type LHsBinds id = LHsBindsLR id id
type HsBind id = HsBindLR id id
type LHsBindLR idL idR = Located (HsBindLR idL idR)
type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
type LHsBindLR idL idR = Located (HsBindLR idL idR)
data HsBindLR idL idR
= -- | FunBind is used for both functions @f x = e@
......
......@@ -84,7 +84,6 @@ import NameSet
import BasicTypes
import SrcLoc
import FastString
import Outputable
import Util
import Bag
......@@ -665,11 +664,15 @@ lStmtsImplicits = hs_lstmts
hsValBindsImplicits :: HsValBindsLR Name idR -> NameSet
hsValBindsImplicits (ValBindsOut binds _)
= unionManyNameSets [foldBag unionNameSets (hs_bind . unLoc) emptyNameSet hs_binds | (_rec, hs_binds) <- binds]
= foldr (unionNameSets . lhsBindsImplicits . snd) emptyNameSet binds
hsValBindsImplicits (ValBindsIn binds _)
= lhsBindsImplicits binds
lhsBindsImplicits :: LHsBindsLR Name idR -> NameSet
lhsBindsImplicits = foldBag unionNameSets lhs_bind emptyNameSet
where
hs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
hs_bind _ = emptyNameSet
hsValBindsImplicits (ValBindsIn {}) = pprPanic "hsValBindsImplicits: ValBindsIn" empty
lhs_bind (L _ (PatBind { pat_lhs = lpat })) = lPatImplicits lpat
lhs_bind _ = emptyNameSet
lPatImplicits :: LPat Name -> NameSet
lPatImplicits = hs_lpat
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment