X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsSyn.lhs;h=96379a5e2835f292f605a9cb9d8fbaba7c4ea739;hb=626b9cd2cca1b05e94d8937ccf176d3e74562f87;hp=6347228f6dd309b21ce9d95246075bbfcc0b1972;hpb=6cce4a58fb206f16db579fded00fd0a7090543ae;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index 6347228..96379a5 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -9,22 +9,17 @@ therefore, is almost nothing but re-exporting. \begin{code} module HsSyn ( - - -- NB: don't reexport HsCore or HsPragmas; - -- this module tells about "real Haskell" - - module HsSyn, module HsBinds, module HsDecls, module HsExpr, module HsImpExp, - module HsBasic, - module HsMatches, + module HsLit, module HsPat, module HsTypes, + module HsUtils, Fixity, NewOrData, - collectTopBinders, collectMonoBinders + HsModule(..), HsExtCore(..) ) where #include "HsVersions.h" @@ -34,51 +29,60 @@ import HsDecls import HsBinds import HsExpr import HsImpExp -import HsBasic -import HsMatches +import HsLit import HsPat import HsTypes -import HsCore -import BasicTypes ( Fixity, Version, NewOrData ) +import HscTypes ( DeprecTxt ) +import BasicTypes ( Fixity, NewOrData ) +import HsUtils -- others: +import IfaceSyn ( IfaceBinding ) import Outputable -import SrcLoc ( SrcLoc ) -import Bag -import Module ( ModuleName, pprModuleName ) +import SrcLoc ( Located(..), unLoc, noLoc ) +import Module ( Module ) +import Bag ( Bag, foldrBag ) \end{code} All we actually declare here is the top-level structure for a module. \begin{code} -data HsModule name pat +data HsModule name = HsModule - ModuleName -- module name - (Maybe Version) -- source interface version number - (Maybe [IE name]) -- export list; Nothing => 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 - -- info to TyDecls/etc; so this list is - -- often empty, downstream. - [HsDecl name pat] -- Type, class, value, and interface signature decls - (Maybe (Deprecation name)) -- reason/explanation for deprecation of this module - SrcLoc + (Maybe (Located Module))-- Nothing => "module X where" is omitted + -- (in which case the next field is Nothing too) + (Maybe [LIE name]) -- Export list; Nothing => export list omitted, so export everything + -- Just [] => export *nothing* + -- Just [...] => as you would expect... + [LImportDecl name] -- We snaffle interesting stuff out of the + -- imported interfaces early on, adding that + -- info to TyDecls/etc; so this list is + -- often empty, downstream. + [LHsDecl name] -- Type, class, value, and interface signature decls + (Maybe DeprecTxt) -- reason/explanation for deprecation of this module + +data HsExtCore name -- Read from Foo.hcr + = HsExtCore + Module + [TyClDecl name] -- Type declarations only; just as in Haskell source, + -- so that we can infer kinds etc + [IfaceBinding] -- And the bindings \end{code} \begin{code} -instance (Outputable name, Outputable pat) - => Outputable (HsModule name pat) where +instance (OutputableBndr name) + => Outputable (HsModule name) where - ppr (HsModule name iface_version exports imports - decls deprec src_loc) + ppr (HsModule Nothing _ imports decls _) + = pp_nonnull imports $$ pp_nonnull decls + + ppr (HsModule (Just name) exports imports decls deprec) = vcat [ case exports of Nothing -> pp_header (ptext SLIT("where")) Just es -> vcat [ - pp_header lparen, - nest 8 (fsep (punctuate comma (map ppr es))), - nest 4 (ptext SLIT(") where")) + pp_header lparen, + nest 8 (fsep (punctuate comma (map ppr es))), + nest 4 (ptext SLIT(") where")) ], pp_nonnull imports, pp_nonnull decls @@ -88,49 +92,8 @@ instance (Outputable name, Outputable pat) Nothing -> pp_modname <+> rest Just d -> vcat [ pp_modname, ppr d, rest ] - pp_modname = ptext SLIT("module") <+> pprModuleName name - - pp_nonnull [] = empty - pp_nonnull xs = vcat (map ppr xs) - - pp_iface_version Nothing = empty - pp_iface_version (Just n) = hsep [text "{-# INTERFACE", int n, text "#-}"] -\end{code} - + pp_modname = ptext SLIT("module") <+> ppr name -%************************************************************************ -%* * -\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} -collectTopBinders :: HsBinds name (InPat name) -> Bag (name,SrcLoc) -collectTopBinders EmptyBinds = emptyBag -collectTopBinders (MonoBind b _ _) = collectMonoBinders b -collectTopBinders (ThenBinds b1 b2) - = collectTopBinders b1 `unionBags` collectTopBinders b2 - -collectMonoBinders :: MonoBinds name (InPat name) -> Bag (name,SrcLoc) -collectMonoBinders EmptyMonoBinds = emptyBag -collectMonoBinders (PatMonoBind pat _ loc) = listToBag (map (\v->(v,loc)) (collectPatBinders pat)) -collectMonoBinders (FunMonoBind f _ matches loc) = unitBag (f,loc) -collectMonoBinders (VarMonoBind v expr) = error "collectMonoBinders" -collectMonoBinders (CoreMonoBind v expr) = error "collectMonoBinders" -collectMonoBinders (AndMonoBinds bs1 bs2) = collectMonoBinders bs1 `unionBags` - collectMonoBinders bs2 +pp_nonnull [] = empty +pp_nonnull xs = vcat (map ppr xs) \end{code} -