X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsSyn.lhs;h=887bc699c105c6f8cd1bb61915210cdb2bd65cd9;hb=d28ba8c800901bea01f70c4719278c2a364cf9fc;hp=708a82fb487f837f90c6b4285de67d9233961f3b;hpb=8c1b6bd7ffb9ce97da7a72f9e102998df19b23a2;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index 708a82f..887bc69 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -21,7 +21,7 @@ module HsSyn ( module HsTypes, Fixity, NewOrData, - HsModule(..), hsModule, hsImports, + HsModule(..), collectStmtsBinders, collectHsBinders, collectLocatedHsBinders, collectMonoBinders, collectLocatedMonoBinders, @@ -51,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 @@ -69,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")) @@ -89,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} @@ -118,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 @@ -125,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 @@ -162,6 +162,7 @@ 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