Module.lhs 11.8 KB
Newer Older
sof's avatar
sof committed
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow, 2004-2006
sof's avatar
sof committed
3 4
%

5
Module
6
~~~~~~~~~~
7
Simply the name of a module, represented as a FastString.
Josef Svenningsson's avatar
Josef Svenningsson committed
8
These are Uniquable, hence we can build FiniteMaps with Modules as
9
the keys.
sof's avatar
sof committed
10 11 12 13

\begin{code}
module Module 
    (
Simon Marlow's avatar
Simon Marlow committed
14 15 16 17 18
	-- * The ModuleName type
	ModuleName,
	pprModuleName,
	moduleNameFS,
	moduleNameString,
19
        moduleNameSlashes,
Simon Marlow's avatar
Simon Marlow committed
20 21 22
	mkModuleName,
	mkModuleNameFS,

23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
        -- * The PackageId type
        PackageId,
        fsToPackageId,
        packageIdFS,
        stringToPackageId,
        packageIdString,

	-- * Wired-in PackageIds
	basePackageId,
	rtsPackageId,
	haskell98PackageId,
	thPackageId,
        ndpPackageId,
	mainPackageId,

Simon Marlow's avatar
Simon Marlow committed
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
	-- * The Module type
	Module,
	modulePackageId, moduleName,
	pprModule,
	mkModule,

	-- * The ModuleLocation type
	ModLocation(..),
	addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,

	-- * Module mappings
    	ModuleEnv,
	elemModuleEnv, extendModuleEnv, extendModuleEnvList, 
	extendModuleEnvList_C, plusModuleEnv_C,
	delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
	lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
54 55
	moduleEnvKeys, moduleEnvElts, unitModuleEnv, isEmptyModuleEnv,
        foldModuleEnv, extendModuleEnv_C, filterModuleEnv,
Simon Marlow's avatar
Simon Marlow committed
56 57 58 59 60 61 62

	-- * ModuleName mappings
	ModuleNameEnv,

	-- * Sets of modules
	ModuleSet, emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet,
	elemModuleSet
sof's avatar
sof committed
63 64 65 66
    ) where

#include "HsVersions.h"
import Outputable
67
import qualified Pretty
Simon Marlow's avatar
Simon Marlow committed
68
import Unique
Simon Marlow's avatar
Simon Marlow committed
69
import FiniteMap
70
import UniqFM
71
import FastString
Simon Marlow's avatar
Simon Marlow committed
72
import Binary
sof's avatar
sof committed
73 74 75 76
\end{code}

%************************************************************************
%*									*
77
\subsection{Module locations}
sof's avatar
sof committed
78 79 80 81
%*									*
%************************************************************************

\begin{code}
82 83 84
data ModLocation
   = ModLocation {
        ml_hs_file   :: Maybe FilePath,
85
		-- The source file, if we have one.  Package modules
86 87 88 89 90 91 92 93 94 95 96 97 98
		-- probably don't have source files.

        ml_hi_file   :: FilePath,
		-- Where the .hi file is, whether or not it exists
		-- yet.  Always of form foo.hi, even if there is an
		-- hi-boot file (we add the -boot suffix later)

        ml_obj_file  :: FilePath
		-- Where the .o file is, whether or not it exists yet.
		-- (might not exist either because the module hasn't
		-- been compiled yet, or because it is part of a
		-- package with a .a file)
  } deriving Show
99 100 101

instance Outputable ModLocation where
   ppr = text . show
sof's avatar
sof committed
102 103
\end{code}

104 105 106 107 108 109 110 111
For a module in another package, the hs_file and obj_file
components of ModLocation are undefined.  

The locations specified by a ModLocation may or may not
correspond to actual files yet: for example, even if the object
file doesn't exist, the ModLocation still contains the path to
where the object file will reside if/when it is created.

112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128
\begin{code}
addBootSuffix :: FilePath -> FilePath
-- Add the "-boot" suffix to .hs, .hi and .o files
addBootSuffix path = path ++ "-boot"

addBootSuffix_maybe :: Bool -> FilePath -> FilePath
addBootSuffix_maybe is_boot path
 | is_boot   = addBootSuffix path
 | otherwise = path

addBootSuffixLocn :: ModLocation -> ModLocation
addBootSuffixLocn locn
  = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
	 , ml_hi_file  = addBootSuffix (ml_hi_file locn)
	 , ml_obj_file = addBootSuffix (ml_obj_file locn) }
\end{code}

sof's avatar
sof committed
129 130 131 132 133 134 135 136

%************************************************************************
%*									*
\subsection{The name of a module}
%*									*
%************************************************************************

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
137 138
-- | A ModuleName is a simple string, eg. @Data.List@.
newtype ModuleName = ModuleName FastString
139

Simon Marlow's avatar
Simon Marlow committed
140 141
instance Uniquable ModuleName where
  getUnique (ModuleName nm) = getUnique nm
142

