ghc/compiler/basicTypes/Module.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[Module]{The @Module@ module.}
   5
   6 Representing modules and their flavours.
   7
   8 \begin{code}
   9 module Module
  10     (
  11       Module                -- abstract, instance of Eq, Ord, Outputable
  12     , ModuleName
  13
  14     , moduleNameString          -- :: ModuleName -> EncodedString
  15     , moduleNameUserString      -- :: ModuleName -> UserString
  16
  17     , moduleString          -- :: Module -> EncodedString
  18     , moduleUserString      -- :: Module -> UserString
  19     , moduleName            -- :: Module -> ModuleName
  20
  21     , mkVanillaModule       -- :: ModuleName -> Module
  22     , mkThisModule          -- :: ModuleName -> Module
  23     , mkPrelModule          -- :: UserString -> Module
  24     , mkModule              -- :: ModuleName -> PackageName -> Module
  25
  26     , isLocalModule       -- :: Module -> Bool
  27
  28     , mkSrcModule
  29
  30     , mkSrcModuleFS         -- :: UserFS    -> ModuleName
  31     , mkSysModuleFS         -- :: EncodedFS -> ModuleName
  32
  33     , pprModule, pprModuleName
  34
  35     , PackageName
  36
  37         -- Where to find a .hi file
  38     , WhereFrom(..), SearchPath, mkSearchPath
  39     , ModuleHiMap, mkModuleHiMaps
  40
  41     ) where
  42
  43 #include "HsVersions.h"
  44 import OccName
  45 import Outputable
  46 import FiniteMap
  47 import CmdLineOpts      ( opt_Static, opt_InPackage, opt_WarnHiShadows, opt_HiMapSep )
  48 import Constants        ( interfaceFileFormatVersion )
  49 import Maybes           ( seqMaybe )
  50 import Maybe            ( fromMaybe )
  51 import Directory        ( doesFileExist )
  52 import DirUtils         ( getDirectoryContents )
  53 import List             ( intersperse )
  54 import Monad            ( foldM )
  55 import IO               ( hPutStrLn, stderr, isDoesNotExistError )
  56 import FastString       ( FastString )
  57 \end{code}
  58
  59
  60 %************************************************************************
  61 %*                                                                      *
  62 \subsection{Interface file flavour}
  63 %*                                                                      *
  64 %************************************************************************
  65
  66 A further twist to the tale is the support for dynamically linked libraries under
  67 Win32. Here, dealing with the use of global variables that's residing in a DLL
  68 requires special handling at the point of use (there's an extra level of indirection,
  69 i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an
  70 interface file we then record whether it's coming from a .hi corresponding to a
  71 module that's packaged up in a DLL or not, so that we later can emit the
  72 appropriate code.
  73
  74 The logic for how an interface file is marked as corresponding to a module that's
  75 hiding in a DLL is explained elsewhere (ToDo: give renamer href here.)
  76
  77 \begin{code}
  78 data PackageInfo = ThisPackage                  -- A module from the same package
  79                                                 -- as the one being compiled
  80                  | AnotherPackage PackageName   -- A module from a different package
  81
  82 type PackageName = FastString           -- No encoding at all
  83
  84 preludePackage :: PackageName
  85 preludePackage = SLIT("std")
  86
  87 instance Show PackageInfo where -- Just used in debug prints of lex tokens
  88                                 -- and in debug modde
  89   showsPrec n ThisPackage        s = "<THIS>"   ++ s
  90   showsPrec n (AnotherPackage p) s = (_UNPK_ p) ++ s
  91 \end{code}
  92
  93
  94 %************************************************************************
  95 %*                                                                      *
  96 \subsection{System/user module}
  97 %*                                                                      *
  98 %************************************************************************
  99
 100 We also track whether an imported module is from a 'system-ish' place.  In this case
 101 we don't record the fact that this module depends on it, nor usages of things
 102 inside it.
 103
 104 Apr 00: We want to record dependencies on all modules other than
 105 prelude modules else STG Hugs gets confused because it uses this
 106 info to know what modules to link.  (Compiled GHC uses command line
 107 options to specify this.)
 108
 109 \begin{code}
 110 data ModFlavour = PrelMod       -- A Prelude module
 111                 | UserMod       -- Not library-ish
 112 \end{code}
 113
 114
 115 %************************************************************************
 116 %*                                                                      *
 117 \subsection{Where from}
 118 %*                                                                      *
 119 %************************************************************************
 120
 121 The @WhereFrom@ type controls where the renamer looks for an interface file
 122
 123 \begin{code}
 124 data WhereFrom = ImportByUser           -- Ordinary user import: look for M.hi
 125                | ImportByUserSource     -- User {- SOURCE -}: look for M.hi-boot
 126                | ImportBySystem         -- Non user import.  Look for M.hi if M is in
 127                                         -- the module this module depends on, or is a system-ish module;
 128                                         -- M.hi-boot otherwise
 129
 130 instance Outputable WhereFrom where
 131   ppr ImportByUser       = empty
 132   ppr ImportByUserSource = ptext SLIT("{- SOURCE -}")
 133   ppr ImportBySystem     = ptext SLIT("{- SYSTEM IMPORT -}")
 134 \end{code}
 135
 136
 137 %************************************************************************
 138 %*                                                                      *
 139 \subsection{The name of a module}
 140 %*                                                                      *
 141 %************************************************************************
 142
 143 \begin{code}
 144 type ModuleName = EncodedFS
 145         -- Haskell module names can include the quote character ',
 146         -- so the module names have the z-encoding applied to them
 147
 148 pprModuleName :: ModuleName -> SDoc
 149 pprModuleName nm = pprEncodedFS nm
 150
 151 moduleNameString :: ModuleName -> EncodedString
 152 moduleNameString mod = _UNPK_ mod
 153
 154 moduleNameUserString :: ModuleName -> UserString
 155 moduleNameUserString mod = decode (_UNPK_ mod)
 156
 157 mkSrcModule :: UserString -> ModuleName
 158 mkSrcModule s = _PK_ (encode s)
 159
 160 mkSrcModuleFS :: UserFS -> ModuleName
 161 mkSrcModuleFS s = encodeFS s
 162
 163 mkSysModuleFS :: EncodedFS -> ModuleName
 164 mkSysModuleFS s = s
 165 \end{code}
 166
 167 \begin{code}
 168 data Module = Module ModuleName PackageInfo
 169 \end{code}
 170
 171 \begin{code}
 172 instance Outputable Module where
 173   ppr = pprModule
 174
 175 instance Eq Module where
 176   (Module m1 _) == (Module m2 _) = m1 == m2
 177
 178 instance Ord Module where
 179   (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
 180 \end{code}
 181
 182
 183 \begin{code}
 184 pprModule :: Module -> SDoc
 185 pprModule (Module mod p) = getPprStyle $ \ sty ->
 186                            if userStyle sty then
 187                                 text (moduleNameUserString mod)
 188                            else if debugStyle sty then
 189                                 -- Print the package too
 190                                 text (show p) <> dot <> pprModuleName mod
 191                            else
 192                                 pprModuleName mod
 193 \end{code}
 194
 195
 196 \begin{code}
 197 mkModule :: ModuleName  -- Name of the module
 198          -> PackageName
 199          -> Module
 200 mkModule mod_nm pack_name
 201   = Module mod_nm pack_info
 202   where
 203     pack_info | pack_name == opt_InPackage = ThisPackage
 204               | otherwise                  = AnotherPackage pack_name
 205
 206 mkVanillaModule :: ModuleName -> Module
 207 mkVanillaModule name = Module name ThisPackage
 208         -- Used temporarily when we first come across Foo.x in an interface
 209         -- file, but before we've opened Foo.hi.
 210         -- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
 211
 212 mkThisModule :: ModuleName -> Module    -- The module being compiled
 213 mkThisModule name = Module name ThisPackage
 214
 215 mkPrelModule :: ModuleName -> Module
 216 mkPrelModule name = mkModule name preludePackage
 217
 218 moduleString :: Module -> EncodedString
 219 moduleString (Module mod _) = _UNPK_ mod
 220
 221 moduleName :: Module -> ModuleName
 222 moduleName (Module mod _) = mod
 223
 224 moduleUserString :: Module -> UserString
 225 moduleUserString (Module mod _) = moduleNameUserString mod
 226 \end{code}
 227
 228 \begin{code}
 229 isLocalModule :: Module -> Bool
 230 isLocalModule (Module _ ThisPackage) = True
 231 isLocalModule _                      = False
 232 \end{code}
 233
 234
 235 %************************************************************************
 236 %*                                                                      *
 237 \subsection{Finding modules in the file system
 238 %*                                                                      *
 239 %************************************************************************
 240
 241 \begin{code}
 242 type ModuleHiMap = FiniteMap ModuleName String
 243   -- Mapping from module name to
 244   --    * the file path of its corresponding interface file,
 245   --    * the ModuleName
 246 \end{code}
 247
 248 (We allege that) it is quicker to build up a mapping from module names
 249 to the paths to their corresponding interface files once, than to search
 250 along the import part every time we slurp in a new module (which we
 251 do quite a lot of.)
 252
 253 \begin{code}
 254 type SearchPath = [(String,String)]     -- List of (directory,suffix) pairs to search
 255                                         -- for interface files.
 256
 257 mkModuleHiMaps :: SearchPath -> IO (SearchPath, ModuleHiMap, ModuleHiMap)
 258 mkModuleHiMaps dirs = do (hi,hi_boot) <- foldM (getAllFilesMatching dirs) (env,env) dirs
 259                          return (dirs, hi, hi_boot)
 260  where
 261   env = emptyFM
 262
 263 getAllFilesMatching :: SearchPath
 264                     -> (ModuleHiMap, ModuleHiMap)
 265                     -> (FilePath, String)
 266                     -> IO (ModuleHiMap, ModuleHiMap)
 267 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 268     -- fpaths entries do not have dir_path prepended
 269   fpaths  <- getDirectoryContents dir_path
 270   return (foldl addModules hims fpaths))
 271   -- soft failure
 272       `catch`
 273         (\ err -> do
 274               hPutStrLn stderr
 275                      ("Import path element `" ++ dir_path ++
 276                       if (isDoesNotExistError err) then
 277                          "' does not exist, ignoring."
 278                       else
 279                         "' couldn't read, ignoring.")
 280
 281               return hims
 282         )
 283  where
 284    xiffus        = reverse dotted_suffix
 285    dotted_suffix = case suffix of
 286                       []       -> []
 287                       ('.':xs) -> suffix
 288                       ls       -> '.':ls
 289
 290    hi_boot_version_xiffus =
 291       reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
 292    hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
 293
 294    addModules his@(hi_env, hib_env) filename = fromMaybe his $
 295         FMAP add_hi   (go xiffus                 rev_fname)     `seqMaybe`
 296
 297         FMAP add_vhib (go hi_boot_version_xiffus rev_fname)     `seqMaybe`
 298                 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
 299
 300         FMAP add_hib  (go hi_boot_xiffus         rev_fname)
 301      where
 302         rev_fname = reverse filename
 303         path      = dir_path ++ '/':filename
 304
 305           -- In these functions file_nm is the base of the filename,
 306           -- with the path and suffix both stripped off.  The filename
 307           -- is the *unencoded* module name (else 'make' gets confused).
 308           -- But the domain of the HiMaps is ModuleName which is encoded.
 309         add_hi    file_nm = (add_to_map addNewOne hi_env file_nm,   hib_env)
 310         add_vhib  file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
 311         add_hib   file_nm = (hi_env, add_to_map addNewOne   hib_env file_nm)
 312
 313         add_to_map combiner env file_nm
 314           = addToFM_C combiner env mod_nm path
 315           where
 316             mod_nm = mkSrcModuleFS file_nm
 317
 318    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
 319    go [] xs                     = Just (_PK_ (reverse xs))
 320    go _  []                     = Nothing
 321    go (x:xs) (y:ys) | x == y    = go xs ys
 322                     | otherwise = Nothing
 323
 324    addNewOne | opt_WarnHiShadows = conflict
 325              | otherwise         = stickWithOld
 326
 327    stickWithOld old new = old
 328    overrideNew  old new = new
 329
 330    conflict old_path new_path
 331     | old_path /= new_path =
 332         pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
 333                               text (show old_path) <+> text "shadows" $$
 334                               text (show new_path) $$
 335                               text "on the import path: " <+>
 336                               text (concat (intersperse ":" (map fst dirs))))
 337         old_path
 338     | otherwise = old_path      -- don't warn about innocous shadowings.
 339 \end{code}
 340
 341
 342 %*********************************************************
 343 %*                                                       *
 344 \subsection{Making a search path}
 345 %*                                                       *
 346 %*********************************************************
 347
 348 @mkSearchPath@ takes a string consisting of a colon-separated list
 349 of directories and corresponding suffixes, and turns it into a list
 350 of (directory, suffix) pairs.  For example:
 351
 352 \begin{verbatim}
 353  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
 354    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
 355 \begin{verbatim}
 356
 357 \begin{code}
 358 mkSearchPath :: Maybe String -> SearchPath
 359 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
 360                                       -- the directory the module we're compiling
 361                                       -- lives.
 362 mkSearchPath (Just s) = go s
 363   where
 364     go "" = []
 365     go s  =
 366       case span (/= '%') s of
 367        (dir,'%':rs) ->
 368          case span (/= opt_HiMapSep) rs of
 369           (hisuf,_:rest) -> (dir,hisuf):go rest
 370           (hisuf,[])     -> [(dir,hisuf)]
 371 \end{code}
 372