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         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, extendModuleEnvWith, 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 UniqFM
  80 import FastString
  81 import Binary
  82 import Util
  83
  84 import Data.Data
  85 import Data.Map (Map)
  86 import qualified Data.Map as Map
  87 import qualified FiniteMap as Map
  88 import System.FilePath
  89 \end{code}
  90
  91 %************************************************************************
  92 %*                                                                      *
  93 \subsection{Module locations}
  94 %*                                                                      *
  95 %************************************************************************
  96
  97 \begin{code}
  98 -- | Where a module lives on the file system: the actual locations
  99 -- of the .hs, .hi and .o files, if we have them
 100 data ModLocation
 101    = ModLocation {
 102         ml_hs_file   :: Maybe FilePath,
 103                 -- The source file, if we have one.  Package modules
 104                 -- probably don't have source files.
 105
 106         ml_hi_file   :: FilePath,
 107                 -- Where the .hi file is, whether or not it exists
 108                 -- yet.  Always of form foo.hi, even if there is an
 109                 -- hi-boot file (we add the -boot suffix later)
 110
 111         ml_obj_file  :: FilePath
 112                 -- Where the .o file is, whether or not it exists yet.
 113                 -- (might not exist either because the module hasn't
 114                 -- been compiled yet, or because it is part of a
 115                 -- package with a .a file)
 116   } deriving Show
 117
 118 instance Outputable ModLocation where
 119    ppr = text . show
 120 \end{code}
 121
 122 For a module in another package, the hs_file and obj_file
 123 components of ModLocation are undefined.
 124
 125 The locations specified by a ModLocation may or may not
 126 correspond to actual files yet: for example, even if the object
 127 file doesn't exist, the ModLocation still contains the path to
 128 where the object file will reside if/when it is created.
 129
 130 \begin{code}
 131 addBootSuffix :: FilePath -> FilePath
 132 -- ^ Add the @-boot@ suffix to .hs, .hi and .o files
 133 addBootSuffix path = path ++ "-boot"
 134
 135 addBootSuffix_maybe :: Bool -> FilePath -> FilePath
 136 -- ^ Add the @-boot@ suffix if the @Bool@ argument is @True@
 137 addBootSuffix_maybe is_boot path
 138  | is_boot   = addBootSuffix path
 139  | otherwise = path
 140
 141 addBootSuffixLocn :: ModLocation -> ModLocation
 142 -- ^ Add the @-boot@ suffix to all file paths associated with the module
 143 addBootSuffixLocn locn
 144   = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
 145          , ml_hi_file  = addBootSuffix (ml_hi_file locn)
 146          , ml_obj_file = addBootSuffix (ml_obj_file locn) }
 147 \end{code}
 148
 149
 150 %************************************************************************
 151 %*                                                                      *
 152 \subsection{The name of a module}
 153 %*                                                                      *
 154 %************************************************************************
 155
 156 \begin{code}
 157 -- | A ModuleName is essentially a simple string, e.g. @Data.List@.
 158 newtype ModuleName = ModuleName FastString
 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_TYPEABLE0(ModuleName,moduleNameTc,"ModuleName")
 180
 181 instance Data ModuleName where
 182   -- don't traverse?
 183   toConstr _   = abstractConstr "ModuleName"
 184   gunfold _ _  = error "gunfold"
 185   dataTypeOf _ = mkNoRepType "ModuleName"
 186
 187 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
 188 -- ^ Compares module names lexically, rather than by their 'Unique's
 189 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
 190
 191 pprModuleName :: ModuleName -> SDoc
 192 pprModuleName (ModuleName nm) =
 193     getPprStyle $ \ sty ->
 194     if codeStyle sty
 195         then ftext (zEncodeFS nm)
 196         else ftext nm
 197
 198 moduleNameFS :: ModuleName -> FastString
 199 moduleNameFS (ModuleName mod) = mod
 200
 201 moduleNameString :: ModuleName -> String
 202 moduleNameString (ModuleName mod) = unpackFS mod
 203
 204 mkModuleName :: String -> ModuleName
 205 mkModuleName s = ModuleName (mkFastString s)
 206
 207 mkModuleNameFS :: FastString -> ModuleName
 208 mkModuleNameFS s = ModuleName s
 209
 210 -- | Returns the string version of the module name, with dots replaced by slashes
 211 moduleNameSlashes :: ModuleName -> String
 212 moduleNameSlashes = dots_to_slashes . moduleNameString
 213   where dots_to_slashes = map (\c -> if c == '.' then pathSeparator else c)
 214 \end{code}
 215
 216 %************************************************************************
 217 %*                                                                      *
 218 \subsection{A fully qualified module}
 219 %*                                                                      *
 220 %************************************************************************
 221
 222 \begin{code}
 223 -- | A Module is a pair of a 'PackageId' and a 'ModuleName'.
 224 data Module = Module {
 225    modulePackageId :: !PackageId,  -- pkg-1.0
 226    moduleName      :: !ModuleName  -- A.B.C
 227   }
 228   deriving (Eq, Ord)
 229
 230 instance Uniquable Module where
 231   getUnique (Module p n) = getUnique (packageIdFS p `appendFS` moduleNameFS n)
 232
 233 instance Outputable Module where
 234   ppr = pprModule
 235
 236 instance Binary Module where
 237   put_ bh (Module p n) = put_ bh p >> put_ bh n
 238   get bh = do p <- get bh; n <- get bh; return (Module p n)
 239
 240 INSTANCE_TYPEABLE0(Module,moduleTc,"Module")
 241
 242 instance Data Module where
 243   -- don't traverse?
 244   toConstr _   = abstractConstr "Module"
 245   gunfold _ _  = error "gunfold"
 246   dataTypeOf _ = mkNoRepType "Module"
 247
 248 -- | This gives a stable ordering, as opposed to the Ord instance which
 249 -- gives an ordering based on the 'Unique's of the components, which may
 250 -- not be stable from run to run of the compiler.
 251 stableModuleCmp :: Module -> Module -> Ordering
 252 stableModuleCmp (Module p1 n1) (Module p2 n2)
 253    = (p1 `stablePackageIdCmp`  p2) `thenCmp`
 254      (n1 `stableModuleNameCmp` n2)
 255
 256 mkModule :: PackageId -> ModuleName -> Module
 257 mkModule = Module
 258
 259 pprModule :: Module -> SDoc
 260 pprModule mod@(Module p n)  = pprPackagePrefix p mod <> pprModuleName n
 261
 262 pprPackagePrefix :: PackageId -> Module -> PprStyle -> Pretty.Doc
 263 pprPackagePrefix p mod = getPprStyle doc
 264  where
 265    doc sty
 266        | codeStyle sty =
 267           if p == mainPackageId
 268                 then empty -- never qualify the main package in code
 269                 else ftext (zEncodeFS (packageIdFS p)) <> char '_'
 270        | qualModule sty mod = ftext (packageIdFS (modulePackageId mod)) <> char ':'
 271                 -- the PrintUnqualified tells us which modules have to
 272                 -- be qualified with package names
 273        | otherwise = empty
 274 \end{code}
 275
 276 %************************************************************************
 277 %*                                                                      *
 278 \subsection{PackageId}
 279 %*                                                                      *
 280 %************************************************************************
 281
 282 \begin{code}
 283 -- | Essentially just a string identifying a package, including the version: e.g. parsec-1.0
 284 newtype PackageId = PId FastString deriving( Eq )
 285     -- here to avoid module loops with PackageConfig
 286
 287 instance Uniquable PackageId where
 288  getUnique pid = getUnique (packageIdFS pid)
 289
 290 -- Note: *not* a stable lexicographic ordering, a faster unique-based
 291 -- ordering.
 292 instance Ord PackageId where
 293   nm1 `compare` nm2 = getUnique nm1 `compare` getUnique nm2
 294
 295 INSTANCE_TYPEABLE0(PackageId,packageIdTc,"PackageId")
 296
 297 instance Data PackageId where
 298   -- don't traverse?
 299   toConstr _   = abstractConstr "PackageId"
 300   gunfold _ _  = error "gunfold"
 301   dataTypeOf _ = mkNoRepType "PackageId"
 302
 303 stablePackageIdCmp :: PackageId -> PackageId -> Ordering
 304 -- ^ Compares package ids lexically, rather than by their 'Unique's
 305 stablePackageIdCmp p1 p2 = packageIdFS p1 `compare` packageIdFS p2
 306
 307 instance Outputable PackageId where
 308    ppr pid = text (packageIdString pid)
 309
 310 instance Binary PackageId where
 311   put_ bh pid = put_ bh (packageIdFS pid)
 312   get bh = do { fs <- get bh; return (fsToPackageId fs) }
 313
 314 fsToPackageId :: FastString -> PackageId
 315 fsToPackageId = PId
 316
 317 packageIdFS :: PackageId -> FastString
 318 packageIdFS (PId fs) = fs
 319
 320 stringToPackageId :: String -> PackageId
 321 stringToPackageId = fsToPackageId . mkFastString
 322
 323 packageIdString :: PackageId -> String
 324 packageIdString = unpackFS . packageIdFS
 325
 326
 327 -- -----------------------------------------------------------------------------
 328 -- $wired_in_packages
 329 -- Certain packages are known to the compiler, in that we know about certain
 330 -- entities that reside in these packages, and the compiler needs to
 331 -- declare static Modules and Names that refer to these packages.  Hence
 332 -- the wired-in packages can't include version numbers, since we don't want
 333 -- to bake the version numbers of these packages into GHC.
 334 --
 335 -- So here's the plan.  Wired-in packages are still versioned as
 336 -- normal in the packages database, and you can still have multiple
 337 -- versions of them installed.  However, for each invocation of GHC,
 338 -- only a single instance of each wired-in package will be recognised
 339 -- (the desired one is selected via @-package@\/@-hide-package@), and GHC
 340 -- will use the unversioned 'PackageId' below when referring to it,
 341 -- including in .hi files and object file symbols.  Unselected
 342 -- versions of wired-in packages will be ignored, as will any other
 343 -- package that depends directly or indirectly on it (much as if you
 344 -- had used @-ignore-package@).
 345
 346 -- Make sure you change 'Packages.findWiredInPackages' if you add an entry here
 347
 348 integerPackageId, primPackageId,
 349   basePackageId, rtsPackageId, haskell98PackageId,
 350   thPackageId, dphSeqPackageId, dphParPackageId,
 351   mainPackageId  :: PackageId
 352 primPackageId      = fsToPackageId (fsLit "ghc-prim")
 353 integerPackageId   = fsToPackageId (fsLit cIntegerLibrary)
 354 basePackageId      = fsToPackageId (fsLit "base")
 355 rtsPackageId       = fsToPackageId (fsLit "rts")
 356 haskell98PackageId = fsToPackageId (fsLit "haskell98")
 357 thPackageId        = fsToPackageId (fsLit "template-haskell")
 358 dphSeqPackageId    = fsToPackageId (fsLit "dph-seq")
 359 dphParPackageId    = fsToPackageId (fsLit "dph-par")
 360
 361 -- | This is the package Id for the current program.  It is the default
 362 -- package Id if you don't specify a package name.  We don't add this prefix
 363 -- to symbol names, since there can be only one main package per program.
 364 mainPackageId      = fsToPackageId (fsLit "main")
 365 \end{code}
 366
 367 %************************************************************************
 368 %*                                                                      *
 369 \subsection{@ModuleEnv@s}
 370 %*                                                                      *
 371 %************************************************************************
 372
 373 \begin{code}
 374 -- | A map keyed off of 'Module's
 375 newtype ModuleEnv elt = ModuleEnv (Map Module elt)
 376
 377 filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a
 378 filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey f e)
 379
 380 elemModuleEnv :: Module -> ModuleEnv a -> Bool
 381 elemModuleEnv m (ModuleEnv e) = Map.member m e
 382
 383 extendModuleEnv :: ModuleEnv a -> Module -> a -> ModuleEnv a
 384 extendModuleEnv (ModuleEnv e) m x = ModuleEnv (Map.insert m x e)
 385
 386 extendModuleEnvWith :: (a -> a -> a) -> ModuleEnv a -> Module -> a -> ModuleEnv a
 387 extendModuleEnvWith f (ModuleEnv e) m x = ModuleEnv (Map.insertWith f m x e)
 388
 389 extendModuleEnvList :: ModuleEnv a -> [(Module, a)] -> ModuleEnv a
 390 extendModuleEnvList (ModuleEnv e) xs = ModuleEnv (Map.insertList xs e)
 391
 392 extendModuleEnvList_C :: (a -> a -> a) -> ModuleEnv a -> [(Module, a)]
 393                       -> ModuleEnv a
 394 extendModuleEnvList_C f (ModuleEnv e) xs = ModuleEnv (Map.insertListWith f xs e)
 395
 396 plusModuleEnv_C :: (a -> a -> a) -> ModuleEnv a -> ModuleEnv a -> ModuleEnv a
 397 plusModuleEnv_C f (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.unionWith f e1 e2)
 398
 399 delModuleEnvList :: ModuleEnv a -> [Module] -> ModuleEnv a
 400 delModuleEnvList (ModuleEnv e) ms = ModuleEnv (Map.deleteList ms e)
 401
 402 delModuleEnv :: ModuleEnv a -> Module -> ModuleEnv a
 403 delModuleEnv (ModuleEnv e) m = ModuleEnv (Map.delete m e)
 404
 405 plusModuleEnv :: ModuleEnv a -> ModuleEnv a -> ModuleEnv a
 406 plusModuleEnv (ModuleEnv e1) (ModuleEnv e2) = ModuleEnv (Map.union e1 e2)
 407
 408 lookupModuleEnv :: ModuleEnv a -> Module -> Maybe a
 409 lookupModuleEnv (ModuleEnv e) m = Map.lookup m e
 410
 411 lookupWithDefaultModuleEnv :: ModuleEnv a -> a -> Module -> a
 412 lookupWithDefaultModuleEnv (ModuleEnv e) x m = Map.findWithDefault x m e
 413
 414 mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b
 415 mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e)
 416
 417 mkModuleEnv :: [(Module, a)] -> ModuleEnv a
 418 mkModuleEnv xs = ModuleEnv (Map.fromList xs)
 419
 420 emptyModuleEnv :: ModuleEnv a
 421 emptyModuleEnv = ModuleEnv Map.empty
 422
 423 moduleEnvKeys :: ModuleEnv a -> [Module]
 424 moduleEnvKeys (ModuleEnv e) = Map.keys e
 425
 426 moduleEnvElts :: ModuleEnv a -> [a]
 427 moduleEnvElts (ModuleEnv e) = Map.elems e
 428
 429 moduleEnvToList :: ModuleEnv a -> [(Module, a)]
 430 moduleEnvToList (ModuleEnv e) = Map.toList e
 431
 432 unitModuleEnv :: Module -> a -> ModuleEnv a
 433 unitModuleEnv m x = ModuleEnv (Map.singleton m x)
 434
 435 isEmptyModuleEnv :: ModuleEnv a -> Bool
 436 isEmptyModuleEnv (ModuleEnv e) = Map.null e
 437
 438 foldModuleEnv :: (a -> b -> b) -> b -> ModuleEnv a -> b
 439 foldModuleEnv f x (ModuleEnv e) = Map.foldRightWithKey (\_ v -> f v) x e
 440 \end{code}
 441
 442 \begin{code}
 443 -- | A set of 'Module's
 444 type ModuleSet = Map Module ()
 445
 446 mkModuleSet     :: [Module] -> ModuleSet
 447 extendModuleSet :: ModuleSet -> Module -> ModuleSet
 448 emptyModuleSet  :: ModuleSet
 449 moduleSetElts   :: ModuleSet -> [Module]
 450 elemModuleSet   :: Module -> ModuleSet -> Bool
 451
 452 emptyModuleSet    = Map.empty
 453 mkModuleSet ms    = Map.fromList [(m,()) | m <- ms ]
 454 extendModuleSet s m = Map.insert m () s
 455 moduleSetElts     = Map.keys
 456 elemModuleSet     = Map.member
 457 \end{code}
 458
 459 A ModuleName has a Unique, so we can build mappings of these using
 460 UniqFM.
 461
 462 \begin{code}
 463 -- | A map keyed off of 'ModuleName's (actually, their 'Unique's)
 464 type ModuleNameEnv elt = UniqFM elt
 465 \end{code}