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