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 debugStyle sty then
 187                                 -- Print the package too
 188                                 text (show p) <> dot <> pprModuleName mod
 189                            else
 190                                 pprModuleName mod
 191 \end{code}
 192
 193
 194 \begin{code}
 195 mkModule :: ModuleName  -- Name of the module
 196          -> PackageName
 197          -> Module
 198 mkModule mod_nm pack_name
 199   = Module mod_nm pack_info
 200   where
 201     pack_info | pack_name == opt_InPackage = ThisPackage
 202               | otherwise                  = AnotherPackage pack_name
 203
 204 mkVanillaModule :: ModuleName -> Module
 205 mkVanillaModule name = Module name ThisPackage
 206         -- Used temporarily when we first come across Foo.x in an interface
 207         -- file, but before we've opened Foo.hi.
 208         -- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
 209
 210 mkThisModule :: ModuleName -> Module    -- The module being compiled
 211 mkThisModule name = Module name ThisPackage
 212
 213 mkPrelModule :: ModuleName -> Module
 214 mkPrelModule name = mkModule name preludePackage
 215
 216 moduleString :: Module -> EncodedString
 217 moduleString (Module mod _) = _UNPK_ mod
 218
 219 moduleName :: Module -> ModuleName
 220 moduleName (Module mod _) = mod
 221
 222 moduleUserString :: Module -> UserString
 223 moduleUserString (Module mod _) = moduleNameUserString mod
 224 \end{code}
 225
 226 \begin{code}
 227 isLocalModule :: Module -> Bool
 228 isLocalModule (Module _ ThisPackage) = True
 229 isLocalModule _                      = False
 230 \end{code}
 231
 232
 233 %************************************************************************
 234 %*                                                                      *
 235 \subsection{Finding modules in the file system
 236 %*                                                                      *
 237 %************************************************************************
 238
 239 \begin{code}
 240 type ModuleHiMap = FiniteMap ModuleName String
 241   -- Mapping from module name to
 242   --    * the file path of its corresponding interface file,
 243   --    * the ModuleName
 244 \end{code}
 245
 246 (We allege that) it is quicker to build up a mapping from module names
 247 to the paths to their corresponding interface files once, than to search
 248 along the import part every time we slurp in a new module (which we
 249 do quite a lot of.)
 250
 251 \begin{code}
 252 type SearchPath = [(String,String)]     -- List of (directory,suffix) pairs to search
 253                                         -- for interface files.
 254
 255 mkModuleHiMaps :: SearchPath -> IO (SearchPath, ModuleHiMap, ModuleHiMap)
 256 mkModuleHiMaps dirs = do (hi,hi_boot) <- foldM (getAllFilesMatching dirs) (env,env) dirs
 257                          return (dirs, hi, hi_boot)
 258  where
 259   env = emptyFM
 260
 261 getAllFilesMatching :: SearchPath
 262                     -> (ModuleHiMap, ModuleHiMap)
 263                     -> (FilePath, String)
 264                     -> IO (ModuleHiMap, ModuleHiMap)
 265 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 266     -- fpaths entries do not have dir_path prepended
 267   fpaths  <- getDirectoryContents dir_path
 268   return (foldl addModules hims fpaths))
 269   -- soft failure
 270       `catch`
 271         (\ err -> do
 272               hPutStrLn stderr
 273                      ("Import path element `" ++ dir_path ++
 274                       if (isDoesNotExistError err) then
 275                          "' does not exist, ignoring."
 276                       else
 277                         "' couldn't read, ignoring.")
 278
 279               return hims
 280         )
 281  where
 282    xiffus        = reverse dotted_suffix
 283    dotted_suffix = case suffix of
 284                       []       -> []
 285                       ('.':xs) -> suffix
 286                       ls       -> '.':ls
 287
 288    hi_boot_version_xiffus =
 289       reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
 290    hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
 291
 292    addModules his@(hi_env, hib_env) filename = fromMaybe his $
 293         FMAP add_hi   (go xiffus                 rev_fname)     `seqMaybe`
 294
 295         FMAP add_vhib (go hi_boot_version_xiffus rev_fname)     `seqMaybe`
 296                 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
 297
 298         FMAP add_hib  (go hi_boot_xiffus         rev_fname)
 299      where
 300         rev_fname = reverse filename
 301         path      = dir_path ++ '/':filename
 302
 303           -- In these functions file_nm is the base of the filename,
 304           -- with the path and suffix both stripped off.  The filename
 305           -- is the *unencoded* module name (else 'make' gets confused).
 306           -- But the domain of the HiMaps is ModuleName which is encoded.
 307         add_hi    file_nm = (add_to_map addNewOne hi_env file_nm,   hib_env)
 308         add_vhib  file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
 309         add_hib   file_nm = (hi_env, add_to_map addNewOne   hib_env file_nm)
 310
 311         add_to_map combiner env file_nm
 312           = addToFM_C combiner env mod_nm path
 313           where
 314             mod_nm = mkSrcModuleFS file_nm
 315
 316    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
 317    go [] xs                     = Just (_PK_ (reverse xs))
 318    go _  []                     = Nothing
 319    go (x:xs) (y:ys) | x == y    = go xs ys
 320                     | otherwise = Nothing
 321
 322    addNewOne | opt_WarnHiShadows = conflict
 323              | otherwise         = stickWithOld
 324
 325    stickWithOld old new = old
 326    overrideNew  old new = new
 327
 328    conflict old_path new_path
 329     | old_path /= new_path =
 330         pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
 331                               text (show old_path) <+> text "shadows" $$
 332                               text (show new_path) $$
 333                               text "on the import path: " <+>
 334                               text (concat (intersperse ":" (map fst dirs))))
 335         old_path
 336     | otherwise = old_path      -- don't warn about innocous shadowings.
 337 \end{code}
 338
 339
 340 %*********************************************************
 341 %*                                                       *
 342 \subsection{Making a search path}
 343 %*                                                       *
 344 %*********************************************************
 345
 346 @mkSearchPath@ takes a string consisting of a colon-separated list
 347 of directories and corresponding suffixes, and turns it into a list
 348 of (directory, suffix) pairs.  For example:
 349
 350 \begin{verbatim}
 351  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
 352    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
 353 \begin{verbatim}
 354
 355 \begin{code}
 356 mkSearchPath :: Maybe String -> SearchPath
 357 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
 358                                       -- the directory the module we're compiling
 359                                       -- lives.
 360 mkSearchPath (Just s) = go s
 361   where
 362     go "" = []
 363     go s  =
 364       case span (/= '%') s of
 365        (dir,'%':rs) ->
 366          case span (/= opt_HiMapSep) rs of
 367           (hisuf,_:rest) -> (dir,hisuf):go rest
 368           (hisuf,[])     -> [(dir,hisuf)]
 369 \end{code}
 370