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 FiniteMaps 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         haskell98PackageId,
  39         thPackageId,
  40         dphSeqPackageId,
  41         dphParPackageId,
  42         mainPackageId,
  43
  44         -- * The Module type
  45         Module,
  46         modulePackageId, moduleName,
  47         pprModule,
  48         mkModule,
  49         stableModuleCmp,
  50
  51         -- * The ModuleLocation type
  52         ModLocation(..),
  53         addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
  54
  55         -- * Module mappings
  56         ModuleEnv,
  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, extendModuleEnv_C, filterModuleEnv,
  64
  65         -- * ModuleName mappings
  66         ModuleNameEnv,
  67
  68         -- * Sets of Modules
  69         ModuleSet,
  70         emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
  71     ) where
  72
  73 #include "Typeable.h"
  74
  75 import Config
  76 import Outputable
  77 import qualified Pretty
  78 import Unique
  79 import FiniteMap
  80 import UniqFM
  81 import FastString
  82 import Binary
  83 import Util
  84
  85 import Data.Data
  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)  = pprPackagePrefix p mod <> pprModuleName n
 259
 260 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
 261 pprPackagePrefix p mod = getPprStyle doc
 262  where
 263    doc sty
 264        | codeStyle sty =
 265           if p == mainPackageId
 266                 then empty -- never qualify the main package in code
 267                 else ftext (zEncodeFS (packageIdFS p)) <> char '_'
 268        | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
 269                 -- the PrintUnqualified tells us which modules have to
 270                 -- be qualified with package names
 271        | otherwise = empty
 272 \end{code}
 273
 274 %************************************************************************
 275 %*                                                                      *
 276 \subsection{PackageId}
 277 %*                                                                      *
 278 %************************************************************************
 279
 280 \begin{code}
 281 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
 282 newtype PackageId = PId FastString deriving( Eq )
 283     -- here to avoid module loops with PackageConfig
 284
 285 instance Uniquable PackageId where
 286  getUnique pid = getUnique (packageIdFS pid)
 287
 288 -- Note: *not* a stable lexicographic ordering, a faster unique-based
 289 -- ordering.
 290 instance Ord PackageId where
 291   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 292
 293 INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
 294
 295 instance Data PackageId where
 296   -- don't traverse?
 297   toConstr _   = abstractConstr "PackageId"
 298   gunfold _ _  = error "gunfold"
 299   dataTypeOf _ = mkNoRepType "PackageId"
 300
 301 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
 302 -- ^ Compares package ids lexically, rather than by their 'Unique's
 303 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
 304
 305 instance Outputable PackageId where
 306    ppr pid = text (packageIdString pid)
 307
 308 instance Binary PackageId where
 309   put_ bh pid = put_ bh (packageIdFS pid)
 310   get bh = do { fs <- get bh; return (fsToPackageId fs) }
 311
 312 fsToPackageId :: FastString -> PackageId
 313 fsToPackageId = PId
 314
 315 packageIdFS :: PackageId -> FastString
 316 packageIdFS (PId fs) = fs
 317
 318 stringToPackageId :: String -> PackageId
 319 stringToPackageId = fsToPackageId . mkFastString
 320
 321 packageIdString :: PackageId -> String
 322 packageIdString = unpackFS . packageIdFS
 323
 324
 325 -- -----------------------------------------------------------------------------
 326 -- $wired_in_packages
 327 -- Certain packages are known to the compiler, in that we know about certain
 328 -- entities that reside in these packages, and the compiler needs to
 329 -- declare static Modules and Names that refer to these packages.  Hence
 330 -- the wired-in packages can't include version numbers, since we don't want
 331 -- to bake the version numbers of these packages into GHC.
 332 --
 333 -- So here's the plan.  Wired-in packages are still versioned as
 334 -- normal in the packages database, and you can still have multiple
 335 -- versions of them installed.  However, for each invocation of GHC,
 336 -- only a single instance of each wired-in package will be recognised
 337 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
 338 -- will use the unversioned 'PackageId' below when referring to it,
 339 -- including in .hi files and object file symbols.  Unselected
 340 -- versions of wired-in packages will be ignored, as will any other
 341 -- package that depends directly or indirectly on it (much as if you
 342 -- had used @-ignore-package@).
 343
 344 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
 345
 346 integerPackageId, primPackageId,
 347   basePackageId, rtsPackageId, haskell98PackageId,
 348   thPackageId, dphSeqPackageId, dphParPackageId,
 349   mainPackageId  :: PackageId
 350 primPackageId      = fsToPackageId (fsLit "ghc-prim")
 351 integerPackageId   = fsToPackageId (fsLit cIntegerLibrary)
 352 basePackageId      = fsToPackageId (fsLit "base")
 353 rtsPackageId       = fsToPackageId (fsLit "rts")
 354 haskell98PackageId = fsToPackageId (fsLit "haskell98")
 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 (FiniteMap Module elt)
 374
 375 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
 376 filterModuleEnv f (ModuleEnv e) = ModuleEnv (filterFM f e)
 377
 378 elemModuleEnv :: Module -> ModuleEnv a -> Bool
 379 elemModuleEnv m (ModuleEnv e) = elemFM m e
 380
 381 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
 382 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (addToFM e m x)
 383
 384 extendModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
 385 extendModuleEnv_C f (ModuleEnv e) m x = ModuleEnv (addToFM_C f e m x)
 386
 387 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
 388 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (addListToFM e xs)
 389
 390 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
 391                       -> ModuleEnv a
 392 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (addListToFM_C f e xs)
 393
 394 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
 395 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM_C f e1 e2)
 396
 397 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
 398 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (delListFromFM e ms)
 399
 400 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
 401 delModuleEnv (ModuleEnv e) m = ModuleEnv (delFromFM e m)
 402
 403 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
 404 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (plusFM e1 e2)
 405
 406 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
 407 lookupModuleEnv (ModuleEnv e) m = lookupFM e m
 408
 409 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
 410 lookupWithDefaultModuleEnv (ModuleEnv e) x m = lookupWithDefaultFM e x m
 411
 412 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
 413 mapModuleEnv f (ModuleEnv e) = ModuleEnv (mapFM (\_ v -> f v) e)
 414
 415 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
 416 mkModuleEnv xs = ModuleEnv (listToFM xs)
 417
 418 emptyModuleEnv :: ModuleEnv a
 419 emptyModuleEnv = ModuleEnv emptyFM
 420
 421 moduleEnvKeys :: ModuleEnv a -> [Module]
 422 moduleEnvKeys (ModuleEnv e) = keysFM e
 423
 424 moduleEnvElts :: ModuleEnv a -> [a]
 425 moduleEnvElts (ModuleEnv e) = eltsFM e
 426
 427 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
 428 moduleEnvToList (ModuleEnv e) = fmToList e
 429
 430 unitModuleEnv :: Module -> a -> ModuleEnv a
 431 unitModuleEnv m x = ModuleEnv (unitFM m x)
 432
 433 isEmptyModuleEnv :: ModuleEnv a -> Bool
 434 isEmptyModuleEnv (ModuleEnv e) = isEmptyFM e
 435
 436 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
 437 foldModuleEnv f x (ModuleEnv e) = foldFM (\_ v -> f v) x e
 438 \end{code}
 439
 440 \begin{code}
 441 -- | A set of 'Module's
 442 type ModuleSet = FiniteMap 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    = emptyFM
 451 mkModuleSet ms    = listToFM [(m,()) | m <- ms ]
 452 extendModuleSet s m = addToFM s m ()
 453 moduleSetElts     = keysFM
 454 elemModuleSet     = elemFM
 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}