compiler/basicTypes/Module.lhs

   1 %
   2 % (c) The University of Glasgow, 2004-2006
   3 %
   4
   5 Module
   6 ~~~~~~~~~~
   7 Simply the name of a module, represented as a FastString.
   8 These are Uniquable, hence we can build Maps with Modules as
   9 the keys.
  10
  11 \begin{code}
  12 module Module
  13     (
  14         -- * The ModuleName type
  15         ModuleName,
  16         pprModuleName,
  17         moduleNameFS,
  18         moduleNameString,
  19         moduleNameSlashes,
  20         mkModuleName,
  21         mkModuleNameFS,
  22         stableModuleNameCmp,
  23
  24         -- * The PackageId type
  25         PackageId,
  26         fsToPackageId,
  27         packageIdFS,
  28         stringToPackageId,
  29         packageIdString,
  30         stablePackageIdCmp,
  31
  32         -- * Wired-in PackageIds
  33         -- $wired_in_packages
  34         primPackageId,
  35         integerPackageId,
  36         basePackageId,
  37         rtsPackageId,
  38         thPackageId,
  39         dphSeqPackageId,
  40         dphParPackageId,
  41         mainPackageId,
  42
  43         -- * The Module type
  44         Module,
  45         modulePackageId, moduleName,
  46         pprModule,
  47         mkModule,
  48         stableModuleCmp,
  49
  50         -- * The ModuleLocation type
  51         ModLocation(..),
  52         addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
  53
  54         -- * Module mappings
  55         ModuleEnv,
  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,
  63
  64         -- * ModuleName mappings
  65         ModuleNameEnv,
  66
  67         -- * Sets of Modules
  68         ModuleSet,
  69         emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
  70     ) where
  71
  72 #include "Typeable.h"
  73
  74 import Config
  75 import Outputable
  76 import Unique
  77 import UniqFM
  78 import FastString
  79 import Binary
  80 import Util
  81
  82 import Data.Data
  83 import Data.Map (Map)
  84 import qualified Data.Map as Map
  85 import qualified FiniteMap as Map
  86 import System.FilePath
  87 \end{code}
  88
  89 %************************************************************************
  90 %*                                                                      *
  91 \subsection{Module locations}
  92 %*                                                                      *
  93 %************************************************************************
  94
  95 \begin{code}
  96 -- | Where a module lives on the file system: the actual locations
  97 -- of the .hs, .hi and .o files, if we have them
  98 data ModLocation
  99    = ModLocation {
 100         ml_hs_file   :: Maybe FilePath,
 101                 -- The source file, if we have one.  Package modules
 102                 -- probably don't have source files.
 103
 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)
 108
 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)
 114   } deriving Show
 115
 116 instance Outputable ModLocation where
 117    ppr = text . show
 118 \end{code}
 119
 120 For a module in another package, the hs_file and obj_file
 121 components of ModLocation are undefined.
 122
 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.
 127
 128 \begin{code}
 129 addBootSuffix :: FilePath -> FilePath
 130 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
 131 addBootSuffix path = path ++ "-boot"
 132
 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
 137  | otherwise = path
 138
 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) }
 145 \end{code}
 146
 147
 148 %************************************************************************
 149 %*                                                                      *
 150 \subsection{The name of a module}
 151 %*                                                                      *
 152 %************************************************************************
 153
 154 \begin{code}
 155 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
 156 newtype ModuleName = ModuleName FastString
 157     deriving Typeable
 158
 159 instance Uniquable ModuleName where
 160   getUnique (ModuleName nm) = getUnique nm
 161
 162 instance Eq ModuleName where
 163   nm1 == nm2 = getUnique nm1 == getUnique nm2
 164
 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
 170
 171 instance Outputable ModuleName where
 172   ppr = pprModuleName
 173
 174 instance Binary ModuleName where
 175   put_ bh (ModuleName fs) = put_ bh fs
 176   get bh = do fs <- get bh; return (ModuleName fs)
 177
 178 instance Data ModuleName where
 179   -- don't traverse?
 180   toConstr _   = abstractConstr "ModuleName"
 181   gunfold _ _  = error "gunfold"
 182   dataTypeOf _ = mkNoRepType "ModuleName"
 183
 184 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
 185 -- ^ Compares module names lexically, rather than by their 'Unique's
 186 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
 187
 188 pprModuleName :: ModuleName -> SDoc
 189 pprModuleName (ModuleName nm) =
 190     getPprStyle $ \ sty ->
 191     if codeStyle sty
 192         then ftext (zEncodeFS nm)
 193         else ftext nm
 194
 195 moduleNameFS :: ModuleName -> FastString
 196 moduleNameFS (ModuleName mod) = mod
 197
 198 moduleNameString :: ModuleName -> String
 199 moduleNameString (ModuleName mod) = unpackFS mod
 200
 201 mkModuleName :: String -> ModuleName
 202 mkModuleName s = ModuleName (mkFastString s)
 203
 204 mkModuleNameFS :: FastString -> ModuleName
 205 mkModuleNameFS s = ModuleName s
 206
 207 -- | Returns the string version of the module name, with dots replaced by slashes
 208 moduleNameSlashes :: ModuleName -> String
 209 moduleNameSlashes = dots_to_slashes . moduleNameString
 210   where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
 211 \end{code}
 212
 213 %************************************************************************
 214 %*                                                                      *
 215 \subsection{A fully qualified module}
 216 %*                                                                      *
 217 %************************************************************************
 218
 219 \begin{code}
 220 -- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
 221 data Module = Module {
 222    modulePackageId :: !PackageId,  -- pkg-1.0
 223    moduleName      :: !ModuleName  -- A.B.C
 224   }
 225   deriving (Eq, Ord, Typeable)
 226
 227 instance Uniquable Module where
 228   getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
 229
 230 instance Outputable Module where
 231   ppr = pprModule
 232
 233 instance Binary Module where
 234   put_ bh (Module p n) = put_ bh p >> put_ bh n
 235   get bh = do p <- get bh; n <- get bh; return (Module p n)
 236
 237 instance Data Module where
 238   -- don't traverse?
 239   toConstr _   = abstractConstr "Module"
 240   gunfold _ _  = error "gunfold"
 241   dataTypeOf _ = mkNoRepType "Module"
 242
 243 -- | This gives a stable ordering, as opposed to the Ord instance which
 244 -- gives an ordering based on the 'Unique's of the components, which may
 245 -- not be stable from run to run of the compiler.
 246 stableModuleCmp :: Module -> Module -> Ordering
 247 stableModuleCmp (Module p1 n1) (Module p2 n2)
 248    = (p1 `stablePackageIdCmp`  p2) `thenCmp`
 249      (n1 `stableModuleNameCmp` n2)
 250
 251 mkModule :: PackageId -> ModuleName -> Module
 252 mkModule = Module
 253
 254 pprModule :: Module -> SDoc
 255 pprModule mod@(Module p n)  =
 256   pprPackagePrefix p mod <> pprModuleName n
 257
 258 pprPackagePrefix :: PackageId -> Module -> SDoc
 259 pprPackagePrefix p mod = getPprStyle doc
 260  where
 261    doc sty
 262        | codeStyle sty =
 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
 269        | otherwise = empty
 270 \end{code}
 271
 272 %************************************************************************
 273 %*                                                                      *
 274 \subsection{PackageId}
 275 %*                                                                      *
 276 %************************************************************************
 277
 278 \begin{code}
 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
 282
 283 instance Uniquable PackageId where
 284  getUnique pid = getUnique (packageIdFS pid)
 285
 286 -- Note: *not* a stable lexicographic ordering, a faster unique-based
 287 -- ordering.
 288 instance Ord PackageId where
 289   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 290
 291 instance Data PackageId where
 292   -- don't traverse?
 293   toConstr _   = abstractConstr "PackageId"
 294   gunfold _ _  = error "gunfold"
 295   dataTypeOf _ = mkNoRepType "PackageId"
 296
 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
 300
 301 instance Outputable PackageId where
 302    ppr pid = text (packageIdString pid)
 303
 304 instance Binary PackageId where
 305   put_ bh pid = put_ bh (packageIdFS pid)
 306   get bh = do { fs <- get bh; return (fsToPackageId fs) }
 307
 308 fsToPackageId :: FastString -> PackageId
 309 fsToPackageId = PId
 310
 311 packageIdFS :: PackageId -> FastString
 312 packageIdFS (PId fs) = fs
 313
 314 stringToPackageId :: String -> PackageId
 315 stringToPackageId = fsToPackageId . mkFastString
 316
 317 packageIdString :: PackageId -> String
 318 packageIdString = unpackFS . packageIdFS
 319
 320
 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.
 328 --
 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@).
 339
 340 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
 341
 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")
 353
 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")
 358 \end{code}
 359
 360 %************************************************************************
 361 %*                                                                      *
 362 \subsection{@ModuleEnv@s}
 363 %*                                                                      *
 364 %************************************************************************
 365
 366 \begin{code}
 367 -- | A map keyed off of 'Module's
 368 newtype ModuleEnv elt = ModuleEnv (Map Module elt)
 369
 370 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
 371 filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
 372
 373 elemModuleEnv :: Module -> ModuleEnv a -> Bool
 374 elemModuleEnv m (ModuleEnv e) = Map.member m e
 375
 376 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
 377 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
 378
 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)
 381
 382 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
 383 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
 384
 385 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
 386                       -> ModuleEnv a
 387 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
 388
 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)
 391
 392 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
 393 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
 394
 395 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
 396 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
 397
 398 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
 399 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
 400
 401 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
 402 lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
 403
 404 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
 405 lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
 406
 407 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
 408 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
 409
 410 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
 411 mkModuleEnv xs = ModuleEnv (Map.fromList xs)
 412
 413 emptyModuleEnv :: ModuleEnv a
 414 emptyModuleEnv = ModuleEnv Map.empty
 415
 416 moduleEnvKeys :: ModuleEnv a -> [Module]
 417 moduleEnvKeys (ModuleEnv e) = Map.keys e
 418
 419 moduleEnvElts :: ModuleEnv a -> [a]
 420 moduleEnvElts (ModuleEnv e) = Map.elems e
 421
 422 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
 423 moduleEnvToList (ModuleEnv e) = Map.toList e
 424
 425 unitModuleEnv :: Module -> a -> ModuleEnv a
 426 unitModuleEnv m x = ModuleEnv (Map.singleton m x)
 427
 428 isEmptyModuleEnv :: ModuleEnv a -> Bool
 429 isEmptyModuleEnv (ModuleEnv e) = Map.null e
 430
 431 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
 432 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
 433 \end{code}
 434
 435 \begin{code}
 436 -- | A set of 'Module's
 437 type ModuleSet = Map Module ()
 438
 439 mkModuleSet     :: [Module] -> ModuleSet
 440 extendModuleSet :: ModuleSet -> Module -> ModuleSet
 441 emptyModuleSet  :: ModuleSet
 442 moduleSetElts   :: ModuleSet -> [Module]
 443 elemModuleSet   :: Module -> ModuleSet -> Bool
 444
 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
 450 \end{code}
 451
 452 A ModuleName has a Unique, so we can build mappings of these using
 453 UniqFM.
 454
 455 \begin{code}
 456 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 457 type ModuleNameEnv elt = UniqFM elt
 458 \end{code}