X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsImpExp.lhs;h=78e417c6e66fcba4d1ed13d8131c6536244b8075;hb=c1500e4888be2341c0b6e6897f494766c86feba0;hp=220afb7499c6b72bb6d6a8f4d7222e10de39f5e0;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs index 220afb7..78e417c 100644 --- a/compiler/hsSyn/HsImpExp.lhs +++ b/compiler/hsSyn/HsImpExp.lhs @@ -1,14 +1,23 @@ % +% (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} +{-# 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 + module HsImpExp where -#include "HsVersions.h" +import Module ( ModuleName ) +import HsDoc ( HsDoc ) -import Module ( Module ) import Outputable import FastString import SrcLoc ( Located(..) ) @@ -26,35 +35,36 @@ One per \tr{import} declaration in a module. type LImportDecl name = Located (ImportDecl name) data ImportDecl name - = ImportDecl (Located Module) -- module name + = ImportDecl (Located ModuleName) -- module name Bool -- True <=> {-# SOURCE #-} import Bool -- True => qualified - (Maybe Module) -- as Module + (Maybe ModuleName) -- as Module (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, + = hang (hsep [ptext (sLit "import"), ppr_imp from, pp_qual qual, ppr mod, pp_as as]) 4 (pp_spec spec) where 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) + = ptext (sLit "hiding") <+> parens (interpp'SP spec) +ideclName :: ImportDecl name -> Located ModuleName ideclName (ImportDecl mod_nm _ _ _ _) = mod_nm \end{code} @@ -68,11 +78,14 @@ ideclName (ImportDecl mod_nm _ _ _ _) = mod_nm type LIE name = Located (IE name) 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 Module -- (Export Only) + = 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 \end{code} \begin{code} @@ -88,6 +101,9 @@ ieNames (IEThingAbs n ) = [n] ieNames (IEThingAll n ) = [n] ieNames (IEThingWith n ns) = n:ns ieNames (IEModuleContents _ ) = [] +ieNames (IEGroup _ _ ) = [] +ieNames (IEDoc _ ) = [] +ieNames (IEDocNamed _ ) = [] \end{code} \begin{code} @@ -98,7 +114,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 + = ptext (sLit "module") <+> ppr mod + ppr (IEGroup n _) = text ("") + ppr (IEDoc doc) = ppr doc + ppr (IEDocNamed string) = text ("") \end{code} \begin{code} @@ -111,13 +130,13 @@ pprHsVar v | isOperator ppr_v = parens 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 + ('(':_) -> False -- (), (,) etc + ('[':_) -> False -- [] + ('$':c:_) -> not (isAlpha c) -- Don't treat $d as an operator + (':':c:_) -> not (isAlpha c) -- Don't treat :T as an operator + ('_':_) -> False -- Not an operator + (c:_) -> not (isAlpha c) -- Starts with non-alpha + _ -> 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.