X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsImpExp.lhs;h=9465cd289d78a908e054cae41af0669dbf5390f4;hp=767be42d2966ba23b6209fc8e17f4c42d990b8db;hb=7bb3d1fc79521d591cd9f824893963141a7997b6;hpb=190f24892156953d73b55401d0467a6f1a88ce5d diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs index 767be42..9465cd2 100644 --- a/compiler/hsSyn/HsImpExp.lhs +++ b/compiler/hsSyn/HsImpExp.lhs @@ -1,12 +1,19 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % -\section[HsImpExp]{Abstract syntax: imports, exports, interfaces} + +HsImpExp: Abstract syntax: imports, exports, interfaces \begin{code} -module HsImpExp where +{-# OPTIONS -fno-warn-incomplete-patterns #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details -#include "HsVersions.h" +module HsImpExp where import Module ( ModuleName ) import HsDoc ( HsDoc ) @@ -14,7 +21,6 @@ import HsDoc ( HsDoc ) import Outputable import FastString import SrcLoc ( Located(..) ) -import Char ( isAlpha ) \end{code} %************************************************************************ @@ -27,37 +33,43 @@ One per \tr{import} declaration in a module. \begin{code} type LImportDecl name = Located (ImportDecl name) +-- | A single Haskell @import@ declaration. data ImportDecl name - = ImportDecl (Located ModuleName) -- module name - Bool -- True <=> {-# SOURCE #-} import - Bool -- True => qualified - (Maybe ModuleName) -- as Module - (Maybe (Bool, [LIE name])) -- (True => hiding, names) + = ImportDecl { + ideclName :: Located ModuleName, -- ^ Module name. + ideclPkgQual :: Maybe FastString, -- ^ Package qualifier. + ideclSource :: Bool, -- ^ True <=> {-# SOURCE #-} import + ideclQualified :: Bool, -- ^ True => qualified + ideclAs :: Maybe ModuleName, -- ^ as Module + ideclHiding :: Maybe (Bool, [LIE name]) -- ^ (True => hiding, names) + } \end{code} \begin{code} instance (Outputable name) => Outputable (ImportDecl name) where - ppr (ImportDecl mod from qual as spec) - = hang (hsep [ptext SLIT("import"), ppr_imp from, - pp_qual qual, ppr mod, pp_as as]) + ppr (ImportDecl mod pkg from qual as spec) + = hang (hsep [ptext (sLit "import"), ppr_imp from, + pp_qual qual, pp_pkg pkg, ppr mod, pp_as as]) 4 (pp_spec spec) where + pp_pkg Nothing = empty + pp_pkg (Just p) = doubleQuotes (ftext p) + pp_qual False = empty - pp_qual True = ptext SLIT("qualified") + pp_qual True = ptext (sLit "qualified") pp_as Nothing = empty - pp_as (Just a) = ptext SLIT("as ") <+> ppr a + pp_as (Just a) = ptext (sLit "as") <+> ppr a - ppr_imp True = ptext SLIT("{-# SOURCE #-}") + ppr_imp True = ptext (sLit "{-# SOURCE #-}") ppr_imp False = empty - pp_spec Nothing = empty - pp_spec (Just (False, spec)) - = parens (interpp'SP spec) - pp_spec (Just (True, spec)) - = ptext SLIT("hiding") <+> parens (interpp'SP spec) + pp_spec Nothing = empty + pp_spec (Just (False, ies)) = ppr_ies ies + pp_spec (Just (True, ies)) = ptext (sLit "hiding") <+> ppr_ies ies -ideclName (ImportDecl mod_nm _ _ _ _) = mod_nm + ppr_ies [] = ptext (sLit "()") + ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')' \end{code} %************************************************************************ @@ -69,15 +81,16 @@ ideclName (ImportDecl mod_nm _ _ _ _) = mod_nm \begin{code} type LIE name = Located (IE name) +-- | Imported or exported entity. data IE name = IEVar name - | IEThingAbs name -- Class/Type (can't tell) - | IEThingAll name -- Class/Type plus all methods/constructors - | IEThingWith name [name] -- Class/Type plus some methods/constructors - | IEModuleContents ModuleName -- (Export Only) - | IEGroup Int (HsDoc name) -- Doc section heading - | IEDoc (HsDoc name) -- Some documentation - | IEDocNamed String -- Reference to named doc + | IEThingAbs name -- ^ Class/Type (can't tell) + | IEThingAll name -- ^ Class/Type plus all methods/constructors + | IEThingWith name [name] -- ^ Class/Type plus some methods/constructors + | IEModuleContents ModuleName -- ^ (Export Only) + | IEGroup Int (HsDoc name) -- ^ Doc section heading + | IEDoc (HsDoc name) -- ^ Some documentation + | IEDocNamed String -- ^ Reference to named doc \end{code} \begin{code} @@ -106,31 +119,10 @@ instance (Outputable name) => Outputable (IE name) where ppr (IEThingWith thing withs) = ppr thing <> parens (fsep (punctuate comma (map pprHsVar withs))) ppr (IEModuleContents mod) - = ptext SLIT("module") <+> ppr mod - ppr (IEGroup n doc) = text ("") + = ptext (sLit "module") <+> ppr mod + ppr (IEGroup n _) = text ("") ppr (IEDoc doc) = ppr doc ppr (IEDocNamed string) = text ("") \end{code} -\begin{code} -pprHsVar :: Outputable name => name -> SDoc -pprHsVar v | isOperator ppr_v = parens ppr_v - | otherwise = ppr_v - where - ppr_v = ppr v - -isOperator :: SDoc -> Bool -isOperator ppr_v - = case showSDocUnqual ppr_v of - ('(':s) -> False -- (), (,) etc - ('[':s) -> False -- [] - ('$':c:s) -> not (isAlpha c) -- Don't treat $d as an operator - (':':c:s) -> not (isAlpha c) -- Don't treat :T as an operator - ('_':s) -> False -- Not an operator - (c:s) -> not (isAlpha c) -- Starts with non-alpha - other -> False - -- We use (showSDoc (ppr v)), rather than isSymOcc (getOccName v) simply so - -- that we don't need NamedThing in the context of all these functions. - -- Gruesome, but simple. -\end{code}