X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsUtils.lhs;fp=compiler%2FhsSyn%2FHsUtils.lhs;h=36054744704c1eb5a1b541d4b99cddc6f8b2bda8;hp=5e8dda3fcf2486d78ed60effcffe3868a6fe509d;hb=10ffbfd2624f37d6d61ecb4b8d42f1463cc1d476;hpb=7f021f25e4c1b8546e346501ae34f1126755b739 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