2 % (c) The University of Glasgow, 2004-2006
7 Simply the name of a module, represented as a FastString.
8 These are Uniquable, hence we can build FiniteMaps with Modules as
14 -- * The ModuleName type
24 -- * The PackageId type
32 -- * Wired-in PackageIds
46 modulePackageId, moduleName,
51 -- * The ModuleLocation type
53 addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
57 elemModuleEnv, extendModuleEnv, extendModuleEnvList,
58 extendModuleEnvList_C, plusModuleEnv_C,
59 delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
60 lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
61 moduleEnvKeys, moduleEnvElts, moduleEnvToList,
62 unitModuleEnv, isEmptyModuleEnv,
63 foldModuleEnv, extendModuleEnv_C, filterModuleEnv,
65 -- * ModuleName mappings
70 emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
77 import qualified Pretty
86 import System.FilePath
89 %************************************************************************
91 \subsection{Module locations}
93 %************************************************************************
96 -- | Where a module lives on the file system: the actual locations
97 -- of the .hs, .hi and .o files, if we have them
100 ml_hs_file :: Maybe FilePath,
101 -- The source file, if we have one. Package modules
102 -- probably don't have source files.
104 ml_hi_file :: FilePath,
105 -- Where the .hi file is, whether or not it exists
106 -- yet. Always of form foo.hi, even if there is an
107 -- hi-boot file (we add the -boot suffix later)
109 ml_obj_file :: FilePath
110 -- Where the .o file is, whether or not it exists yet.
111 -- (might not exist either because the module hasn't
112 -- been compiled yet, or because it is part of a
113 -- package with a .a file)
116 instance Outputable ModLocation where
120 For a module in another package, the hs_file and obj_file
121 components of ModLocation are undefined.
123 The locations specified by a ModLocation may or may not
124 correspond to actual files yet: for example, even if the object
125 file doesn't exist, the ModLocation still contains the path to
126 where the object file will reside if/when it is created.
129 addBootSuffix :: FilePath -> FilePath
130 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
131 addBootSuffix path = path ++ "-boot"
133 addBootSuffix_maybe :: Bool -> FilePath -> FilePath
134 -- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
135 addBootSuffix_maybe is_boot path
136 | is_boot = addBootSuffix path
139 addBootSuffixLocn :: ModLocation -> ModLocation
140 -- ^ Add the @-boot@ suffix to all file paths associated with the module
141 addBootSuffixLocn locn
142 = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
143 , ml_hi_file = addBootSuffix (ml_hi_file locn)
144 , ml_obj_file = addBootSuffix (ml_obj_file locn) }
148 %************************************************************************
150 \subsection{The name of a module}
152 %************************************************************************
155 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
156 newtype ModuleName = ModuleName FastString
158 instance Uniquable ModuleName where
159 getUnique (ModuleName nm) = getUnique nm
161 instance Eq ModuleName where
162 nm1 == nm2 = getUnique nm1 == getUnique nm2
164 -- Warning: gives an ordering relation based on the uniques of the
165 -- FastStrings which are the (encoded) module names. This is _not_
166 -- a lexicographical ordering.
167 instance Ord ModuleName where
168 nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
170 instance Outputable ModuleName where
173 instance Binary ModuleName where
174 put_ bh (ModuleName fs) = put_ bh fs
175 get bh = do fs <- get bh; return (ModuleName fs)
177 INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
179 instance Data ModuleName where
181 toConstr _ = abstractConstr "ModuleName"
182 gunfold _ _ = error "gunfold"
183 dataTypeOf _ = mkNoRepType "ModuleName"
185 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
186 -- ^ Compares module names lexically, rather than by their 'Unique's
187 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
189 pprModuleName :: ModuleName -> SDoc
190 pprModuleName (ModuleName nm) =
191 getPprStyle $ \ sty ->
193 then ftext (zEncodeFS nm)
196 moduleNameFS :: ModuleName -> FastString
197 moduleNameFS (ModuleName mod) = mod
199 moduleNameString :: ModuleName -> String
200 moduleNameString (ModuleName mod) = unpackFS mod
202 mkModuleName :: String -> ModuleName
203 mkModuleName s = ModuleName (mkFastString s)
205 mkModuleNameFS :: FastString -> ModuleName
206 mkModuleNameFS s = ModuleName s
208 -- | Returns the string version of the module name, with dots replaced by slashes
209 moduleNameSlashes :: ModuleName -> String
210 moduleNameSlashes = dots_to_slashes . moduleNameString
211 where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
214 %************************************************************************
216 \subsection{A fully qualified module}
218 %************************************************************************
221 -- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
222 data Module = Module {
223 modulePackageId :: !PackageId, -- pkg-1.0
224 moduleName :: !ModuleName -- A.B.C
228 instance Uniquable Module where
229 getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
231 instance Outputable Module where
234 instance Binary Module where
235 put_ bh (Module p n) = put_ bh p >> put_ bh n
236 get bh = do p <- get bh; n <- get bh; return (Module p n)
238 INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
240 instance Data Module where
242 toConstr _ = abstractConstr "Module"
243 gunfold _ _ = error "gunfold"
244 dataTypeOf _ = mkNoRepType "Module"
246 -- | This gives a stable ordering, as opposed to the Ord instance which
247 -- gives an ordering based on the 'Unique's of the components, which may
248 -- not be stable from run to run of the compiler.
249 stableModuleCmp :: Module -> Module -> Ordering
250 stableModuleCmp (Module p1 n1) (Module p2 n2)
251 = (p1 `stablePackageIdCmp` p2) `thenCmp`
252 (n1 `stableModuleNameCmp` n2)
254 mkModule :: PackageId -> ModuleName -> Module
257 pprModule :: Module -> SDoc
258 pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n
260 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
261 pprPackagePrefix p mod = getPprStyle doc
265 if p == mainPackageId
266 then empty -- never qualify the main package in code
267 else ftext (zEncodeFS (packageIdFS p)) <> char '_'
268 | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
269 -- the PrintUnqualified tells us which modules have to
270 -- be qualified with package names
274 %************************************************************************
276 \subsection{PackageId}
278 %************************************************************************
281 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
282 newtype PackageId = PId FastString deriving( Eq )
283 -- here to avoid module loops with PackageConfig
285 instance Uniquable PackageId where
286 getUnique pid = getUnique (packageIdFS pid)
288 -- Note: *not* a stable lexicographic ordering, a faster unique-based
290 instance Ord PackageId where
291 nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
293 INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
295 instance Data PackageId where
297 toConstr _ = abstractConstr "PackageId"
298 gunfold _ _ = error "gunfold"
299 dataTypeOf _ = mkNoRepType "PackageId"
301 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
302 -- ^ Compares package ids lexically, rather than by their 'Unique's
303 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
305 instance Outputable PackageId where
306 ppr pid = text (packageIdString pid)
308 instance Binary PackageId where
309 put_ bh pid = put_ bh (packageIdFS pid)
310 get bh = do { fs <- get bh; return (fsToPackageId fs) }
312 fsToPackageId :: FastString -> PackageId
315 packageIdFS :: PackageId -> FastString
316 packageIdFS (PId fs) = fs
318 stringToPackageId :: String -> PackageId
319 stringToPackageId = fsToPackageId . mkFastString
321 packageIdString :: PackageId -> String
322 packageIdString = unpackFS . packageIdFS
325 -- -----------------------------------------------------------------------------
326 -- $wired_in_packages
327 -- Certain packages are known to the compiler, in that we know about certain
328 -- entities that reside in these packages, and the compiler needs to
329 -- declare static Modules and Names that refer to these packages. Hence
330 -- the wired-in packages can't include version numbers, since we don't want
331 -- to bake the version numbers of these packages into GHC.
333 -- So here's the plan. Wired-in packages are still versioned as
334 -- normal in the packages database, and you can still have multiple
335 -- versions of them installed. However, for each invocation of GHC,
336 -- only a single instance of each wired-in package will be recognised
337 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
338 -- will use the unversioned 'PackageId' below when referring to it,
339 -- including in .hi files and object file symbols. Unselected
340 -- versions of wired-in packages will be ignored, as will any other
341 -- package that depends directly or indirectly on it (much as if you
342 -- had used @-ignore-package@).
344 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
346 integerPackageId, primPackageId,
347 basePackageId, rtsPackageId, haskell98PackageId,
348 thPackageId, dphSeqPackageId, dphParPackageId,
349 mainPackageId :: PackageId
350 primPackageId = fsToPackageId (fsLit "ghc-prim")
351 integerPackageId = fsToPackageId (fsLit cIntegerLibrary)
352 basePackageId = fsToPackageId (fsLit "base")
353 rtsPackageId = fsToPackageId (fsLit "rts")
354 haskell98PackageId = fsToPackageId (fsLit "haskell98")
355 thPackageId = fsToPackageId (fsLit "template-haskell")
356 dphSeqPackageId = fsToPackageId (fsLit "dph-seq")
357 dphParPackageId = fsToPackageId (fsLit "dph-par")
359 -- | This is the package Id for the current program. It is the default
360 -- package Id if you don't specify a package name. We don't add this prefix
361 -- to symbol names, since there can be only one main package per program.
362 mainPackageId = fsToPackageId (fsLit "main")
365 %************************************************************************
367 \subsection{@ModuleEnv@s}
369 %************************************************************************
372 -- | A map keyed off of 'Module's
373 newtype ModuleEnv elt = ModuleEnv (FiniteMap Module elt)
375 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
376 filterModuleEnv f (ModuleEnv e) = ModuleEnv (filterFM f e)
378 elemModuleEnv :: Module -> ModuleEnv a -> Bool
379 elemModuleEnv m (ModuleEnv e) = elemFM m e
381 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
382 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (addToFM e m x)
384 extendModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
385 extendModuleEnv_C f (ModuleEnv e) m x = ModuleEnv (addToFM_C f e m x)
387 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
388 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (addListToFM e xs)
390 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
392 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (addListToFM_C f e xs)
394 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
395 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM_C f e1 e2)
397 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
398 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (delListFromFM e ms)
400 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
401 delModuleEnv (ModuleEnv e) m = ModuleEnv (delFromFM e m)
403 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
404 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM e1 e2)
406 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
407 lookupModuleEnv (ModuleEnv e) m = lookupFM e m
409 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
410 lookupWithDefaultModuleEnv (ModuleEnv e) x m = lookupWithDefaultFM e x m
412 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
413 mapModuleEnv f (ModuleEnv e) = ModuleEnv (mapFM (\_ v -> f v) e)
415 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
416 mkModuleEnv xs = ModuleEnv (listToFM xs)
418 emptyModuleEnv :: ModuleEnv a
419 emptyModuleEnv = ModuleEnv emptyFM
421 moduleEnvKeys :: ModuleEnv a -> [Module]
422 moduleEnvKeys (ModuleEnv e) = keysFM e
424 moduleEnvElts :: ModuleEnv a -> [a]
425 moduleEnvElts (ModuleEnv e) = eltsFM e
427 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
428 moduleEnvToList (ModuleEnv e) = fmToList e
430 unitModuleEnv :: Module -> a -> ModuleEnv a
431 unitModuleEnv m x = ModuleEnv (unitFM m x)
433 isEmptyModuleEnv :: ModuleEnv a -> Bool
434 isEmptyModuleEnv (ModuleEnv e) = isEmptyFM e
436 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
437 foldModuleEnv f x (ModuleEnv e) = foldFM (\_ v -> f v) x e
441 -- | A set of 'Module's
442 type ModuleSet = FiniteMap Module ()
444 mkModuleSet :: [Module] -> ModuleSet
445 extendModuleSet :: ModuleSet -> Module -> ModuleSet
446 emptyModuleSet :: ModuleSet
447 moduleSetElts :: ModuleSet -> [Module]
448 elemModuleSet :: Module -> ModuleSet -> Bool
450 emptyModuleSet = emptyFM
451 mkModuleSet ms = listToFM [(m,()) | m <- ms ]
452 extendModuleSet s m = addToFM s m ()
453 moduleSetElts = keysFM
454 elemModuleSet = elemFM
457 A ModuleName has a Unique, so we can build mappings of these using
461 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
462 type ModuleNameEnv elt = UniqFM elt