X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FhsSyn%2FHsImpExp.lhs;h=b47abf4914770206e1c8ae9d4a1db099356ef593;hb=47eef4b5780f0a5b5a37847097842daebd0f9285;hp=f5c579b3182c4997c52b6ef4c286db6eba4f53fe;hpb=6c381e873e222417d9a67aeec77b9555eca7b7a8;p=ghc-hetmet.git diff --git a/ghc/compiler/hsSyn/HsImpExp.lhs b/ghc/compiler/hsSyn/HsImpExp.lhs index f5c579b..b47abf4 100644 --- a/ghc/compiler/hsSyn/HsImpExp.lhs +++ b/ghc/compiler/hsSyn/HsImpExp.lhs @@ -1,24 +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 -import Ubiq{-uitous-} - --- friends: -import HsDecls ( FixityDecl, TyDecl, ClassDecl, InstDecl ) -import HsBinds ( Sig ) +#include "HsVersions.h" --- others: +import Module ( ModuleName, WhereFrom ) import Outputable -import PprStyle ( PprStyle(..) ) -import Pretty -import SrcLoc ( SrcLoc{-instances-} ) +import SrcLoc ( SrcLoc ) \end{code} %************************************************************************ @@ -29,35 +21,35 @@ import SrcLoc ( SrcLoc{-instances-} ) One per \tr{import} declaration in a module. \begin{code} -data ImportedInterface tyvar uvar name pat - = ImportMod (Interface tyvar uvar name pat) - Bool -- qualified? - (Maybe FAST_STRING) -- as Modid - (Maybe (Bool, [IE name])) -- (hiding?, names) +data ImportDecl name + = ImportDecl ModuleName -- module name + WhereFrom + Bool -- True => qualified + (Maybe ModuleName) -- as Module + (Maybe (Bool, [IE name])) -- (True => hiding, names) + SrcLoc \end{code} \begin{code} -instance (NamedThing name, Outputable name, Outputable pat, - Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) - => Outputable (ImportedInterface tyvar uvar name pat) where - - ppr sty (ImportMod iface qual as spec) - = ppAbove (ppHang (ppCat [ppStr "import", pp_qual qual, ppr PprForUser iface, pp_as as]) - 4 (pp_spec spec)) - (case sty of {PprForUser -> ppNil; _ -> ppr sty iface}) +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 = ppStr "qualified" + pp_qual False = empty + pp_qual True = ptext SLIT("qualified") - pp_as Nothing = ppNil - pp_as (Just a) = ppCat [ppStr "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)) - = ppBesides [ppStr "(", interpp'SP sty spec, ppStr ")"] + = parens (interpp'SP spec) pp_spec (Just (True, spec)) - = ppBesides [ppStr "hiding (", interpp'SP sty spec, ppStr ")"] + = ptext SLIT("hiding") <+> parens (interpp'SP spec) +ideclName (ImportDecl mod_nm _ _ _ _ _) = mod_nm \end{code} %************************************************************************ @@ -65,80 +57,39 @@ instance (NamedThing name, Outputable name, Outputable pat, \subsection{Imported and exported entities} %* * %************************************************************************ + \begin{code} data IE name = IEVar name - | IEThingAbs name -- Constructor/Type/Class (can't tell) + | 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 FAST_STRING -- (Export Only) + | IEModuleContents ModuleName -- (Export Only) \end{code} \begin{code} -instance (Outputable name) => Outputable (IE name) where - ppr sty (IEVar var) = ppr sty var - ppr sty (IEThingAbs thing) = ppr sty thing - ppr sty (IEThingAll thing) - = ppBesides [ppr sty thing, ppStr "(..)"] - ppr sty (IEThingWith thing withs) - = ppBesides [ppr sty thing, ppLparen, ppInterleave ppComma (map (ppr sty) withs), ppRparen] - ppr sty (IEModuleContents mod) - = ppBeside (ppPStr SLIT("module ")) (ppPStr mod) +ieName :: IE name -> name +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} -%************************************************************************ -%* * -\subsection{Interfaces} -%* * -%************************************************************************ - \begin{code} -data Interface tyvar uvar name pat - = Interface FAST_STRING -- module name - [IfaceImportDecl name] - [FixityDecl name] - [TyDecl name] -- data decls may have no constructors - [ClassDecl tyvar uvar name pat] -- without default methods - [InstDecl tyvar uvar name pat] -- without method defns - [Sig name] - SrcLoc -\end{code} - -\begin{code} -instance (NamedThing name, Outputable name, Outputable pat, - Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar) - => Outputable (Interface tyvar uvar name pat) where - - ppr PprForUser (Interface name _ _ _ _ _ _ _) = ppPStr name - - ppr sty (Interface name iimpdecls fixities tydecls classdecls instdecls sigs anns) - = ppAboves [ppStr "{-", - ifPprShowAll sty (ppr sty anns), - ppCat [ppStr "interface", ppPStr name, ppStr "where"], - ppNest 4 (ppAboves [ - pp_nonnull iimpdecls, - pp_nonnull fixities, - pp_nonnull tydecls, - pp_nonnull classdecls, - pp_nonnull instdecls, - pp_nonnull sigs]), - ppStr "-}"] - where - pp_nonnull [] = ppNil - pp_nonnull xs = ppAboves (map (ppr sty) xs) -\end{code} - -\begin{code} -data IfaceImportDecl name - = IfaceImportDecl FAST_STRING -- module we're being told about - [IE name] -- things we're being told about - SrcLoc +instance (Outputable name) => Outputable (IE name) where + ppr (IEVar var) = ppr 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 withs))) + ppr (IEModuleContents mod) + = ptext SLIT("module") <+> ppr mod \end{code} -\begin{code} -instance Outputable name => Outputable (IfaceImportDecl name) where - - ppr sty (IfaceImportDecl mod names src_loc) - = ppHang (ppCat [ppPStr SLIT("import"), ppPStr mod, ppLparen]) - 4 (ppSep [ppCat [interpp'SP sty names, ppRparen]]) -\end{code}