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
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, extendModuleEnvWith, filterModuleEnv,
65 -- * ModuleName mappings
70 emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
77 import qualified Pretty
86 import qualified Data.Map as Map
87 import qualified FiniteMap as Map
88 import System.FilePath
91 %************************************************************************
93 \subsection{Module locations}
95 %************************************************************************
98 -- | Where a module lives on the file system: the actual locations
99 -- of the .hs, .hi and .o files, if we have them
102 ml_hs_file :: Maybe FilePath,
103 -- The source file, if we have one. Package modules
104 -- probably don't have source files.
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)
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)
118 instance Outputable ModLocation where
122 For a module in another package, the hs_file and obj_file
123 components of ModLocation are undefined.
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.
131 addBootSuffix :: FilePath -> FilePath
132 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
133 addBootSuffix path = path ++ "-boot"
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
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) }
150 %************************************************************************
152 \subsection{The name of a module}
154 %************************************************************************
157 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
158 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_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
181 instance Data ModuleName where
183 toConstr _ = abstractConstr "ModuleName"
184 gunfold _ _ = error "gunfold"
185 dataTypeOf _ = mkNoRepType "ModuleName"
187 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
188 -- ^ Compares module names lexically, rather than by their 'Unique's
189 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
191 pprModuleName :: ModuleName -> SDoc
192 pprModuleName (ModuleName nm) =
193 getPprStyle $ \ sty ->
195 then ftext (zEncodeFS nm)
198 moduleNameFS :: ModuleName -> FastString
199 moduleNameFS (ModuleName mod) = mod
201 moduleNameString :: ModuleName -> String
202 moduleNameString (ModuleName mod) = unpackFS mod
204 mkModuleName :: String -> ModuleName
205 mkModuleName s = ModuleName (mkFastString s)
207 mkModuleNameFS :: FastString -> ModuleName
208 mkModuleNameFS s = ModuleName s
210 -- | Returns the string version of the module name, with dots replaced by slashes
211 moduleNameSlashes :: ModuleName -> String
212 moduleNameSlashes = dots_to_slashes . moduleNameString
213 where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
216 %************************************************************************
218 \subsection{A fully qualified module}
220 %************************************************************************
223 -- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
224 data Module = Module {
225 modulePackageId :: !PackageId, -- pkg-1.0
226 moduleName :: !ModuleName -- A.B.C
230 instance Uniquable Module where
231 getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
233 instance Outputable Module where
236 instance Binary Module where
237 put_ bh (Module p n) = put_ bh p >> put_ bh n
238 get bh = do p <- get bh; n <- get bh; return (Module p n)
240 INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
242 instance Data Module where
244 toConstr _ = abstractConstr "Module"
245 gunfold _ _ = error "gunfold"
246 dataTypeOf _ = mkNoRepType "Module"
248 -- | This gives a stable ordering, as opposed to the Ord instance which
249 -- gives an ordering based on the 'Unique's of the components, which may
250 -- not be stable from run to run of the compiler.
251 stableModuleCmp :: Module -> Module -> Ordering
252 stableModuleCmp (Module p1 n1) (Module p2 n2)
253 = (p1 `stablePackageIdCmp` p2) `thenCmp`
254 (n1 `stableModuleNameCmp` n2)
256 mkModule :: PackageId -> ModuleName -> Module
259 pprModule :: Module -> SDoc
260 pprModule mod@(Module p n) = pprPackagePrefix p mod <> pprModuleName n
262 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
263 pprPackagePrefix p mod = getPprStyle doc
267 if p == mainPackageId
268 then empty -- never qualify the main package in code
269 else ftext (zEncodeFS (packageIdFS p)) <> char '_'
270 | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
271 -- the PrintUnqualified tells us which modules have to
272 -- be qualified with package names
276 %************************************************************************
278 \subsection{PackageId}
280 %************************************************************************
283 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
284 newtype PackageId = PId FastString deriving( Eq )
285 -- here to avoid module loops with PackageConfig
287 instance Uniquable PackageId where
288 getUnique pid = getUnique (packageIdFS pid)
290 -- Note: *not* a stable lexicographic ordering, a faster unique-based
292 instance Ord PackageId where
293 nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
295 INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
297 instance Data PackageId where
299 toConstr _ = abstractConstr "PackageId"
300 gunfold _ _ = error "gunfold"
301 dataTypeOf _ = mkNoRepType "PackageId"
303 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
304 -- ^ Compares package ids lexically, rather than by their 'Unique's
305 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
307 instance Outputable PackageId where
308 ppr pid = text (packageIdString pid)
310 instance Binary PackageId where
311 put_ bh pid = put_ bh (packageIdFS pid)
312 get bh = do { fs <- get bh; return (fsToPackageId fs) }
314 fsToPackageId :: FastString -> PackageId
317 packageIdFS :: PackageId -> FastString
318 packageIdFS (PId fs) = fs
320 stringToPackageId :: String -> PackageId
321 stringToPackageId = fsToPackageId . mkFastString
323 packageIdString :: PackageId -> String
324 packageIdString = unpackFS . packageIdFS
327 -- -----------------------------------------------------------------------------
328 -- $wired_in_packages
329 -- Certain packages are known to the compiler, in that we know about certain
330 -- entities that reside in these packages, and the compiler needs to
331 -- declare static Modules and Names that refer to these packages. Hence
332 -- the wired-in packages can't include version numbers, since we don't want
333 -- to bake the version numbers of these packages into GHC.
335 -- So here's the plan. Wired-in packages are still versioned as
336 -- normal in the packages database, and you can still have multiple
337 -- versions of them installed. However, for each invocation of GHC,
338 -- only a single instance of each wired-in package will be recognised
339 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
340 -- will use the unversioned 'PackageId' below when referring to it,
341 -- including in .hi files and object file symbols. Unselected
342 -- versions of wired-in packages will be ignored, as will any other
343 -- package that depends directly or indirectly on it (much as if you
344 -- had used @-ignore-package@).
346 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
348 integerPackageId, primPackageId,
349 basePackageId, rtsPackageId, haskell98PackageId,
350 thPackageId, dphSeqPackageId, dphParPackageId,
351 mainPackageId :: PackageId
352 primPackageId = fsToPackageId (fsLit "ghc-prim")
353 integerPackageId = fsToPackageId (fsLit cIntegerLibrary)
354 basePackageId = fsToPackageId (fsLit "base")
355 rtsPackageId = fsToPackageId (fsLit "rts")
356 haskell98PackageId = fsToPackageId (fsLit "haskell98")
357 thPackageId = fsToPackageId (fsLit "template-haskell")
358 dphSeqPackageId = fsToPackageId (fsLit "dph-seq")
359 dphParPackageId = fsToPackageId (fsLit "dph-par")
361 -- | This is the package Id for the current program. It is the default
362 -- package Id if you don't specify a package name. We don't add this prefix
363 -- to symbol names, since there can be only one main package per program.
364 mainPackageId = fsToPackageId (fsLit "main")
367 %************************************************************************
369 \subsection{@ModuleEnv@s}
371 %************************************************************************
374 -- | A map keyed off of 'Module's
375 newtype ModuleEnv elt = ModuleEnv (Map Module elt)
377 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
378 filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
380 elemModuleEnv :: Module -> ModuleEnv a -> Bool
381 elemModuleEnv m (ModuleEnv e) = Map.member m e
383 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
384 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
386 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
387 extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
389 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
390 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
392 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
394 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
396 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
397 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
399 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
400 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
402 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
403 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
405 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
406 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
408 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
409 lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
411 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
412 lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
414 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
415 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
417 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
418 mkModuleEnv xs = ModuleEnv (Map.fromList xs)
420 emptyModuleEnv :: ModuleEnv a
421 emptyModuleEnv = ModuleEnv Map.empty
423 moduleEnvKeys :: ModuleEnv a -> [Module]
424 moduleEnvKeys (ModuleEnv e) = Map.keys e
426 moduleEnvElts :: ModuleEnv a -> [a]
427 moduleEnvElts (ModuleEnv e) = Map.elems e
429 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
430 moduleEnvToList (ModuleEnv e) = Map.toList e
432 unitModuleEnv :: Module -> a -> ModuleEnv a
433 unitModuleEnv m x = ModuleEnv (Map.singleton m x)
435 isEmptyModuleEnv :: ModuleEnv a -> Bool
436 isEmptyModuleEnv (ModuleEnv e) = Map.null e
438 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
439 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
443 -- | A set of 'Module's
444 type ModuleSet = Map Module ()
446 mkModuleSet :: [Module] -> ModuleSet
447 extendModuleSet :: ModuleSet -> Module -> ModuleSet
448 emptyModuleSet :: ModuleSet
449 moduleSetElts :: ModuleSet -> [Module]
450 elemModuleSet :: Module -> ModuleSet -> Bool
452 emptyModuleSet = Map.empty
453 mkModuleSet ms = Map.fromList [(m,()) | m <- ms ]
454 extendModuleSet s m = Map.insert m () s
455 moduleSetElts = Map.keys
456 elemModuleSet = Map.member
459 A ModuleName has a Unique, so we can build mappings of these using
463 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
464 type ModuleNameEnv elt = UniqFM elt