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
 158 instance Uniquable ModuleName where
 159   getUnique (ModuleName nm) = getUnique nm
 160
 161 instance Eq ModuleName where
 162   nm1 == nm2 = getUnique nm1 == getUnique nm2
 163
 164 -- Warning: gives an ordering relation based on the uniques of the
 165 -- FastStrings which are the (encoded) module names.  This is _not_
 166 -- a lexicographical ordering.
 167 instance Ord ModuleName where
 168   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 169
 170 instance Outputable ModuleName where
 171   ppr = pprModuleName
 172
 173 instance Binary ModuleName where
 174   put_ bh (ModuleName fs) = put_ bh fs
 175   get bh = do fs <- get bh; return (ModuleName fs)
 176
 177 INSTANCE_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
 178
 179 instance Data ModuleName where
 180   -- don't traverse?
 181   toConstr _   = abstractConstr "ModuleName"
 182   gunfold _ _  = error "gunfold"
 183   dataTypeOf _ = mkNoRepType "ModuleName"
 184
 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
 188
 189 pprModuleName :: ModuleName -> SDoc
 190 pprModuleName (ModuleName nm) =
 191     getPprStyle $ \ sty ->
 192     if codeStyle sty
 193         then ftext (zEncodeFS nm)
 194         else ftext nm
 195
 196 moduleNameFS :: ModuleName -> FastString
 197 moduleNameFS (ModuleName mod) = mod
 198
 199 moduleNameString :: ModuleName -> String
 200 moduleNameString (ModuleName mod) = unpackFS mod
 201
 202 mkModuleName :: String -> ModuleName
 203 mkModuleName s = ModuleName (mkFastString s)
 204
 205 mkModuleNameFS :: FastString -> ModuleName
 206 mkModuleNameFS s = ModuleName s
 207
 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)
 212 \end{code}
 213
 214 %************************************************************************
 215 %*                                                                      *
 216 \subsection{A fully qualified module}
 217 %*                                                                      *
 218 %************************************************************************
 219
 220 \begin{code}
 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
 225   }
 226   deriving (Eq, Ord)
 227
 228 instance Uniquable Module where
 229   getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
 230
 231 instance Outputable Module where
 232   ppr = pprModule
 233
 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)
 237
 238 INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
 239
 240 instance Data Module where
 241   -- don't traverse?
 242   toConstr _   = abstractConstr "Module"
 243   gunfold _ _  = error "gunfold"
 244   dataTypeOf _ = mkNoRepType "Module"
 245
 246 -- | This gives a stable ordering, as opposed to the Ord instance which
 247 -- gives an ordering based on the 'Unique's of the components, which may
 248 -- not be stable from run to run of the compiler.
 249 stableModuleCmp :: Module -> Module -> Ordering
 250 stableModuleCmp (Module p1 n1) (Module p2 n2)
 251    = (p1 `stablePackageIdCmp`  p2) `thenCmp`
 252      (n1 `stableModuleNameCmp` n2)
 253
 254 mkModule :: PackageId -> ModuleName -> Module
 255 mkModule = Module
 256
 257 pprModule :: Module -> SDoc
 258 pprModule mod@(Module p n)  =
 259   pprPackagePrefix p mod <> pprModuleName n
 260
 261 pprPackagePrefix :: PackageId -> Module -> SDoc
 262 pprPackagePrefix p mod = getPprStyle doc
 263  where
 264    doc sty
 265        | codeStyle sty =
 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
 272        | otherwise = empty
 273 \end{code}
 274
 275 %************************************************************************
 276 %*                                                                      *
 277 \subsection{PackageId}
 278 %*                                                                      *
 279 %************************************************************************
 280
 281 \begin{code}
 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
 285
 286 instance Uniquable PackageId where
 287  getUnique pid = getUnique (packageIdFS pid)
 288
 289 -- Note: *not* a stable lexicographic ordering, a faster unique-based
 290 -- ordering.
 291 instance Ord PackageId where
 292   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 293
 294 INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
 295
 296 instance Data PackageId where
 297   -- don't traverse?
 298   toConstr _   = abstractConstr "PackageId"
 299   gunfold _ _  = error "gunfold"
 300   dataTypeOf _ = mkNoRepType "PackageId"
 301
 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
 305
 306 instance Outputable PackageId where
 307    ppr pid = text (packageIdString pid)
 308
 309 instance Binary PackageId where
 310   put_ bh pid = put_ bh (packageIdFS pid)
 311   get bh = do { fs <- get bh; return (fsToPackageId fs) }
 312
 313 fsToPackageId :: FastString -> PackageId
 314 fsToPackageId = PId
 315
 316 packageIdFS :: PackageId -> FastString
 317 packageIdFS (PId fs) = fs
 318
 319 stringToPackageId :: String -> PackageId
 320 stringToPackageId = fsToPackageId . mkFastString
 321
 322 packageIdString :: PackageId -> String
 323 packageIdString = unpackFS . packageIdFS
 324
 325
 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.
 333 --
 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@).
 344
 345 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
 346
 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")
 358
 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")
 363 \end{code}
 364
 365 %************************************************************************
 366 %*                                                                      *
 367 \subsection{@ModuleEnv@s}
 368 %*                                                                      *
 369 %************************************************************************
 370
 371 \begin{code}
 372 -- | A map keyed off of 'Module's
 373 newtype ModuleEnv elt = ModuleEnv (Map Module elt)
 374
 375 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
 376 filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
 377
 378 elemModuleEnv :: Module -> ModuleEnv a -> Bool
 379 elemModuleEnv m (ModuleEnv e) = Map.member m e
 380
 381 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
 382 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
 383
 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)
 386
 387 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
 388 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
 389
 390 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
 391                       -> ModuleEnv a
 392 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
 393
 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)
 396
 397 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
 398 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
 399
 400 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
 401 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
 402
 403 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
 404 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
 405
 406 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
 407 lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
 408
 409 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
 410 lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
 411
 412 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
 413 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
 414
 415 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
 416 mkModuleEnv xs = ModuleEnv (Map.fromList xs)
 417
 418 emptyModuleEnv :: ModuleEnv a
 419 emptyModuleEnv = ModuleEnv Map.empty
 420
 421 moduleEnvKeys :: ModuleEnv a -> [Module]
 422 moduleEnvKeys (ModuleEnv e) = Map.keys e
 423
 424 moduleEnvElts :: ModuleEnv a -> [a]
 425 moduleEnvElts (ModuleEnv e) = Map.elems e
 426
 427 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
 428 moduleEnvToList (ModuleEnv e) = Map.toList e
 429
 430 unitModuleEnv :: Module -> a -> ModuleEnv a
 431 unitModuleEnv m x = ModuleEnv (Map.singleton m x)
 432
 433 isEmptyModuleEnv :: ModuleEnv a -> Bool
 434 isEmptyModuleEnv (ModuleEnv e) = Map.null e
 435
 436 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
 437 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
 438 \end{code}
 439
 440 \begin{code}
 441 -- | A set of 'Module's
 442 type ModuleSet = Map Module ()
 443
 444 mkModuleSet     :: [Module] -> ModuleSet
 445 extendModuleSet :: ModuleSet -> Module -> ModuleSet
 446 emptyModuleSet  :: ModuleSet
 447 moduleSetElts   :: ModuleSet -> [Module]
 448 elemModuleSet   :: Module -> ModuleSet -> Bool
 449
 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
 455 \end{code}
 456
 457 A ModuleName has a Unique, so we can build mappings of these using
 458 UniqFM.
 459
 460 \begin{code}
 461 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 462 type ModuleNameEnv elt = UniqFM elt
 463 \end{code}