PageRenderTime 91ms CodeModel.GetById 2ms app.highlight 79ms RepoModel.GetById 1ms app.codeStats 1ms

/compiler/basicTypes/Module.lhs

https://bitbucket.org/carter/ghc
Haskell | 469 lines | 302 code | 96 blank | 71 comment | 15 complexity | 16e81c4c1fc357a9dd769a0657443f31 MD5 | raw file
  1%
  2% (c) The University of Glasgow, 2004-2006
  3%
  4
  5Module
  6~~~~~~~~~~
  7Simply the name of a module, represented as a FastString.
  8These are Uniquable, hence we can build Maps with Modules as
  9the keys.
 10
 11\begin{code}
 12
 13module 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
 76import Config
 77import Outputable
 78import Unique
 79import UniqFM
 80import FastString
 81import Binary
 82import Util
 83
 84import Data.Data
 85import Data.Map (Map)
 86import qualified Data.Map as Map
 87import qualified FiniteMap as Map
 88import 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
100data 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
118instance Outputable ModLocation where
119   ppr = text . show
120\end{code}
121
122For a module in another package, the hs_file and obj_file
123components of ModLocation are undefined.
124
125The locations specified by a ModLocation may or may not
126correspond to actual files yet: for example, even if the object
127file doesn't exist, the ModLocation still contains the path to
128where the object file will reside if/when it is created.
129
130\begin{code}
131addBootSuffix :: FilePath -> FilePath
132-- ^ Add the @-boot@ suffix to .hs, .hi and .o files
133addBootSuffix path = path ++ "-boot"
134
135addBootSuffix_maybe :: Bool -> FilePath -> FilePath
136-- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
137addBootSuffix_maybe is_boot path
138 | is_boot   = addBootSuffix path
139 | otherwise = path
140
141addBootSuffixLocn :: ModLocation -> ModLocation
142-- ^ Add the @-boot@ suffix to all file paths associated with the module
143addBootSuffixLocn 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@.
158newtype ModuleName = ModuleName FastString
159    deriving Typeable
160
161instance Uniquable ModuleName where
162  getUnique (ModuleName nm) = getUnique nm
163
164instance 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.
170instance Ord ModuleName where
171  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
172
173instance Outputable ModuleName where
174  ppr = pprModuleName
175
176instance Binary ModuleName where
177  put_ bh (ModuleName fs) = put_ bh fs
178  get bh = do fs <- get bh; return (ModuleName fs)
179
180instance Data ModuleName where
181  -- don't traverse?
182  toConstr _   = abstractConstr "ModuleName"
183  gunfold _ _  = error "gunfold"
184  dataTypeOf _ = mkNoRepType "ModuleName"
185
186stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
187-- ^ Compares module names lexically, rather than by their 'Unique's
188stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
189
190pprModuleName :: ModuleName -> SDoc
191pprModuleName (ModuleName nm) =
192    getPprStyle $ \ sty ->
193    if codeStyle sty
194        then ztext (zEncodeFS nm)
195        else ftext nm
196
197moduleNameFS :: ModuleName -> FastString
198moduleNameFS (ModuleName mod) = mod
199
200moduleNameString :: ModuleName -> String
201moduleNameString (ModuleName mod) = unpackFS mod
202
203mkModuleName :: String -> ModuleName
204mkModuleName s = ModuleName (mkFastString s)
205
206mkModuleNameFS :: FastString -> ModuleName
207mkModuleNameFS s = ModuleName s
208
209-- |Returns the string version of the module name, with dots replaced by slashes.
210--
211moduleNameSlashes :: ModuleName -> String
212moduleNameSlashes = 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--
217moduleNameColons :: ModuleName -> String
218moduleNameColons = 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'.
230data Module = Module {
231   modulePackageId :: !PackageId,  -- pkg-1.0
232   moduleName      :: !ModuleName  -- A.B.C
233  }
234  deriving (Eq, Ord, Typeable)
235
236instance Uniquable Module where
237  getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
238
239instance Outputable Module where
240  ppr = pprModule
241
242instance 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
246instance 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.
255stableModuleCmp :: Module -> Module -> Ordering
256stableModuleCmp (Module p1 n1) (Module p2 n2)
257   = (p1 `stablePackageIdCmp`  p2) `thenCmp`
258     (n1 `stableModuleNameCmp` n2)
259
260mkModule :: PackageId -> ModuleName -> Module
261mkModule = Module
262
263pprModule :: Module -> SDoc
264pprModule mod@(Module p n)  =
265  pprPackagePrefix p mod <> pprModuleName n
266
267pprPackagePrefix :: PackageId -> Module -> SDoc
268pprPackagePrefix 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 ztext (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
289newtype PackageId = PId FastString deriving( Eq, Typeable )
290    -- here to avoid module loops with PackageConfig
291
292instance Uniquable PackageId where
293 getUnique pid = getUnique (packageIdFS pid)
294
295-- Note: *not* a stable lexicographic ordering, a faster unique-based
296-- ordering.
297instance Ord PackageId where
298  nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
299
300instance Data PackageId where
301  -- don't traverse?
302  toConstr _   = abstractConstr "PackageId"
303  gunfold _ _  = error "gunfold"
304  dataTypeOf _ = mkNoRepType "PackageId"
305
306stablePackageIdCmp :: PackageId -> PackageId -> Ordering
307-- ^ Compares package ids lexically, rather than by their 'Unique's
308stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
309
310instance Outputable PackageId where
311   ppr pid = text (packageIdString pid)
312
313instance Binary PackageId where
314  put_ bh pid = put_ bh (packageIdFS pid)
315  get bh = do { fs <- get bh; return (fsToPackageId fs) }
316
317fsToPackageId :: FastString -> PackageId
318fsToPackageId = PId
319
320packageIdFS :: PackageId -> FastString
321packageIdFS (PId fs) = fs
322
323stringToPackageId :: String -> PackageId
324stringToPackageId = fsToPackageId . mkFastString
325
326packageIdString :: PackageId -> String
327packageIdString = 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
351integerPackageId, primPackageId,
352  basePackageId, rtsPackageId,
353  thPackageId, dphSeqPackageId, dphParPackageId,
354  mainPackageId, thisGhcPackageId  :: PackageId
355primPackageId      = fsToPackageId (fsLit "ghc-prim")
356integerPackageId   = fsToPackageId (fsLit cIntegerLibrary)
357basePackageId      = fsToPackageId (fsLit "base")
358rtsPackageId       = fsToPackageId (fsLit "rts")
359thPackageId        = fsToPackageId (fsLit "template-haskell")
360dphSeqPackageId    = fsToPackageId (fsLit "dph-seq")
361dphParPackageId    = fsToPackageId (fsLit "dph-par")
362thisGhcPackageId   = 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.
367mainPackageId      = 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
378newtype ModuleEnv elt = ModuleEnv (Map Module elt)
379
380filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
381filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
382
383elemModuleEnv :: Module -> ModuleEnv a -> Bool
384elemModuleEnv m (ModuleEnv e) = Map.member m e
385
386extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
387extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
388
389extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
390extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
391
392extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
393extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
394
395extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
396                      -> ModuleEnv a
397extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
398
399plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
400plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
401
402delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
403delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
404
405delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
406delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
407
408plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
409plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
410
411lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
412lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
413
414lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
415lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
416
417mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
418mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
419
420mkModuleEnv :: [(Module, a)] -> ModuleEnv a
421mkModuleEnv xs = ModuleEnv (Map.fromList xs)
422
423emptyModuleEnv :: ModuleEnv a
424emptyModuleEnv = ModuleEnv Map.empty
425
426moduleEnvKeys :: ModuleEnv a -> [Module]
427moduleEnvKeys (ModuleEnv e) = Map.keys e
428
429moduleEnvElts :: ModuleEnv a -> [a]
430moduleEnvElts (ModuleEnv e) = Map.elems e
431
432moduleEnvToList :: ModuleEnv a -> [(Module, a)]
433moduleEnvToList (ModuleEnv e) = Map.toList e
434
435unitModuleEnv :: Module -> a -> ModuleEnv a
436unitModuleEnv m x = ModuleEnv (Map.singleton m x)
437
438isEmptyModuleEnv :: ModuleEnv a -> Bool
439isEmptyModuleEnv (ModuleEnv e) = Map.null e
440
441foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
442foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
443\end{code}
444
445\begin{code}
446-- | A set of 'Module's
447type ModuleSet = Map Module ()
448
449mkModuleSet     :: [Module] -> ModuleSet
450extendModuleSet :: ModuleSet -> Module -> ModuleSet
451emptyModuleSet  :: ModuleSet
452moduleSetElts   :: ModuleSet -> [Module]
453elemModuleSet   :: Module -> ModuleSet -> Bool
454
455emptyModuleSet    = Map.empty
456mkModuleSet ms    = Map.fromList [(m,()) | m <- ms ]
457extendModuleSet s m = Map.insert m () s
458moduleSetElts     = Map.keys
459elemModuleSet     = Map.member
460\end{code}
461
462A ModuleName has a Unique, so we can build mappings of these using
463UniqFM.
464
465\begin{code}
466-- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
467type ModuleNameEnv elt = UniqFM elt
468\end{code}
469