X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsUtils.lhs;fp=ghc%2Fcompiler%2FhsSyn%2FHsUtils.lhs;h=2e33d4e361d654d9f309153cea55bda2ab9f72fa;hb=70b59eb3397c68f10ce429c0ffcf5ed63d86d3d3;hp=8019f362828142d3fae23023da861850831cfdd0;hpb=e79d44f15f7dd7b034746b702bd734792ded7f93;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsUtils.lhs b/ghc/compiler/hsSyn/HsUtils.lhs index 8019f36..2e33d4e 100644 --- a/ghc/compiler/hsSyn/HsUtils.lhs +++ b/ghc/compiler/hsSyn/HsUtils.lhs @@ -221,18 +221,17 @@ nlHsFunTy a b = noLoc (HsFunTy a b) %************************************************************************ \begin{code} -mkVarBind :: SrcSpan -> name -> LHsExpr name -> LHsBind name -mkVarBind loc var rhs = mk_easy_FunBind loc var [] emptyLHsBinds rhs +mkVarBind :: SrcSpan -> RdrName -> LHsExpr RdrName -> LHsBind RdrName +mkVarBind loc var rhs = mk_easy_FunBind loc var [] rhs ------------ -mk_easy_FunBind :: SrcSpan -> name -> [LPat name] - -> LHsBinds name -> LHsExpr name - -> LHsBind name +mk_easy_FunBind :: SrcSpan -> RdrName -> [LPat RdrName] + -> LHsExpr RdrName -> LHsBind RdrName -mk_easy_FunBind loc fun pats binds expr +mk_easy_FunBind loc fun pats expr = L loc (FunBind (L loc fun) False{-not infix-} matches placeHolderNames) where - matches = mkMatchGroup [mk_easy_Match pats binds expr] + matches = mkMatchGroup [mkMatch pats expr emptyLocalBinds] ------------ mk_FunBind :: SrcSpan -> RdrName @@ -246,10 +245,6 @@ mk_FunBind loc fun pats_and_exprs matches = mkMatchGroup [mkMatch p e emptyLocalBinds | (p,e) <-pats_and_exprs] ------------ -mk_easy_Match pats binds expr - = mkMatch pats expr (HsValBinds (ValBindsIn binds [])) - ------------- mkMatch :: [LPat id] -> LHsExpr id -> HsLocalBinds id -> LMatch id mkMatch pats expr binds = noLoc (Match (map paren pats) Nothing @@ -285,7 +280,9 @@ collectLocalBinders EmptyLocalBinds = [] collectHsValBinders :: HsValBinds name -> [Located name] collectHsValBinders (ValBindsIn binds sigs) = collectHsBindLocatedBinders binds -collectHsValBinders (ValBindsOut binds) = panic "collectHsValBinders" +collectHsValBinders (ValBindsOut binds) = foldr collect_one [] binds + where + collect_one (_,binds) acc = foldrBag (collectAcc . unLoc) acc binds collectAcc :: HsBind name -> [Located name] -> [Located name] collectAcc (PatBind pat _ _ _) acc = collectLocatedPatBinders pat ++ acc