X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsSyn.lhs;h=96379a5e2835f292f605a9cb9d8fbaba7c4ea739;hb=626b9cd2cca1b05e94d8937ccf176d3e74562f87;hp=08537bc48dd2f0ec7aa3c51eb05940819cdc5a65;hpb=26741ec416bae2c502ef00a2ba0e79050a32cb67;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsSyn.lhs b/ghc/compiler/hsSyn/HsSyn.lhs index 08537bc..96379a5 100644 --- a/ghc/compiler/hsSyn/HsSyn.lhs +++ b/ghc/compiler/hsSyn/HsSyn.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section{Haskell abstract syntax definition} @@ -8,182 +8,92 @@ which is declared in the various \tr{Hs*} modules. This module, therefore, is almost nothing but re-exporting. \begin{code} -#include "HsVersions.h" - module HsSyn ( + module HsBinds, + module HsDecls, + module HsExpr, + module HsImpExp, + module HsLit, + module HsPat, + module HsTypes, + module HsUtils, + Fixity, NewOrData, - -- NB: don't reexport HsCore or HsPragmas; - -- this module tells about "real Haskell" - - EXP_MODULE(HsSyn) , -#if (! defined(REALLY_HASKELL_1_3)) || PATRICK_FIXES_MODULE_DOTDOT_THING - EXP_MODULE(HsBinds) , - EXP_MODULE(HsDecls) , - EXP_MODULE(HsExpr) , - EXP_MODULE(HsImpExp) , - EXP_MODULE(HsLit) , - EXP_MODULE(HsMatches) , - EXP_MODULE(HsPat) , - EXP_MODULE(HsTypes) -#else - ArithSeqInfo(..), - BangType(..), - Bind(..), - ClassDecl(..), - ConDecl(..), - DefaultDecl(..), - FixityDecl(..), - GRHS(..), - GRHSsAndBinds(..), - HsBinds(..), - HsExpr(..), - HsLit(..), - IE(..), - ImportDecl(..), - InPat(..), - InstDecl(..), - Match(..), - MonoBinds(..), - MonoType(..), - OutPat(..), - PolyType(..), - Qualifier(..), - Sig(..), - SpecDataSig(..), - SpecInstSig(..), - Stmt(..), - TyDecl(..), - bindIsRecursive, - cmpContext, - cmpMonoType, - cmpPolyType, - collectBinders, - collectMonoBinders, - collectMonoBindersAndLocs, - collectPatBinders, - collectTopLevelBinders, - extractCtxtTyNames, - extractMonoTyNames, - failureFreePat, - irrefutablePat, - irrefutablePats, - isConPat, - isLitPat, - negLiteral, - nullBind, - nullBinds, - nullMonoBinds, - patsAreAllCons, - patsAreAllLits, - pp_condecls, - pp_decl_head, - pp_dotdot, - pp_rbinds, - pp_tydecl, - pprContext, - pprExpr, - pprGRHS, - pprGRHSsAndBinds, - pprMatch, - pprMatches, - pprParendExpr, - pprParendMonoType, - pprParendPolyType, - ppr_bang, - print_it, - SYN_IE(ClassAssertion), - SYN_IE(Context), - SYN_IE(HsRecordBinds) -#endif + HsModule(..), HsExtCore(..) ) where -IMP_Ubiq() +#include "HsVersions.h" -- friends: +import HsDecls import HsBinds -import HsDecls import HsExpr import HsImpExp import HsLit -import HsMatches import HsPat import HsTypes -import HsPragmas ( ClassPragmas, ClassOpPragmas, - DataPragmas, GenPragmas, InstancePragmas ) --- others: -import FiniteMap ( FiniteMap ) -import Outputable ( ifPprShowAll, ifnotPprForUser, interpp'SP, Outputable(..) ) -import Pretty -import SrcLoc ( SrcLoc ) -\end{code} +import HscTypes ( DeprecTxt ) +import BasicTypes ( Fixity, NewOrData ) +import HsUtils -@Fake@ is a placeholder type; for when tyvars and uvars aren't used. -\begin{code} -data Fake = Fake -instance Eq Fake -instance Outputable Fake +-- others: +import IfaceSyn ( IfaceBinding ) +import Outputable +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} -type Version = Int - -data HsModule tyvar uvar name pat +data HsModule name = HsModule - Module -- module name - (Maybe Version) -- source interface version number - (Maybe [IE name]) -- export list; Nothing => export everything - -- Just [] => export *nothing* (???) + (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... - [ImportDecl name] -- We snaffle interesting stuff out of the + [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. - [FixityDecl name] - [TyDecl name] - [SpecDataSig name] -- user pragmas that modify TyDecls - [ClassDecl tyvar uvar name pat] - [InstDecl tyvar uvar name pat] - [SpecInstSig name] -- user pragmas that modify InstDecls - [DefaultDecl name] - (HsBinds tyvar uvar name pat) -- the main stuff, includes source sigs - [Sig name] -- interface sigs - SrcLoc + [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 (NamedThing name, Outputable name, Outputable pat, - Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) - => Outputable (HsModule tyvar uvar name pat) where +instance (OutputableBndr name) + => Outputable (HsModule name) where + + ppr (HsModule Nothing _ imports decls _) + = pp_nonnull imports $$ pp_nonnull decls - ppr sty (HsModule name iface_version exports imports fixities - typedecls typesigs classdecls instdecls instsigs - defdecls binds sigs src_loc) - = ppAboves [ - ifPprShowAll sty (ppr sty src_loc), - ifnotPprForUser sty (pp_iface_version iface_version), + ppr (HsModule (Just name) exports imports decls deprec) + = vcat [ case exports of - Nothing -> ppCat [ppPStr SLIT("module"), ppPStr name, ppPStr SLIT("where")] - Just es -> ppAboves [ - ppCat [ppPStr SLIT("module"), ppPStr name, ppLparen], - ppNest 8 (interpp'SP sty es), - ppNest 4 (ppPStr SLIT(") where")) + 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_nonnull imports, - pp_nonnull fixities, - pp_nonnull typedecls, - pp_nonnull typesigs, - pp_nonnull classdecls, - pp_nonnull instdecls, - pp_nonnull instsigs, - pp_nonnull defdecls, - ppr sty binds, - pp_nonnull sigs + pp_nonnull decls ] where - pp_nonnull [] = ppNil - pp_nonnull xs = ppAboves (map (ppr sty) xs) + pp_header rest = case deprec of + Nothing -> pp_modname <+> rest + Just d -> vcat [ pp_modname, ppr d, rest ] + + pp_modname = ptext SLIT("module") <+> ppr name - pp_iface_version Nothing = ppNil - pp_iface_version (Just n) = ppCat [ppStr "{-# INTERFACE", ppInt n, ppStr "#-}"] +pp_nonnull [] = empty +pp_nonnull xs = vcat (map ppr xs) \end{code}