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