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
160 instance Uniquable ModuleName where
161 getUnique (ModuleName nm) = getUnique nm
163 instance Eq ModuleName where
164 nm1 == nm2 = getUnique nm1 == getUnique nm2
166 -- Warning: gives an ordering relation based on the uniques of the
167 -- FastStrings which are the (encoded) module names. This is _not_
168 -- a lexicographical ordering.
169 instance Ord ModuleName where
170 nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
172 instance Outputable ModuleName where
175 instance Binary ModuleName where
176 put_ bh (ModuleName fs) = put_ bh fs
177 get bh = do fs <- get bh; return (ModuleName fs)
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
226 deriving (Eq, Ord, Typeable)
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 Data Module where
240 toConstr _ = abstractConstr "Module"
241 gunfold _ _ = error "gunfold"
242 dataTypeOf _ = mkNoRepType "Module"
244 -- | This gives a stable ordering, as opposed to the Ord instance which
245 -- gives an ordering based on the 'Unique's of the components, which may
246 -- not be stable from run to run of the compiler.
247 stableModuleCmp :: Module -> Module -> Ordering
248 stableModuleCmp (Module p1 n1) (Module p2 n2)
249 = (p1 `stablePackageIdCmp` p2) `thenCmp`
250 (n1 `stableModuleNameCmp` n2)
252 mkModule :: PackageId -> ModuleName -> Module
255 pprModule :: Module -> SDoc
256 pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n
258 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
259 pprPackagePrefix p mod = getPprStyle doc
263 if p == mainPackageId
264 then empty -- never qualify the main package in code
265 else ftext (zEncodeFS (packageIdFS p)) <> char '_'
266 | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
267 -- the PrintUnqualified tells us which modules have to
268 -- be qualified with package names
272 %************************************************************************
274 \subsection{PackageId}
276 %************************************************************************
279 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
280 newtype PackageId = PId FastString deriving( Eq, Typeable )
281 -- here to avoid module loops with PackageConfig
283 instance Uniquable PackageId where
284 getUnique pid = getUnique (packageIdFS pid)
286 -- Note: *not* a stable lexicographic ordering, a faster unique-based
288 instance Ord PackageId where
289 nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
291 instance Data PackageId where
293 toConstr _ = abstractConstr "PackageId"
294 gunfold _ _ = error "gunfold"
295 dataTypeOf _ = mkNoRepType "PackageId"
297 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
298 -- ^ Compares package ids lexically, rather than by their 'Unique's
299 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
301 instance Outputable PackageId where
302 ppr pid = text (packageIdString pid)
304 instance Binary PackageId where
305 put_ bh pid = put_ bh (packageIdFS pid)
306 get bh = do { fs <- get bh; return (fsToPackageId fs) }
308 fsToPackageId :: FastString -> PackageId
311 packageIdFS :: PackageId -> FastString
312 packageIdFS (PId fs) = fs
314 stringToPackageId :: String -> PackageId
315 stringToPackageId = fsToPackageId . mkFastString
317 packageIdString :: PackageId -> String
318 packageIdString = unpackFS . packageIdFS
321 -- -----------------------------------------------------------------------------
322 -- $wired_in_packages
323 -- Certain packages are known to the compiler, in that we know about certain
324 -- entities that reside in these packages, and the compiler needs to
325 -- declare static Modules and Names that refer to these packages. Hence
326 -- the wired-in packages can't include version numbers, since we don't want
327 -- to bake the version numbers of these packages into GHC.
329 -- So here's the plan. Wired-in packages are still versioned as
330 -- normal in the packages database, and you can still have multiple
331 -- versions of them installed. However, for each invocation of GHC,
332 -- only a single instance of each wired-in package will be recognised
333 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
334 -- will use the unversioned 'PackageId' below when referring to it,
335 -- including in .hi files and object file symbols. Unselected
336 -- versions of wired-in packages will be ignored, as will any other
337 -- package that depends directly or indirectly on it (much as if you
338 -- had used @-ignore-package@).
340 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
342 integerPackageId, primPackageId,
343 basePackageId, rtsPackageId,
344 thPackageId, dphSeqPackageId, dphParPackageId,
345 mainPackageId :: PackageId
346 primPackageId = fsToPackageId (fsLit "ghc-prim")
347 integerPackageId = fsToPackageId (fsLit cIntegerLibrary)
348 basePackageId = fsToPackageId (fsLit "base")
349 rtsPackageId = fsToPackageId (fsLit "rts")
350 thPackageId = fsToPackageId (fsLit "template-haskell")
351 dphSeqPackageId = fsToPackageId (fsLit "dph-seq")
352 dphParPackageId = fsToPackageId (fsLit "dph-par")
354 -- | This is the package Id for the current program. It is the default
355 -- package Id if you don't specify a package name. We don't add this prefix
356 -- to symbol names, since there can be only one main package per program.
357 mainPackageId = fsToPackageId (fsLit "main")
360 %************************************************************************
362 \subsection{@ModuleEnv@s}
364 %************************************************************************
367 -- | A map keyed off of 'Module's
368 newtype ModuleEnv elt = ModuleEnv (Map Module elt)
370 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
371 filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
373 elemModuleEnv :: Module -> ModuleEnv a -> Bool
374 elemModuleEnv m (ModuleEnv e) = Map.member m e
376 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
377 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
379 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
380 extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
382 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
383 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
385 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
387 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
389 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
390 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
392 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
393 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
395 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
396 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
398 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
399 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
401 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
402 lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
404 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
405 lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
407 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
408 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
410 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
411 mkModuleEnv xs = ModuleEnv (Map.fromList xs)
413 emptyModuleEnv :: ModuleEnv a
414 emptyModuleEnv = ModuleEnv Map.empty
416 moduleEnvKeys :: ModuleEnv a -> [Module]
417 moduleEnvKeys (ModuleEnv e) = Map.keys e
419 moduleEnvElts :: ModuleEnv a -> [a]
420 moduleEnvElts (ModuleEnv e) = Map.elems e
422 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
423 moduleEnvToList (ModuleEnv e) = Map.toList e
425 unitModuleEnv :: Module -> a -> ModuleEnv a
426 unitModuleEnv m x = ModuleEnv (Map.singleton m x)
428 isEmptyModuleEnv :: ModuleEnv a -> Bool
429 isEmptyModuleEnv (ModuleEnv e) = Map.null e
431 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
432 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
436 -- | A set of 'Module's
437 type ModuleSet = Map Module ()
439 mkModuleSet :: [Module] -> ModuleSet
440 extendModuleSet :: ModuleSet -> Module -> ModuleSet
441 emptyModuleSet :: ModuleSet
442 moduleSetElts :: ModuleSet -> [Module]
443 elemModuleSet :: Module -> ModuleSet -> Bool
445 emptyModuleSet = Map.empty
446 mkModuleSet ms = Map.fromList [(m,()) | m <- ms ]
447 extendModuleSet s m = Map.insert m () s
448 moduleSetElts = Map.keys
449 elemModuleSet = Map.member
452 A ModuleName has a Unique, so we can build mappings of these using
456 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
457 type ModuleNameEnv elt = UniqFM elt