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