X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsSyn.lhs;h=507eab60db13cd4c806d6c1d609b3ceccfe9c12d;hb=85b8e2b98ed047786a3264499db70bf298b4d52e;hp=0efa1e32c89a7c94590ba960b1212c6c27ba4c6d;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs index 0efa1e3..507eab6 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} @@ -17,12 +18,14 @@ module HsSyn ( module HsPat, module HsTypes, module HsUtils, + module HsDoc, Fixity, - HsModule(..), HsExtCore(..) - ) where + HsModule(..), HsExtCore(..), -#include "HsVersions.h" + HaddockModInfo(..), + emptyHaddockModInfo, +) where -- friends: import HsDecls @@ -32,15 +35,16 @@ import HsImpExp import HsLit import HsPat import HsTypes -import HscTypes ( DeprecTxt ) -import BasicTypes ( Fixity ) +import BasicTypes ( Fixity, DeprecTxt ) import HsUtils +import HsDoc -- others: import IfaceSyn ( IfaceBinding ) import Outputable import SrcLoc ( Located(..) ) import Module ( Module, ModuleName ) +import FastString \end{code} All we actually declare here is the top-level structure for a module. @@ -58,6 +62,23 @@ data HsModule name -- often empty, downstream. [LHsDecl name] -- Type, class, value, and interface signature decls (Maybe DeprecTxt) -- reason/explanation for deprecation of this module + (HaddockModInfo name) -- Haddock module info + (Maybe (HsDoc name)) -- Haddock module description + +data HaddockModInfo name = HaddockModInfo { + hmi_description :: Maybe (HsDoc name), + hmi_portability :: Maybe String, + hmi_stability :: Maybe String, + hmi_maintainer :: Maybe String +} + +emptyHaddockModInfo :: HaddockModInfo a +emptyHaddockModInfo = HaddockModInfo { + hmi_description = Nothing, + hmi_portability = Nothing, + hmi_stability = Nothing, + hmi_maintainer = Nothing +} 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}