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 qualified Pretty
  77 import Unique
  78 import UniqFM
  79 import FastString
  80 import Binary
  81 import Util
  82
  83 import Data.Data
  84 import Data.Map (Map)
  85 import qualified Data.Map as Map
  86 import qualified FiniteMap as Map
  87 import System.FilePath
  88 \end{code}
  89
  90 %************************************************************************
  91 %*                                                                      *
  92 \subsection{Module locations}
  93 %*                                                                      *
  94 %************************************************************************
  95
  96 \begin{code}
  97 -- | Where a module lives on the file system: the actual locations
  98 -- of the .hs, .hi and .o files, if we have them
  99 data ModLocation
 100    = ModLocation {
 101         ml_hs_file   :: Maybe FilePath,
 102                 -- The source file, if we have one.  Package modules
 103                 -- probably don't have source files.
 104
 105         ml_hi_file   :: FilePath,
 106                 -- Where the .hi file is, whether or not it exists
 107                 -- yet.  Always of form foo.hi, even if there is an
 108                 -- hi-boot file (we add the -boot suffix later)
 109
 110         ml_obj_file  :: FilePath
 111                 -- Where the .o file is, whether or not it exists yet.
 112                 -- (might not exist either because the module hasn't
 113                 -- been compiled yet, or because it is part of a
 114                 -- package with a .a file)
 115   } deriving Show
 116
 117 instance Outputable ModLocation where
 118    ppr = text . show
 119 \end{code}
 120
 121 For a module in another package, the hs_file and obj_file
 122 components of ModLocation are undefined.
 123
 124 The locations specified by a ModLocation may or may not
 125 correspond to actual files yet: for example, even if the object
 126 file doesn't exist, the ModLocation still contains the path to
 127 where the object file will reside if/when it is created.
 128
 129 \begin{code}
 130 addBootSuffix :: FilePath -> FilePath
 131 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
 132 addBootSuffix path = path ++ "-boot"
 133
 134 addBootSuffix_maybe :: Bool -> FilePath -> FilePath
 135 -- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
 136 addBootSuffix_maybe is_boot path
 137  | is_boot   = addBootSuffix path
 138  | otherwise = path
 139
 140 addBootSuffixLocn :: ModLocation -> ModLocation
 141 -- ^ Add the @-boot@ suffix to all file paths associated with the module
 142 addBootSuffixLocn locn
 143   = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
 144          , ml_hi_file  = addBootSuffix (ml_hi_file locn)
 145          , ml_obj_file = addBootSuffix (ml_obj_file locn) }
 146 \end{code}
 147
 148
 149 %************************************************************************
 150 %*                                                                      *
 151 \subsection{The name of a module}
 152 %*                                                                      *
 153 %************************************************************************
 154
 155 \begin{code}
 156 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
 157 newtype ModuleName = ModuleName FastString
 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_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
 179
 180 instance Data ModuleName where
 181   -- don't traverse?
 182   toConstr _   = abstractConstr "ModuleName"
 183   gunfold _ _  = error "gunfold"
 184   dataTypeOf _ = mkNoRepType "ModuleName"
 185
 186 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
 187 -- ^ Compares module names lexically, rather than by their 'Unique's
 188 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
 189
 190 pprModuleName :: ModuleName -> SDoc
 191 pprModuleName (ModuleName nm) =
 192     getPprStyle $ \ sty ->
 193     if codeStyle sty
 194         then ftext (zEncodeFS nm)
 195         else ftext nm
 196
 197 moduleNameFS :: ModuleName -> FastString
 198 moduleNameFS (ModuleName mod) = mod
 199
 200 moduleNameString :: ModuleName -> String
 201 moduleNameString (ModuleName mod) = unpackFS mod
 202
 203 mkModuleName :: String -> ModuleName
 204 mkModuleName s = ModuleName (mkFastString s)
 205
 206 mkModuleNameFS :: FastString -> ModuleName
 207 mkModuleNameFS s = ModuleName s
 208
 209 -- | Returns the string version of the module name, with dots replaced by slashes
 210 moduleNameSlashes :: ModuleName -> String
 211 moduleNameSlashes = dots_to_slashes . moduleNameString
 212   where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
 213 \end{code}
 214
 215 %************************************************************************
 216 %*                                                                      *
 217 \subsection{A fully qualified module}
 218 %*                                                                      *
 219 %************************************************************************
 220
 221 \begin{code}
 222 -- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
 223 data Module = Module {
 224    modulePackageId :: !PackageId,  -- pkg-1.0
 225    moduleName      :: !ModuleName  -- A.B.C
 226   }
 227   deriving (Eq, Ord)
 228
 229 instance Uniquable Module where
 230   getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
 231
 232 instance Outputable Module where
 233   ppr = pprModule
 234
 235 instance Binary Module where
 236   put_ bh (Module p n) = put_ bh p >> put_ bh n
 237   get bh = do p <- get bh; n <- get bh; return (Module p n)
 238
 239 INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
 240
 241 instance Data Module where
 242   -- don't traverse?
 243   toConstr _   = abstractConstr "Module"
 244   gunfold _ _  = error "gunfold"
 245   dataTypeOf _ = mkNoRepType "Module"
 246
 247 -- | This gives a stable ordering, as opposed to the Ord instance which
 248 -- gives an ordering based on the 'Unique's of the components, which may
 249 -- not be stable from run to run of the compiler.
 250 stableModuleCmp :: Module -> Module -> Ordering
 251 stableModuleCmp (Module p1 n1) (Module p2 n2)
 252    = (p1 `stablePackageIdCmp`  p2) `thenCmp`
 253      (n1 `stableModuleNameCmp` n2)
 254
 255 mkModule :: PackageId -> ModuleName -> Module
 256 mkModule = Module
 257
 258 pprModule :: Module -> SDoc
 259 pprModule mod@(Module p n)  = pprPackagePrefix p mod <> pprModuleName n
 260
 261 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
 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}