| 1 | % |
|---|
| 2 | % (c) The University of Glasgow 2006 |
|---|
| 3 | % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 |
|---|
| 4 | % |
|---|
| 5 | |
|---|
| 6 | HsImpExp: Abstract syntax: imports, exports, interfaces |
|---|
| 7 | |
|---|
| 8 | \begin{code} |
|---|
| 9 | {-# LANGUAGE DeriveDataTypeable #-} |
|---|
| 10 | |
|---|
| 11 | module HsImpExp where |
|---|
| 12 | |
|---|
| 13 | import Module ( ModuleName ) |
|---|
| 14 | import HsDoc ( HsDocString ) |
|---|
| 15 | import OccName ( HasOccName(..), isTcOcc, isSymOcc ) |
|---|
| 16 | |
|---|
| 17 | import Outputable |
|---|
| 18 | import FastString |
|---|
| 19 | import SrcLoc |
|---|
| 20 | |
|---|
| 21 | import Data.Data |
|---|
| 22 | \end{code} |
|---|
| 23 | |
|---|
| 24 | %************************************************************************ |
|---|
| 25 | %* * |
|---|
| 26 | \subsection{Import and export declaration lists} |
|---|
| 27 | %* * |
|---|
| 28 | %************************************************************************ |
|---|
| 29 | |
|---|
| 30 | One per \tr{import} declaration in a module. |
|---|
| 31 | \begin{code} |
|---|
| 32 | type LImportDecl name = Located (ImportDecl name) |
|---|
| 33 | |
|---|
| 34 | -- | A single Haskell @import@ declaration. |
|---|
| 35 | data ImportDecl name |
|---|
| 36 | = ImportDecl { |
|---|
| 37 | ideclName :: Located ModuleName, -- ^ Module name. |
|---|
| 38 | ideclPkgQual :: Maybe FastString, -- ^ Package qualifier. |
|---|
| 39 | ideclSource :: Bool, -- ^ True <=> {-# SOURCE #-} import |
|---|
| 40 | ideclSafe :: Bool, -- ^ True => safe import |
|---|
| 41 | ideclQualified :: Bool, -- ^ True => qualified |
|---|
| 42 | ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude) |
|---|
| 43 | ideclAs :: Maybe ModuleName, -- ^ as Module |
|---|
| 44 | ideclHiding :: Maybe (Bool, [LIE name]) -- ^ (True => hiding, names) |
|---|
| 45 | } deriving (Data, Typeable) |
|---|
| 46 | |
|---|
| 47 | simpleImportDecl :: ModuleName -> ImportDecl name |
|---|
| 48 | simpleImportDecl mn = ImportDecl { |
|---|
| 49 | ideclName = noLoc mn, |
|---|
| 50 | ideclPkgQual = Nothing, |
|---|
| 51 | ideclSource = False, |
|---|
| 52 | ideclSafe = False, |
|---|
| 53 | ideclImplicit = False, |
|---|
| 54 | ideclQualified = False, |
|---|
| 55 | ideclAs = Nothing, |
|---|
| 56 | ideclHiding = Nothing |
|---|
| 57 | } |
|---|
| 58 | \end{code} |
|---|
| 59 | |
|---|
| 60 | \begin{code} |
|---|
| 61 | instance (OutputableBndr name, HasOccName name) => Outputable (ImportDecl name) where |
|---|
| 62 | ppr (ImportDecl { ideclName = mod', ideclPkgQual = pkg |
|---|
| 63 | , ideclSource = from, ideclSafe = safe |
|---|
| 64 | , ideclQualified = qual, ideclImplicit = implicit |
|---|
| 65 | , ideclAs = as, ideclHiding = spec }) |
|---|
| 66 | = hang (hsep [ptext (sLit "import"), ppr_imp from, pp_implicit implicit, pp_safe safe, |
|---|
| 67 | pp_qual qual, pp_pkg pkg, ppr mod', pp_as as]) |
|---|
| 68 | 4 (pp_spec spec) |
|---|
| 69 | where |
|---|
| 70 | pp_implicit False = empty |
|---|
| 71 | pp_implicit True = ptext (sLit ("(implicit)")) |
|---|
| 72 | |
|---|
| 73 | pp_pkg Nothing = empty |
|---|
| 74 | pp_pkg (Just p) = doubleQuotes (ftext p) |
|---|
| 75 | |
|---|
| 76 | pp_qual False = empty |
|---|
| 77 | pp_qual True = ptext (sLit "qualified") |
|---|
| 78 | |
|---|
| 79 | pp_safe False = empty |
|---|
| 80 | pp_safe True = ptext (sLit "safe") |
|---|
| 81 | |
|---|
| 82 | pp_as Nothing = empty |
|---|
| 83 | pp_as (Just a) = ptext (sLit "as") <+> ppr a |
|---|
| 84 | |
|---|
| 85 | ppr_imp True = ptext (sLit "{-# SOURCE #-}") |
|---|
| 86 | ppr_imp False = empty |
|---|
| 87 | |
|---|
| 88 | pp_spec Nothing = empty |
|---|
| 89 | pp_spec (Just (False, ies)) = ppr_ies ies |
|---|
| 90 | pp_spec (Just (True, ies)) = ptext (sLit "hiding") <+> ppr_ies ies |
|---|
| 91 | |
|---|
| 92 | ppr_ies [] = ptext (sLit "()") |
|---|
| 93 | ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')' |
|---|
| 94 | \end{code} |
|---|
| 95 | |
|---|
| 96 | %************************************************************************ |
|---|
| 97 | %* * |
|---|
| 98 | \subsection{Imported and exported entities} |
|---|
| 99 | %* * |
|---|
| 100 | %************************************************************************ |
|---|
| 101 | |
|---|
| 102 | \begin{code} |
|---|
| 103 | type LIE name = Located (IE name) |
|---|
| 104 | |
|---|
| 105 | -- | Imported or exported entity. |
|---|
| 106 | data IE name |
|---|
| 107 | = IEVar name |
|---|
| 108 | | IEThingAbs name -- ^ Class/Type (can't tell) |
|---|
| 109 | | IEThingAll name -- ^ Class/Type plus all methods/constructors |
|---|
| 110 | | IEThingWith name [name] -- ^ Class/Type plus some methods/constructors |
|---|
| 111 | | IEModuleContents ModuleName -- ^ (Export Only) |
|---|
| 112 | | IEGroup Int HsDocString -- ^ Doc section heading |
|---|
| 113 | | IEDoc HsDocString -- ^ Some documentation |
|---|
| 114 | | IEDocNamed String -- ^ Reference to named doc |
|---|
| 115 | deriving (Eq, Data, Typeable) |
|---|
| 116 | \end{code} |
|---|
| 117 | |
|---|
| 118 | \begin{code} |
|---|
| 119 | ieName :: IE name -> name |
|---|
| 120 | ieName (IEVar n) = n |
|---|
| 121 | ieName (IEThingAbs n) = n |
|---|
| 122 | ieName (IEThingWith n _) = n |
|---|
| 123 | ieName (IEThingAll n) = n |
|---|
| 124 | ieName _ = panic "ieName failed pattern match!" |
|---|
| 125 | |
|---|
| 126 | ieNames :: IE a -> [a] |
|---|
| 127 | ieNames (IEVar n ) = [n] |
|---|
| 128 | ieNames (IEThingAbs n ) = [n] |
|---|
| 129 | ieNames (IEThingAll n ) = [n] |
|---|
| 130 | ieNames (IEThingWith n ns) = n : ns |
|---|
| 131 | ieNames (IEModuleContents _ ) = [] |
|---|
| 132 | ieNames (IEGroup _ _ ) = [] |
|---|
| 133 | ieNames (IEDoc _ ) = [] |
|---|
| 134 | ieNames (IEDocNamed _ ) = [] |
|---|
| 135 | \end{code} |
|---|
| 136 | |
|---|
| 137 | \begin{code} |
|---|
| 138 | |
|---|
| 139 | pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc |
|---|
| 140 | pprImpExp name = type_pref <+> pprPrefixOcc name |
|---|
| 141 | where |
|---|
| 142 | occ = occName name |
|---|
| 143 | type_pref | isTcOcc occ && isSymOcc occ = ptext (sLit "type") |
|---|
| 144 | | otherwise = empty |
|---|
| 145 | |
|---|
| 146 | instance (HasOccName name, OutputableBndr name) => Outputable (IE name) where |
|---|
| 147 | ppr (IEVar var) = pprPrefixOcc var |
|---|
| 148 | ppr (IEThingAbs thing) = pprImpExp thing |
|---|
| 149 | ppr (IEThingAll thing) = hcat [pprImpExp thing, text "(..)"] |
|---|
| 150 | ppr (IEThingWith thing withs) |
|---|
| 151 | = pprImpExp thing <> parens (fsep (punctuate comma (map pprImpExp withs))) |
|---|
| 152 | ppr (IEModuleContents mod') |
|---|
| 153 | = ptext (sLit "module") <+> ppr mod' |
|---|
| 154 | ppr (IEGroup n _) = text ("<IEGroup: " ++ (show n) ++ ">") |
|---|
| 155 | ppr (IEDoc doc) = ppr doc |
|---|
| 156 | ppr (IEDocNamed string) = text ("<IEDocNamed: " ++ string ++ ">") |
|---|
| 157 | \end{code} |
|---|
| 158 | |
|---|