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     deriving Typeable
 159
 160 instance Uniquable ModuleName where
 161   getUnique (ModuleName nm) = getUnique nm
 162
 163 instance Eq ModuleName where
 164   nm1 == nm2 = getUnique nm1 == getUnique nm2
 165
 166 -- Warning: gives an ordering relation based on the uniques of the
 167 -- FastStrings which are the (encoded) module names.  This is _not_
 168 -- a lexicographical ordering.
 169 instance Ord ModuleName where
 170   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 171
 172 instance Outputable ModuleName where
 173   ppr = pprModuleName
 174
 175 instance Binary ModuleName where
 176   put_ bh (ModuleName fs) = put_ bh fs
 177   get bh = do fs <- get bh; return (ModuleName fs)
 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, Typeable)
 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 Data Module where
 239   -- don't traverse?
 240   toConstr _   = abstractConstr "Module"
 241   gunfold _ _  = error "gunfold"
 242   dataTypeOf _ = mkNoRepType "Module"
 243
 244 -- | This gives a stable ordering, as opposed to the Ord instance which
 245 -- gives an ordering based on the 'Unique's of the components, which may
 246 -- not be stable from run to run of the compiler.
 247 stableModuleCmp :: Module -> Module -> Ordering
 248 stableModuleCmp (Module p1 n1) (Module p2 n2)
 249    = (p1 `stablePackageIdCmp`  p2) `thenCmp`
 250      (n1 `stableModuleNameCmp` n2)
 251
 252 mkModule :: PackageId -> ModuleName -> Module
 253 mkModule = Module
 254
 255 pprModule :: Module -> SDoc
 256 pprModule mod@(Module p n)  = pprPackagePrefix p mod <> pprModuleName n
 257
 258 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
 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}