Simon Marlow's avatar
Simon Marlow committed
143
instance Eq ModuleName where
144 145 146 147 148
  nm1 == nm2 = getUnique nm1 == getUnique nm2

-- Warning: gives an ordering relation based on the uniques of the
-- FastStrings which are the (encoded) module names.  This is _not_
-- a lexicographical ordering.
Simon Marlow's avatar
Simon Marlow committed
149
instance Ord ModuleName where
150 151
  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2

Simon Marlow's avatar
Simon Marlow committed
152 153
instance Outputable ModuleName where
  ppr = pprModuleName
sof's avatar
sof committed
154

Simon Marlow's avatar
Simon Marlow committed
155 156 157 158 159 160
instance Binary ModuleName where
  put_ bh (ModuleName fs) = put_ bh fs
  get bh = do fs <- get bh; return (ModuleName fs)

pprModuleName :: ModuleName -> SDoc
pprModuleName (ModuleName nm) = 
161 162 163 164
    getPprStyle $ \ sty ->
    if codeStyle sty 
	then ftext (zEncodeFS nm)
	else ftext nm
165

Simon Marlow's avatar
Simon Marlow committed
166 167
moduleNameFS :: ModuleName -> FastString
moduleNameFS (ModuleName mod) = mod
168

Simon Marlow's avatar
Simon Marlow committed
169 170
moduleNameString :: ModuleName -> String
moduleNameString (ModuleName mod) = unpackFS mod
171

Simon Marlow's avatar
Simon Marlow committed
172 173
mkModuleName :: String -> ModuleName
mkModuleName s = ModuleName (mkFastString s)
174

Simon Marlow's avatar
Simon Marlow committed
175 176
mkModuleNameFS :: FastString -> ModuleName
mkModuleNameFS s = ModuleName s
177 178 179 180 181

-- Returns the string version of the module name, with dots replaced by slashes
moduleNameSlashes :: ModuleName -> String
moduleNameSlashes = dots_to_slashes . moduleNameString
  where dots_to_slashes = map (\c -> if c == '.' then '/' else c)
Simon Marlow's avatar
Simon Marlow committed
182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
\end{code}

%************************************************************************
%*									*
\subsection{A fully qualified module}
%*									*
%************************************************************************

\begin{code}
-- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
data Module = Module {
   modulePackageId :: !PackageId,  -- pkg-1.0
   moduleName      :: !ModuleName  -- A.B.C
  }
  deriving (Eq, Ord)

instance Outputable Module where
  ppr = pprModule

instance Binary Module where
  put_ bh (Module p n) = put_ bh p >> put_ bh n
  get bh = do p <- get bh; n <- get bh; return (Module p n)

205 206 207
instance Uniquable PackageId where
 getUnique pid = getUnique (packageIdFS pid)

Simon Marlow's avatar
Simon Marlow committed
208 209 210 211 212 213
mkModule :: PackageId -> ModuleName -> Module
mkModule = Module

pprModule :: Module -> SDoc
pprModule mod@(Module p n)  = pprPackagePrefix p mod <> pprModuleName n

214
pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
Simon Marlow's avatar
Simon Marlow committed
215 216 217 218 219 220 221
pprPackagePrefix p mod = getPprStyle doc
 where
   doc sty
       | codeStyle sty = 
          if p == mainPackageId 
                then empty -- never qualify the main package in code
                else ftext (zEncodeFS (packageIdFS p)) <> char '_'
222
       | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
Simon Marlow's avatar
Simon Marlow committed
223 224 225
                -- the PrintUnqualified tells us which modules have to
                -- be qualified with package names
       | otherwise = empty
226
\end{code}
227

228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291
%************************************************************************
%*                                                                      *
\subsection{PackageId}
%*                                                                      *
%************************************************************************

\begin{code}
newtype PackageId = PId FastString deriving( Eq, Ord )  -- includes the version
    -- here to avoid module loops with PackageConfig

instance Outputable PackageId where
   ppr pid = text (packageIdString pid)

instance Binary PackageId where
  put_ bh pid = put_ bh (packageIdFS pid)
  get bh = do { fs <- get bh; return (fsToPackageId fs) }

fsToPackageId :: FastString -> PackageId
fsToPackageId = PId

packageIdFS :: PackageId -> FastString
packageIdFS (PId fs) = fs

stringToPackageId :: String -> PackageId
stringToPackageId = fsToPackageId . mkFastString

packageIdString :: PackageId -> String
packageIdString = unpackFS . packageIdFS


-- -----------------------------------------------------------------------------
-- Package Ids that are wired in

-- Certain packages are "known" to the compiler, in that we know about certain
-- entities that reside in these packages, and the compiler needs to 
-- declare static Modules and Names that refer to these packages.  Hence
-- the wired-in packages can't include version numbers, since we don't want
-- to bake the version numbers of these packages into GHC.
--
-- So here's the plan.  Wired-in packages are still versioned as
-- normal in the packages database, and you can still have multiple
-- versions of them installed.  However, for each invocation of GHC,
-- only a single instance of each wired-in package will be recognised
-- (the desired one is selected via -package/-hide-package), and GHC
-- will use the unversioned PackageId below when referring to it,
-- including in .hi files and object file symbols.  Unselected
-- versions of wired-in packages will be ignored, as will any other
-- package that depends directly or indirectly on it (much as if you
-- had used -ignore-package).

