+
+%************************************************************************
+%* *
+ Collecting binders from HsBindGroups and HsBinds
+%* *
+%************************************************************************
+
+Get all the binders in some HsBindGroups, IN THE ORDER OF APPEARANCE. eg.
+
+...
+where
+ (x, y) = ...
+ f i j = ...
+ [a, b] = ...
+
+it should return [x, y, f, a, b] (remember, order important).
+
+\begin{code}
+collectLocalBinders :: HsLocalBinds name -> [Located name]
+collectLocalBinders (HsValBinds val_binds) = collectHsValBinders val_binds
+collectLocalBinders (HsIPBinds _) = []
+collectLocalBinders EmptyLocalBinds = []
+
+collectHsValBinders :: HsValBinds name -> [Located name]
+collectHsValBinders (ValBindsIn binds sigs) = collectHsBindLocatedBinders binds
+collectHsValBinders (ValBindsOut binds sigs) = foldr collect_one [] binds
+ where
+ collect_one (_,binds) acc = foldrBag (collectAcc . unLoc) acc binds
+
+collectAcc :: HsBind name -> [Located name] -> [Located name]
+collectAcc (PatBind { pat_lhs = p }) acc = collectLocatedPatBinders p ++ acc
+collectAcc (FunBind { fun_id = f }) acc = f : acc
+collectAcc (VarBind { var_id = f }) acc = noLoc f : acc
+collectAcc (AbsBinds { abs_exports = dbinds, abs_binds = binds }) acc
+ = [noLoc dp | (_,dp,_,_) <- dbinds] ++ acc
+ -- ++ foldr collectAcc acc binds
+ -- I don't think we want the binders from the nested binds
+ -- The only time we collect binders from a typechecked
+ -- binding (hence see AbsBinds) is in zonking in TcHsSyn
+
+collectHsBindBinders :: LHsBinds name -> [name]
+collectHsBindBinders binds = map unLoc (collectHsBindLocatedBinders binds)
+
+collectHsBindLocatedBinders :: LHsBinds name -> [Located name]
+collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
+\end{code}
+
+
+%************************************************************************
+%* *
+ Getting binders from statements
+%* *
+%************************************************************************
+
+\begin{code}
+collectLStmtsBinders :: [LStmt id] -> [Located id]
+collectLStmtsBinders = concatMap collectLStmtBinders
+
+collectStmtsBinders :: [Stmt id] -> [Located id]
+collectStmtsBinders = concatMap collectStmtBinders
+
+collectLStmtBinders :: LStmt id -> [Located id]
+collectLStmtBinders = collectStmtBinders . unLoc
+
+collectStmtBinders :: 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"
+\end{code}
+
+
+%************************************************************************
+%* *
+%* Gathering stuff out of patterns
+%* *
+%************************************************************************
+
+This function @collectPatBinders@ works with the ``collectBinders''
+functions for @HsBinds@, etc. The order in which the binders are
+collected is important; see @HsBinds.lhs@.
+
+It collects the bounds *value* variables in renamed patterns; type variables
+are *not* collected.
+
+\begin{code}
+collectPatBinders :: LPat a -> [a]
+collectPatBinders pat = map unLoc (collectLocatedPatBinders pat)
+
+collectLocatedPatBinders :: LPat a -> [Located a]
+collectLocatedPatBinders pat = collectl pat []
+
+collectPatsBinders :: [LPat a] -> [a]
+collectPatsBinders pats = map unLoc (collectLocatedPatsBinders pats)
+
+collectLocatedPatsBinders :: [LPat a] -> [Located a]
+collectLocatedPatsBinders pats = foldr collectl [] pats
+
+---------------------
+collectl (L l pat) bndrs
+ = go pat
+ where
+ go (VarPat var) = L l var : bndrs
+ go (VarPatOut var bs) = L l var : collectHsBindLocatedBinders bs
+ ++ bndrs
+ go (WildPat _) = bndrs
+ go (LazyPat pat) = collectl pat bndrs
+ go (BangPat pat) = collectl pat bndrs
+ go (AsPat a pat) = a : collectl pat bndrs
+ go (ParPat pat) = collectl pat bndrs
+
+ go (ListPat pats _) = foldr collectl bndrs pats
+ 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 c _ ds bs ps _) = map noLoc ds
+ ++ collectHsBindLocatedBinders bs
+ ++ foldr collectl bndrs (hsConArgs ps)
+ go (LitPat _) = bndrs
+ go (NPat _ _ _ _) = bndrs
+ go (NPlusKPat n _ _ _) = n : 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
+\end{code}
+
+\begin{code}
+collectSigTysFromPats :: [InPat name] -> [LHsType name]
+collectSigTysFromPats pats = foldr collect_lpat [] pats
+
+collectSigTysFromPat :: InPat name -> [LHsType name]
+collectSigTysFromPat pat = collect_lpat pat []
+
+collect_lpat pat acc = collect_pat (unLoc pat) acc
+
+collect_pat (SigPatIn pat ty) acc = collect_lpat pat (ty:acc)
+collect_pat (TypePat ty) acc = ty:acc
+
+collect_pat (LazyPat pat) acc = collect_lpat pat acc
+collect_pat (BangPat pat) acc = collect_lpat pat acc
+collect_pat (AsPat a pat) acc = collect_lpat pat acc
+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 other acc = acc -- Literals, vars, wildcard
+\end{code}