X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsSyn.lhs;h=ce748ebfab65cc788d317c240e6f87b9f336433e;hp=2169b1a3b6a7cee09b8c899f782a6294c239a528;hb=b2bd63f99d643f6b3eb30bb72bb9ae26d4183252;hpb=108361d05dfb0aa37871c2c6a4ddec45a1b68010 diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs index 2169b1a..ce748eb 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(..), +) where -- friends: import HsDecls @@ -32,31 +34,48 @@ import HsImpExp import HsLit import HsPat import HsTypes -import BasicTypes ( Fixity, DeprecTxt ) +import BasicTypes ( Fixity, WarningTxt ) import HsUtils +import HsDoc -- others: import IfaceSyn ( IfaceBinding ) import Outputable -import SrcLoc ( Located(..) ) +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} +-- | All we actually declare here is the top-level structure for a module. data HsModule name - = HsModule - (Maybe (Located ModuleName))-- 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 @@ -66,32 +85,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}