basePackageId, rtsPackageId, haskell98PackageId, 
  thPackageId, ndpPackageId, mainPackageId  :: PackageId
basePackageId      = fsToPackageId FSLIT("base")
rtsPackageId	   = fsToPackageId FSLIT("rts")
haskell98PackageId = fsToPackageId FSLIT("haskell98")
thPackageId        = fsToPackageId FSLIT("template-haskell")
ndpPackageId       = fsToPackageId FSLIT("ndp")

-- This is the package Id for the program.  It is the default package
-- Id if you don't specify a package name.  We don't add this prefix
-- to symbol name, since there can be only one main package per program.
mainPackageId	   = fsToPackageId FSLIT("main")
\end{code}

292 293 294 295 296 297 298
%************************************************************************
%*                                                                      *
\subsection{@ModuleEnv@s}
%*                                                                      *
%************************************************************************

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
299
type ModuleEnv elt = FiniteMap Module elt
300 301 302 303 304

emptyModuleEnv       :: ModuleEnv a
mkModuleEnv          :: [(Module, a)] -> ModuleEnv a
unitModuleEnv        :: Module -> a -> ModuleEnv a
extendModuleEnv      :: ModuleEnv a -> Module -> a -> ModuleEnv a
305
extendModuleEnv_C    :: (a->a->a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
306 307
plusModuleEnv        :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
extendModuleEnvList  :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
Simon Marlow's avatar
Simon Marlow committed
308
extendModuleEnvList_C  :: (a->a->a) -> ModuleEnv a -> [(Module, a)] -> ModuleEnv a
309 310 311 312 313
                  
delModuleEnvList     :: ModuleEnv a -> [Module] -> ModuleEnv a
delModuleEnv         :: ModuleEnv a -> Module -> ModuleEnv a
plusModuleEnv_C      :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
mapModuleEnv         :: (a -> b) -> ModuleEnv a -> ModuleEnv b
314
moduleEnvKeys        :: ModuleEnv a -> [Module]
315
moduleEnvElts        :: ModuleEnv a -> [a]
316 317
                  
isEmptyModuleEnv     :: ModuleEnv a -> Bool
318
lookupModuleEnv      :: ModuleEnv a -> Module     -> Maybe a
319 320 321
lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
elemModuleEnv        :: Module -> ModuleEnv a -> Bool
foldModuleEnv        :: (a -> b -> b) -> b -> ModuleEnv a -> b
322
filterModuleEnv      :: (a -> Bool) -> ModuleEnv a -> ModuleEnv a
323

Simon Marlow's avatar
Simon Marlow committed
324 325 326 327 328 329 330 331 332 333 334 335 336 337 338
filterModuleEnv f   = filterFM (\_ v -> f v)
elemModuleEnv       = elemFM
extendModuleEnv     = addToFM
extendModuleEnv_C   = addToFM_C
extendModuleEnvList = addListToFM
extendModuleEnvList_C = addListToFM_C
plusModuleEnv_C     = plusFM_C
delModuleEnvList    = delListFromFM
delModuleEnv        = delFromFM
plusModuleEnv       = plusFM
lookupModuleEnv     = lookupFM
lookupWithDefaultModuleEnv = lookupWithDefaultFM
mapModuleEnv f      = mapFM (\_ v -> f v)
mkModuleEnv         = listToFM
emptyModuleEnv      = emptyFM
339
moduleEnvKeys       = keysFM
Simon Marlow's avatar
Simon Marlow committed
340 341 342 343
moduleEnvElts       = eltsFM
unitModuleEnv       = unitFM
isEmptyModuleEnv    = isEmptyFM
foldModuleEnv f     = foldFM (\_ v -> f v)
344
\end{code}
345 346

\begin{code}
Simon Marlow's avatar
Simon Marlow committed
347
type ModuleSet = FiniteMap Module ()
348 349 350 351 352 353
mkModuleSet	:: [Module] -> ModuleSet
extendModuleSet :: ModuleSet -> Module -> ModuleSet
emptyModuleSet  :: ModuleSet
moduleSetElts   :: ModuleSet -> [Module]
elemModuleSet   :: Module -> ModuleSet -> Bool

Simon Marlow's avatar
Simon Marlow committed
354 355 356 357 358 359 360 361 362 363 364 365
emptyModuleSet    = emptyFM
mkModuleSet ms    = listToFM [(m,()) | m <- ms ]
extendModuleSet s m = addToFM s m ()
moduleSetElts     = keysFM
elemModuleSet     = elemFM
\end{code}

A ModuleName has a Unique, so we can build mappings of these using
UniqFM.

\begin{code}
type ModuleNameEnv elt = UniqFM elt
366
\end{code}