X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsSyn.lhs;h=887bc699c105c6f8cd1bb61915210cdb2bd65cd9;hb=d28ba8c800901bea01f70c4719278c2a364cf9fc;hp=290bc85756f82af1f166a8526c1f268492ecbc46;hpb=dbc254c3dcd64761015a3d1c191ac742caafbf4c;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index 290bc85..887bc69 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -9,11 +9,9 @@ therefore, is almost nothing but re-exporting. \begin{code} module HsSyn ( - -- NB: don't reexport HsCore -- this module tells about "real Haskell" - module HsSyn, module HsBinds, module HsDecls, module HsExpr, @@ -23,10 +21,11 @@ module HsSyn ( module HsTypes, Fixity, NewOrData, + HsModule(..), + collectStmtsBinders, collectHsBinders, collectLocatedHsBinders, collectMonoBinders, collectLocatedMonoBinders, - collectSigTysFromHsBinds, collectSigTysFromMonoBinds, - hsModule, hsImports + collectSigTysFromHsBinds, collectSigTysFromMonoBinds ) where #include "HsVersions.h" @@ -52,10 +51,10 @@ All we actually declare here is the top-level structure for a module. \begin{code} data HsModule name = HsModule - Module - (Maybe Version) -- source interface version number - (Maybe [IE name]) -- export list; Nothing => export everything - -- Just [] => export *nothing* (???) + (Maybe Module) -- Nothing => "module X where" is omitted + -- (in which case the next field is Nothing too) + (Maybe [IE name]) -- Export list; Nothing => export list omitted, so export everything + -- Just [] => export *nothing* -- Just [...] => as you would expect... [ImportDecl name] -- We snaffle interesting stuff out of the -- imported interfaces early on, adding that @@ -70,8 +69,10 @@ data HsModule name instance (NamedThing name, OutputableBndr name) => Outputable (HsModule name) where - ppr (HsModule name iface_version exports imports - decls deprec src_loc) + ppr (HsModule Nothing _ imports decls _ src_loc) + = pp_nonnull imports $$ pp_nonnull decls + + ppr (HsModule (Just name) exports imports decls deprec src_loc) = vcat [ case exports of Nothing -> pp_header (ptext SLIT("where")) @@ -90,11 +91,8 @@ instance (NamedThing name, OutputableBndr name) pp_modname = ptext SLIT("module") <+> ppr name - pp_nonnull [] = empty - pp_nonnull xs = vcat (map ppr xs) - -hsModule (HsModule mod _ _ _ _ _ _) = mod -hsImports (HsModule mod vers exports imports decls deprec src_loc) = imports +pp_nonnull [] = empty +pp_nonnull xs = vcat (map ppr xs) \end{code} @@ -119,6 +117,7 @@ it should return @[x, y, f, a, b]@ (remember, order important). \begin{code} collectLocatedHsBinders :: HsBinds name -> [(name,SrcLoc)] +-- Used at top level only; so no need for an IPBinds case collectLocatedHsBinders EmptyBinds = [] collectLocatedHsBinders (MonoBind b _ _) = collectLocatedMonoBinders b @@ -126,11 +125,11 @@ collectLocatedHsBinders (ThenBinds b1 b2) = collectLocatedHsBinders b1 ++ collectLocatedHsBinders b2 collectHsBinders :: HsBinds name -> [name] -collectHsBinders EmptyBinds = [] -collectHsBinders (MonoBind b _ _) - = collectMonoBinders b -collectHsBinders (ThenBinds b1 b2) - = collectHsBinders b1 ++ collectHsBinders b2 +collectHsBinders EmptyBinds = [] +collectHsBinders (IPBinds _ _) = [] -- Implicit parameters don't create + -- ordinary bindings +collectHsBinders (MonoBind b _ _) = collectMonoBinders b +collectHsBinders (ThenBinds b1 b2) = collectHsBinders b1 ++ collectHsBinders b2 collectLocatedMonoBinders :: MonoBinds name -> [(name,SrcLoc)] collectLocatedMonoBinders binds @@ -151,11 +150,19 @@ collectMonoBinders binds go (AndMonoBinds bs1 bs2) acc = go bs1 (go bs2 acc) \end{code} + +%************************************************************************ +%* * +\subsection{Getting patterns out of bindings} +%* * +%************************************************************************ + Get all the pattern type signatures out of a bunch of bindings \begin{code} collectSigTysFromHsBinds :: HsBinds name -> [HsType name] collectSigTysFromHsBinds EmptyBinds = [] +collectSigTysFromHsBinds (IPBinds _ _) = [] collectSigTysFromHsBinds (MonoBind b _ _) = collectSigTysFromMonoBinds b collectSigTysFromHsBinds (ThenBinds b1 b2) = collectSigTysFromHsBinds b1 ++ collectSigTysFromHsBinds b2