X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FhsSyn%2FHsImpExp.lhs;h=4e58dd71f0da18a284256803ff8b983197131336;hb=27de38efce6d73d2a0209f803cfa98c82773e773;hp=767be42d2966ba23b6209fc8e17f4c42d990b8db;hpb=190f24892156953d73b55401d0467a6f1a88ce5d;p=ghc-hetmet.git diff --git a/compiler/hsSyn/HsImpExp.lhs b/compiler/hsSyn/HsImpExp.lhs index 767be42..4e58dd7 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} %************************************************************************ @@ -38,25 +44,26 @@ data ImportDecl name \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} @@ -106,31 +113,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}