Merge branch 'master' of git://git.haskell.org/ghc
[ghc.git] / compiler / basicTypes / Module.lhs
1 %
2 % (c) The University of Glasgow, 2004-2006
3 %
4
5 Module
6 ~~~~~~~~~~
7 Simply the name of a module, represented as a FastString.
8 These are Uniquable, hence we can build Maps with Modules as
9 the keys.
10
11 \begin{code}
12
13 module Module
14     (
15         -- * The ModuleName type
16         ModuleName,
17         pprModuleName,
18         moduleNameFS,
19         moduleNameString,
20         moduleNameSlashes, moduleNameColons,
21         mkModuleName,
22         mkModuleNameFS,
23         stableModuleNameCmp,
24
25         -- * The PackageId type
26         PackageId,
27         fsToPackageId,
28         packageIdFS,
29         stringToPackageId,
30         packageIdString,
31         stablePackageIdCmp,
32
33         -- * Wired-in PackageIds
34         -- $wired_in_packages
35         primPackageId,
36         integerPackageId,
37         basePackageId,
38         rtsPackageId,
39         thPackageId,
40         dphSeqPackageId,
41         dphParPackageId,
42         mainPackageId,
43         thisGhcPackageId,
44
45         -- * The Module type
46         Module,
47         modulePackageId, moduleName,
48         pprModule,
49         mkModule,
50         stableModuleCmp,
51         HasModule(..),
52         ContainsModule(..),
53
54         -- * The ModuleLocation type
55         ModLocation(..),
56         addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
57
58         -- * Module mappings
59         ModuleEnv,
60         elemModuleEnv, extendModuleEnv, extendModuleEnvList,
61         extendModuleEnvList_C, plusModuleEnv_C,
62         delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
63         lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
64         moduleEnvKeys, moduleEnvElts, moduleEnvToList,
65         unitModuleEnv, isEmptyModuleEnv,
66         foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
67
68         -- * ModuleName mappings
69         ModuleNameEnv,
70
71         -- * Sets of Modules
72         ModuleSet,
73         emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
74     ) where
75
76 #include "Typeable.h"
77
78 import Config
79 import Outputable
80 import Unique
81 import UniqFM
82 import FastString
83 import Binary
84 import Util
85
86 import Data.Data
87 import Data.Map (Map)
88 import qualified Data.Map as Map
89 import qualified FiniteMap as Map
90 import System.FilePath
91 \end{code}
92
93 %************************************************************************
94 %*                                                                      *
95 \subsection{Module locations}
96 %*                                                                      *
97 %************************************************************************
98
99 \begin{code}
100 -- | Where a module lives on the file system: the actual locations
101 -- of the .hs, .hi and .o files, if we have them
102 data ModLocation
103    = ModLocation {
104         ml_hs_file   :: Maybe FilePath,
105                 -- The source file, if we have one.  Package modules
106                 -- probably don't have source files.
107
108         ml_hi_file   :: FilePath,
109                 -- Where the .hi file is, whether or not it exists
110                 -- yet.  Always of form foo.hi, even if there is an
111                 -- hi-boot file (we add the -boot suffix later)
112
113         ml_obj_file  :: FilePath
114                 -- Where the .o file is, whether or not it exists yet.
115                 -- (might not exist either because the module hasn't
116                 -- been compiled yet, or because it is part of a
117                 -- package with a .a file)
118   } deriving Show
119
120 instance Outputable ModLocation where
121    ppr = text . show
122 \end{code}
123
124 For a module in another package, the hs_file and obj_file
125 components of ModLocation are undefined.
126
127 The locations specified by a ModLocation may or may not
128 correspond to actual files yet: for example, even if the object
129 file doesn't exist, the ModLocation still contains the path to
130 where the object file will reside if/when it is created.
131
132 \begin{code}
133 addBootSuffix :: FilePath -> FilePath
134 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
135 addBootSuffix path = path ++ "-boot"
136
137 addBootSuffix_maybe :: Bool -> FilePath -> FilePath
138 -- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
139 addBootSuffix_maybe is_boot path
140  | is_boot   = addBootSuffix path
141  | otherwise = path
142
143 addBootSuffixLocn :: ModLocation -> ModLocation
144 -- ^ Add the @-boot@ suffix to all file paths associated with the module
145 addBootSuffixLocn locn
146   = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
147          , ml_hi_file  = addBootSuffix (ml_hi_file locn)
148          , ml_obj_file = addBootSuffix (ml_obj_file locn) }
149 \end{code}
150
151
152 %************************************************************************
153 %*                                                                      *
154 \subsection{The name of a module}
155 %*                                                                      *
156 %************************************************************************
157
158 \begin{code}
159 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
160 newtype ModuleName = ModuleName FastString
161     deriving Typeable
162
163 instance Uniquable ModuleName where
164   getUnique (ModuleName nm) = getUnique nm
165
166 instance Eq ModuleName where
167   nm1 == nm2 = getUnique nm1 == getUnique nm2
168
169 -- Warning: gives an ordering relation based on the uniques of the
170 -- FastStrings which are the (encoded) module names.  This is _not_
171 -- a lexicographical ordering.
172 instance Ord ModuleName where
173   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
174
175 instance Outputable ModuleName where
176   ppr = pprModuleName
177
178 instance Binary ModuleName where
179   put_ bh (ModuleName fs) = put_ bh fs
180   get bh = do fs <- get bh; return (ModuleName fs)
181
182 instance Data ModuleName where
183   -- don't traverse?
184   toConstr _   = abstractConstr "ModuleName"
185   gunfold _ _  = error "gunfold"
186   dataTypeOf _ = mkNoRepType "ModuleName"
187
188 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
189 -- ^ Compares module names lexically, rather than by their 'Unique's
190 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
191
192 pprModuleName :: ModuleName -> SDoc
193 pprModuleName (ModuleName nm) =
194     getPprStyle $ \ sty ->
195     if codeStyle sty
196         then ztext (zEncodeFS nm)
197         else ftext nm
198
199 moduleNameFS :: ModuleName -> FastString
200 moduleNameFS (ModuleName mod) = mod
201
202 moduleNameString :: ModuleName -> String
203 moduleNameString (ModuleName mod) = unpackFS mod
204
205 mkModuleName :: String -> ModuleName
206 mkModuleName s = ModuleName (mkFastString s)
207
208 mkModuleNameFS :: FastString -> ModuleName
209 mkModuleNameFS s = ModuleName s
210
211 -- |Returns the string version of the module name, with dots replaced by slashes.
212 --
213 moduleNameSlashes :: ModuleName -> String
214 moduleNameSlashes = dots_to_slashes . moduleNameString
215   where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
216
217 -- |Returns the string version of the module name, with dots replaced by underscores.
218 --
219 moduleNameColons :: ModuleName -> String
220 moduleNameColons = dots_to_colons . moduleNameString
221   where dots_to_colons = map (\c -> if c == '.' then ':' else c)
222 \end{code}
223
224 %************************************************************************
225 %*                                                                      *
226 \subsection{A fully qualified module}
227 %*                                                                      *
228 %************************************************************************
229
230 \begin{code}
231 -- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
232 data Module = Module {
233    modulePackageId :: !PackageId,  -- pkg-1.0
234    moduleName      :: !ModuleName  -- A.B.C
235   }
236   deriving (Eq, Ord, Typeable)
237
238 instance Uniquable Module where
239   getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
240
241 instance Outputable Module where
242   ppr = pprModule
243
244 instance Binary Module where
245   put_ bh (Module p n) = put_ bh p >> put_ bh n
246   get bh = do p <- get bh; n <- get bh; return (Module p n)
247
248 instance Data Module where
249   -- don't traverse?
250   toConstr _   = abstractConstr "Module"
251   gunfold _ _  = error "gunfold"
252   dataTypeOf _ = mkNoRepType "Module"
253
254 -- | This gives a stable ordering, as opposed to the Ord instance which
255 -- gives an ordering based on the 'Unique's of the components, which may
256 -- not be stable from run to run of the compiler.
257 stableModuleCmp :: Module -> Module -> Ordering
258 stableModuleCmp (Module p1 n1) (Module p2 n2)
259    = (p1 `stablePackageIdCmp`  p2) `thenCmp`
260      (n1 `stableModuleNameCmp` n2)
261
262 mkModule :: PackageId -> ModuleName -> Module
263 mkModule = Module
264
265 pprModule :: Module -> SDoc
266 pprModule mod@(Module p n)  =
267   pprPackagePrefix p mod <> pprModuleName n
268
269 pprPackagePrefix :: PackageId -> Module -> SDoc
270 pprPackagePrefix p mod = getPprStyle doc
271  where
272    doc sty
273        | codeStyle sty =
274           if p == mainPackageId
275                 then empty -- never qualify the main package in code
276                 else ztext (zEncodeFS (packageIdFS p)) <> char '_'
277        | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
278                 -- the PrintUnqualified tells us which modules have to
279                 -- be qualified with package names
280        | otherwise = empty
281
282 class ContainsModule t where
283     extractModule :: t -> Module
284
285 class HasModule m where
286     getModule :: m Module
287 \end{code}
288
289 %************************************************************************
290 %*                                                                      *
291 \subsection{PackageId}
292 %*                                                                      *
293 %************************************************************************
294
295 \begin{code}
296 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
297 newtype PackageId = PId FastString deriving( Eq, Typeable )
298     -- here to avoid module loops with PackageConfig
299
300 instance Uniquable PackageId where
301  getUnique pid = getUnique (packageIdFS pid)
302
303 -- Note: *not* a stable lexicographic ordering, a faster unique-based
304 -- ordering.
305 instance Ord PackageId where
306   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
307
308 instance Data PackageId where
309   -- don't traverse?
310   toConstr _   = abstractConstr "PackageId"
311   gunfold _ _  = error "gunfold"
312   dataTypeOf _ = mkNoRepType "PackageId"
313
314 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
315 -- ^ Compares package ids lexically, rather than by their 'Unique's
316 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
317
318 instance Outputable PackageId where
319    ppr pid = text (packageIdString pid)
320
321 instance Binary PackageId where
322   put_ bh pid = put_ bh (packageIdFS pid)
323   get bh = do { fs <- get bh; return (fsToPackageId fs) }
324
325 fsToPackageId :: FastString -> PackageId
326 fsToPackageId = PId
327
328 packageIdFS :: PackageId -> FastString
329 packageIdFS (PId fs) = fs
330
331 stringToPackageId :: String -> PackageId
332 stringToPackageId = fsToPackageId . mkFastString
333
334 packageIdString :: PackageId -> String
335 packageIdString = unpackFS . packageIdFS
336
337
338 -- -----------------------------------------------------------------------------
339 -- $wired_in_packages
340 -- Certain packages are known to the compiler, in that we know about certain
341 -- entities that reside in these packages, and the compiler needs to
342 -- declare static Modules and Names that refer to these packages.  Hence
343 -- the wired-in packages can't include version numbers, since we don't want
344 -- to bake the version numbers of these packages into GHC.
345 --
346 -- So here's the plan.  Wired-in packages are still versioned as
347 -- normal in the packages database, and you can still have multiple
348 -- versions of them installed.  However, for each invocation of GHC,
349 -- only a single instance of each wired-in package will be recognised
350 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
351 -- will use the unversioned 'PackageId' below when referring to it,
352 -- including in .hi files and object file symbols.  Unselected
353 -- versions of wired-in packages will be ignored, as will any other
354 -- package that depends directly or indirectly on it (much as if you
355 -- had used @-ignore-package@).
356
357 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
358
359 integerPackageId, primPackageId,
360   basePackageId, rtsPackageId,
361   thPackageId, dphSeqPackageId, dphParPackageId,
362   mainPackageId, thisGhcPackageId  :: PackageId
363 primPackageId      = fsToPackageId (fsLit "ghc-prim")
364 integerPackageId   = fsToPackageId (fsLit cIntegerLibrary)
365 basePackageId      = fsToPackageId (fsLit "base")
366 rtsPackageId       = fsToPackageId (fsLit "rts")
367 thPackageId        = fsToPackageId (fsLit "template-haskell")
368 dphSeqPackageId    = fsToPackageId (fsLit "dph-seq")
369 dphParPackageId    = fsToPackageId (fsLit "dph-par")
370 thisGhcPackageId   = fsToPackageId (fsLit ("ghc-" ++ cProjectVersion))
371
372 -- | This is the package Id for the current program.  It is the default
373 -- package Id if you don't specify a package name.  We don't add this prefix
374 -- to symbol names, since there can be only one main package per program.
375 mainPackageId      = fsToPackageId (fsLit "main")
376 \end{code}
377
378 %************************************************************************
379 %*                                                                      *
380 \subsection{@ModuleEnv@s}
381 %*                                                                      *
382 %************************************************************************
383
384 \begin{code}
385 -- | A map keyed off of 'Module's
386 newtype ModuleEnv elt = ModuleEnv (Map Module elt)
387
388 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
389 filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
390
391 elemModuleEnv :: Module -> ModuleEnv a -> Bool
392 elemModuleEnv m (ModuleEnv e) = Map.member m e
393
394 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
395 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
396
397 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
398 extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
399
400 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
401 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
402
403 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
404                       -> ModuleEnv a
405 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
406
407 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
408 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
409
410 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
411 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
412
413 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
414 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
415
416 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
417 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
418
419 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
420 lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
421
422 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
423 lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
424
425 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
426 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
427
428 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
429 mkModuleEnv xs = ModuleEnv (Map.fromList xs)
430
431 emptyModuleEnv :: ModuleEnv a
432 emptyModuleEnv = ModuleEnv Map.empty
433
434 moduleEnvKeys :: ModuleEnv a -> [Module]
435 moduleEnvKeys (ModuleEnv e) = Map.keys e
436
437 moduleEnvElts :: ModuleEnv a -> [a]
438 moduleEnvElts (ModuleEnv e) = Map.elems e
439
440 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
441 moduleEnvToList (ModuleEnv e) = Map.toList e
442
443 unitModuleEnv :: Module -> a -> ModuleEnv a
444 unitModuleEnv m x = ModuleEnv (Map.singleton m x)
445
446 isEmptyModuleEnv :: ModuleEnv a -> Bool
447 isEmptyModuleEnv (ModuleEnv e) = Map.null e
448
449 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
450 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
451 \end{code}
452
453 \begin{code}
454 -- | A set of 'Module's
455 type ModuleSet = Map Module ()
456
457 mkModuleSet     :: [Module] -> ModuleSet
458 extendModuleSet :: ModuleSet -> Module -> ModuleSet
459 emptyModuleSet  :: ModuleSet
460 moduleSetElts   :: ModuleSet -> [Module]
461 elemModuleSet   :: Module -> ModuleSet -> Bool
462
463 emptyModuleSet    = Map.empty
464 mkModuleSet ms    = Map.fromList [(m,()) | m <- ms ]
465 extendModuleSet s m = Map.insert m () s
466 moduleSetElts     = Map.keys
467 elemModuleSet     = Map.member
468 \end{code}
469
470 A ModuleName has a Unique, so we can build mappings of these using
471 UniqFM.
472
473 \begin{code}
474 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
475 type ModuleNameEnv elt = UniqFM elt
476 \end{code}
477