X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsSyn.lhs;h=be7e0036df4bf920fb9af56a83d612378b03594d;hp=a9982a630a7437863dd3bf28e4645fc6b7bf1ee8;hb=e5c3b478b3cd1707cf122833822f44b2ac09b8e9;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1 diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs index a9982a6..be7e003 100644 --- a/compiler/hsSyn/HsSyn.lhs +++ b/compiler/hsSyn/HsSyn.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section{Haskell abstract syntax definition} @@ -8,6 +9,8 @@ which is declared in the various \tr{Hs*} modules. This module, therefore, is almost nothing but re-exporting. \begin{code} +{-# LANGUAGE DeriveDataTypeable #-} + module HsSyn ( module HsBinds, module HsDecls, @@ -17,12 +20,11 @@ module HsSyn ( module HsPat, module HsTypes, module HsUtils, + module HsDoc, Fixity, - HsModule(..), HsExtCore(..) - ) where - -#include "HsVersions.h" + HsModule(..), HsExtCore(..), CodeFlavor(..) +) where -- friends: import HsDecls @@ -32,32 +34,51 @@ import HsImpExp import HsLit import HsPat import HsTypes -import HscTypes ( DeprecTxt ) -import BasicTypes ( Fixity ) +import BasicTypes ( Fixity, WarningTxt ) import HsUtils +import HsDoc -- others: import IfaceSyn ( IfaceBinding ) import Outputable -import SrcLoc ( Located(..) ) -import Module ( Module ) +import SrcLoc +import Module ( Module, ModuleName ) +import FastString + +-- libraries: +import Data.Data hiding ( Fixity ) \end{code} -All we actually declare here is the top-level structure for a module. \begin{code} + +data CodeFlavor = LambdaFlavor | KappaFlavor + +-- | All we actually declare here is the top-level structure for a module. data HsModule name - = HsModule - (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 + = HsModule { + hsmodName :: Maybe (Located ModuleName), + -- ^ @Nothing@: \"module X where\" is omitted (in which case the next + -- field is Nothing too) + hsmodExports :: Maybe [LIE name], + -- ^ Export list + -- + -- - @Nothing@: export list omitted, so export everything + -- + -- - @Just []@: export /nothing/ + -- + -- - @Just [...]@: as you would expect... + -- + hsmodImports :: [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. + hsmodDecls :: [LHsDecl name], + -- ^ Type, class, value, and interface signature decls + hsmodDeprecMessage :: Maybe WarningTxt, + -- ^ reason\/explanation for warning/deprecation of this module + hsmodHaddockModHeader :: Maybe LHsDocString + -- ^ Haddock module info and description, unparsed + } deriving (Data, Typeable) data HsExtCore name -- Read from Foo.hcr = HsExtCore @@ -67,32 +88,42 @@ data HsExtCore name -- Read from Foo.hcr [IfaceBinding] -- And the bindings \end{code} + \begin{code} +instance Outputable Char where + ppr c = text [c] + instance (OutputableBndr name) => Outputable (HsModule name) where - ppr (HsModule Nothing _ imports decls _) - = pp_nonnull imports $$ pp_nonnull decls + ppr (HsModule Nothing _ imports decls _ mbDoc) + = pp_mb mbDoc $$ pp_nonnull imports $$ pp_nonnull decls - ppr (HsModule (Just name) exports imports decls deprec) + ppr (HsModule (Just name) exports imports decls deprec mbDoc) = vcat [ + pp_mb mbDoc, case exports of - Nothing -> pp_header (ptext 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")) + nest 4 (ptext (sLit ") where")) ], pp_nonnull imports, pp_nonnull decls - ] + ] where 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_modname = ptext (sLit "module") <+> ppr name + +pp_mb :: Outputable t => Maybe t -> SDoc +pp_mb (Just x) = ppr x +pp_mb Nothing = empty +pp_nonnull :: Outputable t => [t] -> SDoc pp_nonnull [] = empty pp_nonnull xs = vcat (map ppr xs) \end{code}