Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : master
http://hackage.haskell.org/trac/ghc/changeset/10ffbfd2624f37d6d61ecb4b8d42f1463cc1d476 >--------------------------------------------------------------- commit 10ffbfd2624f37d6d61ecb4b8d42f1463cc1d476 Author: Simon Peyton Jones <simo...@microsoft.com> Date: Thu May 12 11:01:34 2011 +0100 Fix Trac #5192: missing case in hsValBindsImplicits This fixes the bug, adds some comments, and a tiny bit of refactoring >--------------------------------------------------------------- compiler/hsSyn/HsBinds.lhs | 12 ++++++------ compiler/hsSyn/HsUtils.lhs | 13 ++++++++----- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs index 675afa2..0a86756 100644 --- a/compiler/hsSyn/HsBinds.lhs +++ b/compiler/hsSyn/HsBinds.lhs @@ -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@ diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 5e8dda3..3605474 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -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 _______________________________________________ Cvs-ghc mailing list Cvs-ghc@haskell.org http://www.haskell.org/mailman/listinfo/cvs-ghc
