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