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 Maps with Modules as
14 -- * The ModuleName type
24 -- * The PackageId type
32 -- * Wired-in PackageIds
45 modulePackageId, moduleName,
50 -- * The ModuleLocation type
52 addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
56 elemModuleEnv, extendModuleEnv, extendModuleEnvList,
57 extendModuleEnvList_C, plusModuleEnv_C,
58 delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv,
59 lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv,
60 moduleEnvKeys, moduleEnvElts, moduleEnvToList,
61 unitModuleEnv, isEmptyModuleEnv,
62 foldModuleEnv, extendModuleEnvWith, filterModuleEnv,
64 -- * ModuleName mappings
69 emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
76 import qualified Pretty
85 import qualified Data.Map as Map
86 import qualified FiniteMap as Map
87 import System.FilePath
90 %************************************************************************
92 \subsection{Module locations}
94 %************************************************************************
97 -- | Where a module lives on the file system: the actual locations
98 -- of the .hs, .hi and .o files, if we have them
101 ml_hs_file :: Maybe FilePath,
102 -- The source file, if we have one. Package modules
103 -- probably don't have source files.
105 ml_hi_file :: FilePath,
106 -- Where the .hi file is, whether or not it exists
107 -- yet. Always of form foo.hi, even if there is an
108 -- hi-boot file (we add the -boot suffix later)
110 ml_obj_file :: FilePath
111 -- Where the .o file is, whether or not it exists yet.
112 -- (might not exist either because the module hasn't
113 -- been compiled yet, or because it is part of a
114 -- package with a .a file)
117 instance Outputable ModLocation where
121 For a module in another package, the hs_file and obj_file
122 components of ModLocation are undefined.
124 The locations specified by a ModLocation may or may not
125 correspond to actual files yet: for example, even if the object
126 file doesn't exist, the ModLocation still contains the path to
127 where the object file will reside if/when it is created.
130 addBootSuffix :: FilePath -> FilePath
131 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
132 addBootSuffix path = path ++ "-boot"
134 addBootSuffix_maybe :: Bool -> FilePath -> FilePath
135 -- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
136 addBootSuffix_maybe is_boot path
137 | is_boot = addBootSuffix path
140 addBootSuffixLocn :: ModLocation -> ModLocation
141 -- ^ Add the @-boot@ suffix to all file paths associated with the module
142 addBootSuffixLocn locn
143 = locn { ml_hs_file = fmap addBootSuffix (ml_hs_file locn)
144 , ml_hi_file = addBootSuffix (ml_hi_file locn)
145 , ml_obj_file = addBootSuffix (ml_obj_file locn) }
149 %************************************************************************
151 \subsection{The name of a module}
153 %************************************************************************
156 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
157 newtype ModuleName = ModuleName FastString
159 instance Uniquable ModuleName where
160 getUnique (ModuleName nm) = getUnique nm
162 instance Eq ModuleName where
163 nm1 == nm2 = getUnique nm1 == getUnique nm2
165 -- Warning: gives an ordering relation based on the uniques of the
166 -- FastStrings which are the (encoded) module names. This is _not_
167 -- a lexicographical ordering.
168 instance Ord ModuleName where
169 nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
171 instance Outputable ModuleName where
174 instance Binary ModuleName where
175 put_ bh (ModuleName fs) = put_ bh fs
176 get bh = do fs <- get bh; return (ModuleName fs)
178 INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
180 instance Data ModuleName where
182 toConstr _ = abstractConstr "ModuleName"
183 gunfold _ _ = error "gunfold"
184 dataTypeOf _ = mkNoRepType "ModuleName"
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
190 pprModuleName :: ModuleName -> SDoc
191 pprModuleName (ModuleName nm) =
192 getPprStyle $ \ sty ->
194 then ftext (zEncodeFS nm)
197 moduleNameFS :: ModuleName -> FastString
198 moduleNameFS (ModuleName mod) = mod
200 moduleNameString :: ModuleName -> String
201 moduleNameString (ModuleName mod) = unpackFS mod
203 mkModuleName :: String -> ModuleName
204 mkModuleName s = ModuleName (mkFastString s)
206 mkModuleNameFS :: FastString -> ModuleName
207 mkModuleNameFS s = ModuleName s
209 -- | Returns the string version of the module name, with dots replaced by slashes
210 moduleNameSlashes :: ModuleName -> String
211 moduleNameSlashes = dots_to_slashes . moduleNameString
212 where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
215 %************************************************************************
217 \subsection{A fully qualified module}
219 %************************************************************************
222 -- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
223 data Module = Module {
224 modulePackageId :: !PackageId, -- pkg-1.0
225 moduleName :: !ModuleName -- A.B.C
229 instance Uniquable Module where
230 getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
232 instance Outputable Module where
235 instance Binary Module where
236 put_ bh (Module p n) = put_ bh p >> put_ bh n
237 get bh = do p <- get bh; n <- get bh; return (Module p n)
239 INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
241 instance Data Module where
243 toConstr _ = abstractConstr "Module"
244 gunfold _ _ = error "gunfold"
245 dataTypeOf _ = mkNoRepType "Module"
247 -- | This gives a stable ordering, as opposed to the Ord instance which
248 -- gives an ordering based on the 'Unique's of the components, which may
249 -- not be stable from run to run of the compiler.
250 stableModuleCmp :: Module -> Module -> Ordering
251 stableModuleCmp (Module p1 n1) (Module p2 n2)
252 = (p1 `stablePackageIdCmp` p2) `thenCmp`
253 (n1 `stableModuleNameCmp` n2)
255 mkModule :: PackageId -> ModuleName -> Module
258 pprModule :: Module -> SDoc
259 pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n
261 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
262 pprPackagePrefix p mod = getPprStyle doc
266 if p == mainPackageId
267 then empty -- never qualify the main package in code
268 else ftext (zEncodeFS (packageIdFS p)) <> char '_'
269 | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
270 -- the PrintUnqualified tells us which modules have to
271 -- be qualified with package names
275 %************************************************************************
277 \subsection{PackageId}
279 %************************************************************************
282 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
283 newtype PackageId = PId FastString deriving( Eq )
284 -- here to avoid module loops with PackageConfig
286 instance Uniquable PackageId where
287 getUnique pid = getUnique (packageIdFS pid)
289 -- Note: *not* a stable lexicographic ordering, a faster unique-based
291 instance Ord PackageId where
292 nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
294 INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
296 instance Data PackageId where
298 toConstr _ = abstractConstr "PackageId"
299 gunfold _ _ = error "gunfold"
300 dataTypeOf _ = mkNoRepType "PackageId"
302 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
303 -- ^ Compares package ids lexically, rather than by their 'Unique's
304 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
306 instance Outputable PackageId where
307 ppr pid = text (packageIdString pid)
309 instance Binary PackageId where
310 put_ bh pid = put_ bh (packageIdFS pid)
311 get bh = do { fs <- get bh; return (fsToPackageId fs) }
313 fsToPackageId :: FastString -> PackageId
316 packageIdFS :: PackageId -> FastString
317 packageIdFS (PId fs) = fs
319 stringToPackageId :: String -> PackageId
320 stringToPackageId = fsToPackageId . mkFastString
322 packageIdString :: PackageId -> String
323 packageIdString = unpackFS . packageIdFS
326 -- -----------------------------------------------------------------------------
327 -- $wired_in_packages
328 -- Certain packages are known to the compiler, in that we know about certain
329 -- entities that reside in these packages, and the compiler needs to
330 -- declare static Modules and Names that refer to these packages. Hence
331 -- the wired-in packages can't include version numbers, since we don't want
332 -- to bake the version numbers of these packages into GHC.
334 -- So here's the plan. Wired-in packages are still versioned as
335 -- normal in the packages database, and you can still have multiple
336 -- versions of them installed. However, for each invocation of GHC,
337 -- only a single instance of each wired-in package will be recognised
338 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
339 -- will use the unversioned 'PackageId' below when referring to it,
340 -- including in .hi files and object file symbols. Unselected
341 -- versions of wired-in packages will be ignored, as will any other
342 -- package that depends directly or indirectly on it (much as if you
343 -- had used @-ignore-package@).
345 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
347 integerPackageId, primPackageId,
348 basePackageId, rtsPackageId,
349 thPackageId, dphSeqPackageId, dphParPackageId,
350 mainPackageId :: PackageId
351 primPackageId = fsToPackageId (fsLit "ghc-prim")
352 integerPackageId = fsToPackageId (fsLit cIntegerLibrary)
353 basePackageId = fsToPackageId (fsLit "base")
354 rtsPackageId = fsToPackageId (fsLit "rts")
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 (Map Module elt)
375 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
376 filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
378 elemModuleEnv :: Module -> ModuleEnv a -> Bool
379 elemModuleEnv m (ModuleEnv e) = Map.member m e
381 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
382 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
384 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
385 extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
387 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
388 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
390 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
392 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
394 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
395 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
397 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
398 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
400 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
401 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
403 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
404 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
406 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
407 lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
409 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
410 lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
412 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
413 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
415 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
416 mkModuleEnv xs = ModuleEnv (Map.fromList xs)
418 emptyModuleEnv :: ModuleEnv a
419 emptyModuleEnv = ModuleEnv Map.empty
421 moduleEnvKeys :: ModuleEnv a -> [Module]
422 moduleEnvKeys (ModuleEnv e) = Map.keys e
424 moduleEnvElts :: ModuleEnv a -> [a]
425 moduleEnvElts (ModuleEnv e) = Map.elems e
427 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
428 moduleEnvToList (ModuleEnv e) = Map.toList e
430 unitModuleEnv :: Module -> a -> ModuleEnv a
431 unitModuleEnv m x = ModuleEnv (Map.singleton m x)
433 isEmptyModuleEnv :: ModuleEnv a -> Bool
434 isEmptyModuleEnv (ModuleEnv e) = Map.null e
436 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
437 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
441 -- | A set of 'Module's
442 type ModuleSet = Map Module ()
444 mkModuleSet :: [Module] -> ModuleSet
445 extendModuleSet :: ModuleSet -> Module -> ModuleSet
446 emptyModuleSet :: ModuleSet
447 moduleSetElts :: ModuleSet -> [Module]
448 elemModuleSet :: Module -> ModuleSet -> Bool
450 emptyModuleSet = Map.empty
451 mkModuleSet ms = Map.fromList [(m,()) | m <- ms ]
452 extendModuleSet s m = Map.insert m () s
453 moduleSetElts = Map.keys
454 elemModuleSet = Map.member
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