X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsImpExp.lhs;h=e483914619369de1da630a0b3daddae08dcff8ab;hb=21a542ddc3d02e0d3a8be28e0aa00796970adb9e;hp=0305911e60ed4fe048c09a6e596147a6c0bb7bd9;hpb=7a3bd641457666e10d0a47be9f22762e03defbf0;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsImpExp.lhs b/ghc/compiler/hsSyn/HsImpExp.lhs index 0305911..e483914 100644 --- a/ghc/compiler/hsSyn/HsImpExp.lhs +++ b/ghc/compiler/hsSyn/HsImpExp.lhs @@ -1,19 +1,16 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[HsImpExp]{Abstract syntax: imports, exports, interfaces} \begin{code} -#include "HsVersions.h" - module HsImpExp where -IMP_Ubiq() +#include "HsVersions.h" -import Name ( pprNonSym ) +import Name ( isLexSym ) +import Module ( ModuleName, WhereFrom ) import Outputable -import PprStyle ( PprStyle(..) ) -import Pretty import SrcLoc ( SrcLoc ) \end{code} @@ -26,30 +23,34 @@ import SrcLoc ( SrcLoc ) One per \tr{import} declaration in a module. \begin{code} data ImportDecl name - = ImportDecl Module -- module name + = ImportDecl ModuleName -- module name + WhereFrom Bool -- True => qualified - (Maybe Module) -- as Module + (Maybe ModuleName) -- as Module (Maybe (Bool, [IE name])) -- (True => hiding, names) SrcLoc \end{code} \begin{code} -instance (NamedThing name, Outputable name) => Outputable (ImportDecl name) where - ppr sty (ImportDecl mod qual as spec _) - = ppHang (ppCat [ppPStr SLIT("import"), pp_qual qual, ppPStr mod, pp_as as]) +instance (Outputable name) => Outputable (ImportDecl name) where + ppr (ImportDecl mod from qual as spec _) + = hang (hsep [ptext SLIT("import"), ppr from, + pp_qual qual, ppr mod, pp_as as]) 4 (pp_spec spec) where - pp_qual False = ppNil - pp_qual True = ppPStr SLIT("qualified") + pp_qual False = empty + pp_qual True = ptext SLIT("qualified") - pp_as Nothing = ppNil - pp_as (Just a) = ppBeside (ppPStr SLIT("as ")) (ppPStr a) + pp_as Nothing = empty + pp_as (Just a) = ptext SLIT("as ") <+> ppr a - pp_spec Nothing = ppNil + pp_spec Nothing = empty pp_spec (Just (False, spec)) - = ppParens (interpp'SP sty spec) + = parens (interpp'SP spec) pp_spec (Just (True, spec)) - = ppBeside (ppPStr SLIT("hiding ")) (ppParens (interpp'SP sty spec)) + = ptext SLIT("hiding") <+> parens (interpp'SP spec) + +ideclName (ImportDecl mod_nm _ _ _ _ _) = mod_nm \end{code} %************************************************************************ @@ -64,7 +65,7 @@ data IE 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 Module -- (Export Only) + | IEModuleContents ModuleName -- (Export Only) \end{code} \begin{code} @@ -73,18 +74,34 @@ ieName (IEVar n) = n ieName (IEThingAbs n) = n ieName (IEThingWith n _) = n ieName (IEThingAll n) = n + +ieNames :: IE a -> [a] +ieNames (IEVar n ) = [n] +ieNames (IEThingAbs n ) = [n] +ieNames (IEThingAll n ) = [n] +ieNames (IEThingWith n ns) = n:ns +ieNames (IEModuleContents _ ) = [] +\end{code} + +\begin{code} +instance (Outputable name) => Outputable (IE name) where + ppr (IEVar var) = ppr_var var + ppr (IEThingAbs thing) = ppr thing + ppr (IEThingAll thing) = hcat [ppr thing, text "(..)"] + ppr (IEThingWith thing withs) + = ppr thing <> parens (fsep (punctuate comma (map ppr_var withs))) + ppr (IEModuleContents mod) + = ptext SLIT("module") <+> ppr mod + +ppr_var v | isOperator v = parens (ppr v) + | otherwise = ppr v \end{code} \begin{code} -instance (NamedThing name, Outputable name) => Outputable (IE name) where - ppr sty (IEVar var) = pprNonSym sty var - ppr sty (IEThingAbs thing) = ppr sty thing - ppr sty (IEThingAll thing) - = ppBesides [ppr sty thing, ppStr "(..)"] - ppr sty (IEThingWith thing withs) - = ppBeside (ppr sty thing) - (ppParens (ppInterleave ppComma (map (pprNonSym sty) withs))) - ppr sty (IEModuleContents mod) - = ppBeside (ppPStr SLIT("module ")) (ppPStr mod) +isOperator :: Outputable a => a -> Bool +isOperator v = isLexSym (_PK_ (showSDocUnqual (ppr v))) + -- 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}