X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsSyn.lhs;h=96379a5e2835f292f605a9cb9d8fbaba7c4ea739;hb=626b9cd2cca1b05e94d8937ccf176d3e74562f87;hp=7255d1b7f681a08d2ec596d57b9293eee9bb0e6f;hpb=550421384b8364cdaf3135f7859c9f7d7ee1fff1;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index 7255d1b..96379a5 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -19,11 +19,7 @@ module HsSyn ( module HsUtils, Fixity, NewOrData, - HsModule(..), HsExtCore(..), - collectStmtsBinders, collectStmtBinders, collectLStmtBinders, - collectGroupBinders, collectHsBindLocatedBinders, - collectHsBindBinders, - collectSigTysFromHsBind, collectSigTysFromHsBinds + HsModule(..), HsExtCore(..) ) where #include "HsVersions.h" @@ -101,94 +97,3 @@ instance (OutputableBndr name) pp_nonnull [] = empty pp_nonnull xs = vcat (map ppr xs) \end{code} - - -%************************************************************************ -%* * -\subsection{Collecting binders from @HsBinds@} -%* * -%************************************************************************ - -Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE. - -These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds. - -\begin{verbatim} -... -where - (x, y) = ... - f i j = ... - [a, b] = ... -\end{verbatim} -it should return @[x, y, f, a, b]@ (remember, order important). - -\begin{code} -collectGroupBinders :: [HsBindGroup name] -> [Located name] -collectGroupBinders groups = foldr collect_group [] groups - where - collect_group (HsBindGroup bag sigs is_rec) acc - = foldrBag (collectAcc . unLoc) acc bag - collect_group (HsIPBinds _) acc = acc - - -collectAcc :: HsBind name -> [Located name] -> [Located name] -collectAcc (PatBind pat _) acc = collectLocatedPatBinders pat ++ acc -collectAcc (FunBind f _ _) acc = f : acc -collectAcc (VarBind f _) acc = noLoc f : acc -collectAcc (AbsBinds _ _ dbinds _ 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 :: Bag (LHsBind name) -> [name] -collectHsBindBinders binds = map unLoc (collectHsBindLocatedBinders binds) - -collectHsBindLocatedBinders :: Bag (LHsBind name) -> [Located name] -collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds -\end{code} - - -%************************************************************************ -%* * -\subsection{Getting patterns out of bindings} -%* * -%************************************************************************ - -Get all the pattern type signatures out of a bunch of bindings - -\begin{code} -collectSigTysFromHsBinds :: [LHsBind name] -> [LHsType name] -collectSigTysFromHsBinds binds = concat (map collectSigTysFromHsBind binds) - -collectSigTysFromHsBind :: LHsBind name -> [LHsType name] -collectSigTysFromHsBind bind - = go (unLoc bind) - where - go (PatBind pat _) = collectSigTysFromPat pat - go (FunBind f _ ms) = go_matches (map unLoc ms) - - -- A binding like x :: a = f y - -- is parsed as FunMonoBind, but for this purpose we - -- want to treat it as a pattern binding - go_matches [] = [] - go_matches (Match [] (Just sig) _ : matches) = sig : go_matches matches - go_matches (match : matches) = go_matches matches -\end{code} - -\begin{code} -collectStmtsBinders :: [LStmt id] -> [Located id] -collectStmtsBinders = concatMap collectLStmtBinders - -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) = collectGroupBinders binds -collectStmtBinders (ExprStmt _ _) = [] -collectStmtBinders (ResultStmt _) = [] -collectStmtBinders (RecStmt ss _ _ _) = collectStmtsBinders ss -collectStmtBinders other = panic "collectStmtBinders" -\end{code}