X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsUtils.lhs;h=e16a0bde838a8adad6b0db3b23963a2e3f3cf729;hb=ead3abe7fbf33f019549a05ad9dd3cd22ef3adab;hp=9bd34482adcb60c285e3ea4684da87f4dd97c592;hpb=90dc9026b091be5cca5da4c6cbd3713ecc493361;p=ghc-hetmet.git diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs index 9bd3448..e16a0bd 100644 --- a/compiler/hsSyn/HsUtils.lhs +++ b/compiler/hsSyn/HsUtils.lhs @@ -22,7 +22,6 @@ import HsExpr import HsPat import HsTypes import HsLit -import HsDecls import RdrName import Var @@ -320,22 +319,24 @@ collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds %************************************************************************ \begin{code} -collectLStmtsBinders :: [LStmt id] -> [Located id] +collectLStmtsBinders :: OutputableBndr id => [LStmt id] -> [Located id] collectLStmtsBinders = concatMap collectLStmtBinders -collectStmtsBinders :: [Stmt id] -> [Located id] +collectStmtsBinders :: OutputableBndr id => [Stmt id] -> [Located id] collectStmtsBinders = concatMap collectStmtBinders -collectLStmtBinders :: LStmt id -> [Located id] +collectLStmtBinders :: OutputableBndr id => LStmt id -> [Located id] collectLStmtBinders = collectStmtBinders . unLoc -collectStmtBinders :: Stmt id -> [Located id] +collectStmtBinders :: OutputableBndr id => Stmt id -> [Located id] -- Id Binders for a Stmt... [but what about pattern-sig type vars]? collectStmtBinders (BindStmt pat _ _ _) = collectLocatedPatBinders pat collectStmtBinders (LetStmt binds) = collectLocalBinders binds -collectStmtBinders (ExprStmt _ _ _) = [] -collectStmtBinders (RecStmt ss _ _ _ _) = collectLStmtsBinders ss -collectStmtBinders other = panic "collectStmtBinders" +collectStmtBinders (ExprStmt _ _ _) = [] +collectStmtBinders (ParStmt xs) = collectLStmtsBinders + $ concatMap fst xs +collectStmtBinders (RecStmt ss _ _ _ _) = collectLStmtsBinders ss +collectStmtBinders s = pprPanic "collectStmtBinders" (ppr s) \end{code} @@ -382,8 +383,8 @@ collectl (L l pat) bndrs go (PArrPat pats _) = foldr collectl bndrs pats go (TuplePat pats _ _) = foldr collectl bndrs pats - go (ConPatIn c ps) = foldr collectl bndrs (hsConArgs ps) - go (ConPatOut {pat_args=ps}) = foldr collectl bndrs (hsConArgs ps) + go (ConPatIn c ps) = foldr collectl bndrs (hsConPatArgs ps) + go (ConPatOut {pat_args=ps}) = foldr collectl bndrs (hsConPatArgs ps) -- See Note [Dictionary binders in ConPatOut] go (LitPat _) = bndrs go (NPat _ _ _ _) = bndrs @@ -392,8 +393,6 @@ collectl (L l pat) bndrs go (SigPatIn pat _) = collectl pat bndrs go (SigPatOut pat _) = collectl pat bndrs go (TypePat ty) = bndrs - go (DictPat ids1 ids2) = map noLoc ids1 ++ map noLoc ids2 - ++ bndrs go (CoPat _ pat ty) = collectl (noLoc pat) bndrs \end{code} @@ -426,6 +425,6 @@ collect_pat (ParPat pat) acc = collect_lpat pat acc collect_pat (ListPat pats _) acc = foldr collect_lpat acc pats collect_pat (PArrPat pats _) acc = foldr collect_lpat acc pats collect_pat (TuplePat pats _ _) acc = foldr collect_lpat acc pats -collect_pat (ConPatIn c ps) acc = foldr collect_lpat acc (hsConArgs ps) +collect_pat (ConPatIn c ps) acc = foldr collect_lpat acc (hsConPatArgs ps) collect_pat other acc = acc -- Literals, vars, wildcard \end{code}