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   showsPrec n ThisPackage s = s
  89   showsPrec n (AnotherPackage p) s = (_UNPK_ p) ++ s
  90 \end{code}
  91
  92
  93 %************************************************************************
  94 %*                                                                      *
  95 \subsection{System/user module}
  96 %*                                                                      *
  97 %************************************************************************
  98
  99 We also track whether an imported module is from a 'system-ish' place.  In this case
 100 we don't record the fact that this module depends on it, nor usages of things
 101 inside it.
 102
 103 Apr 00: We want to record dependencies on all modules other than
 104 prelude modules else STG Hugs gets confused because it uses this
 105 info to know what modules to link.  (Compiled GHC uses command line
 106 options to specify this.)
 107
 108 \begin{code}
 109 data ModFlavour = PrelMod       -- A Prelude module
 110                 | UserMod       -- Not library-ish
 111 \end{code}
 112
 113
 114 %************************************************************************
 115 %*                                                                      *
 116 \subsection{Where from}
 117 %*                                                                      *
 118 %************************************************************************
 119
 120 The @WhereFrom@ type controls where the renamer looks for an interface file
 121
 122 \begin{code}
 123 data WhereFrom = ImportByUser           -- Ordinary user import: look for M.hi
 124                | ImportByUserSource     -- User {- SOURCE -}: look for M.hi-boot
 125                | ImportBySystem         -- Non user import.  Look for M.hi if M is in
 126                                         -- the module this module depends on, or is a system-ish module;
 127                                         -- M.hi-boot otherwise
 128
 129 instance Outputable WhereFrom where
 130   ppr ImportByUser       = empty
 131   ppr ImportByUserSource = ptext SLIT("{- SOURCE -}")
 132   ppr ImportBySystem     = ptext SLIT("{- SYSTEM IMPORT -}")
 133 \end{code}
 134
 135
 136 %************************************************************************
 137 %*                                                                      *
 138 \subsection{The name of a module}
 139 %*                                                                      *
 140 %************************************************************************
 141
 142 \begin{code}
 143 type ModuleName = EncodedFS
 144         -- Haskell module names can include the quote character ',
 145         -- so the module names have the z-encoding applied to them
 146
 147 pprModuleName :: ModuleName -> SDoc
 148 pprModuleName nm = pprEncodedFS nm
 149
 150 moduleNameString :: ModuleName -> EncodedString
 151 moduleNameString mod = _UNPK_ mod
 152
 153 moduleNameUserString :: ModuleName -> UserString
 154 moduleNameUserString mod = decode (_UNPK_ mod)
 155
 156 mkSrcModule :: UserString -> ModuleName
 157 mkSrcModule s = _PK_ (encode s)
 158
 159 mkSrcModuleFS :: UserFS -> ModuleName
 160 mkSrcModuleFS s = encodeFS s
 161
 162 mkSysModuleFS :: EncodedFS -> ModuleName
 163 mkSysModuleFS s = s
 164 \end{code}
 165
 166 \begin{code}
 167 data Module = Module ModuleName PackageInfo
 168 \end{code}
 169
 170 \begin{code}
 171 instance Outputable Module where
 172   ppr = pprModule
 173
 174 instance Eq Module where
 175   (Module m1 _) == (Module m2 _) = m1 == m2
 176
 177 instance Ord Module where
 178   (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
 179 \end{code}
 180
 181
 182 \begin{code}
 183 pprModule :: Module -> SDoc
 184 pprModule (Module mod _) = getPprStyle $ \ sty ->
 185                            if userStyle sty then
 186                                 text (moduleNameUserString mod)
 187                            else
 188                                 pprModuleName mod
 189 \end{code}
 190
 191
 192 \begin{code}
 193 mkModule :: ModuleName  -- Name of the module
 194          -> PackageName
 195          -> Module
 196 mkModule mod_nm pack_name
 197   = Module mod_nm pack_info
 198   where
 199     pack_info | pack_name == opt_InPackage = ThisPackage
 200               | otherwise                  = AnotherPackage pack_name
 201
 202 mkVanillaModule :: ModuleName -> Module
 203 mkVanillaModule name = Module name (pprTrace "mkVanillaModule" (ppr name) ThisPackage)
 204         -- Used temporarily when we first come across Foo.x in an interface
 205         -- file, but before we've opened Foo.hi.
 206         -- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
 207
 208 mkThisModule :: ModuleName -> Module    -- The module being comiled
 209 mkThisModule name = Module name ThisPackage
 210
 211 mkPrelModule :: ModuleName -> Module
 212 mkPrelModule name = mkModule name preludePackage
 213
 214 moduleString :: Module -> EncodedString
 215 moduleString (Module mod _) = _UNPK_ mod
 216
 217 moduleName :: Module -> ModuleName
 218 moduleName (Module mod _) = mod
 219
 220 moduleUserString :: Module -> UserString
 221 moduleUserString (Module mod _) = moduleNameUserString mod
 222 \end{code}
 223
 224 \begin{code}
 225 isLocalModule :: Module -> Bool
 226 isLocalModule (Module _ ThisPackage) = True
 227 isLocalModule _                      = False
 228 \end{code}
 229
 230
 231 %************************************************************************
 232 %*                                                                      *
 233 \subsection{Finding modules in the file system
 234 %*                                                                      *
 235 %************************************************************************
 236
 237 \begin{code}
 238 type ModuleHiMap = FiniteMap ModuleName String
 239   -- Mapping from module name to
 240   --    * the file path of its corresponding interface file,
 241   --    * the ModuleName
 242 \end{code}
 243
 244 (We allege that) it is quicker to build up a mapping from module names
 245 to the paths to their corresponding interface files once, than to search
 246 along the import part every time we slurp in a new module (which we
 247 do quite a lot of.)
 248
 249 \begin{code}
 250 type SearchPath = [(String,String)]     -- List of (directory,suffix) pairs to search
 251                                         -- for interface files.
 252
 253 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
 254 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
 255  where
 256   env = emptyFM
 257
 258 getAllFilesMatching :: SearchPath
 259                     -> (ModuleHiMap, ModuleHiMap)
 260                     -> (FilePath, String)
 261                     -> IO (ModuleHiMap, ModuleHiMap)
 262 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 263     -- fpaths entries do not have dir_path prepended
 264   fpaths  <- getDirectoryContents dir_path
 265   return (foldl addModules hims fpaths))
 266   -- soft failure
 267       `catch`
 268         (\ err -> do
 269               hPutStrLn stderr
 270                      ("Import path element `" ++ dir_path ++
 271                       if (isDoesNotExistError err) then
 272                          "' does not exist, ignoring."
 273                       else
 274                         "' couldn't read, ignoring.")
 275
 276               return hims
 277         )
 278  where
 279    xiffus        = reverse dotted_suffix
 280    dotted_suffix = case suffix of
 281                       []       -> []
 282                       ('.':xs) -> suffix
 283                       ls       -> '.':ls
 284
 285    hi_boot_version_xiffus =
 286       reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
 287    hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
 288
 289    addModules his@(hi_env, hib_env) filename = fromMaybe his $
 290         FMAP add_hi   (go xiffus                 rev_fname)     `seqMaybe`
 291
 292         FMAP add_vhib (go hi_boot_version_xiffus rev_fname)     `seqMaybe`
 293                 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
 294
 295         FMAP add_hib  (go hi_boot_xiffus         rev_fname)
 296      where
 297         rev_fname = reverse filename
 298         path      = dir_path ++ '/':filename
 299
 300           -- In these functions file_nm is the base of the filename,
 301           -- with the path and suffix both stripped off.  The filename
 302           -- is the *unencoded* module name (else 'make' gets confused).
 303           -- But the domain of the HiMaps is ModuleName which is encoded.
 304         add_hi    file_nm = (add_to_map addNewOne hi_env file_nm,   hib_env)
 305         add_vhib  file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
 306         add_hib   file_nm = (hi_env, add_to_map addNewOne   hib_env file_nm)
 307
 308         add_to_map combiner env file_nm
 309           = addToFM_C combiner env mod_nm path
 310           where
 311             mod_nm = mkSrcModuleFS file_nm
 312
 313    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
 314    go [] xs                     = Just (_PK_ (reverse xs))
 315    go _  []                     = Nothing
 316    go (x:xs) (y:ys) | x == y    = go xs ys
 317                     | otherwise = Nothing
 318
 319    addNewOne | opt_WarnHiShadows = conflict
 320              | otherwise         = stickWithOld
 321
 322    stickWithOld old new = old
 323    overrideNew  old new = new
 324
 325    conflict old_path new_path
 326     | old_path /= new_path =
 327         pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
 328                               text (show old_path) <+> text "shadows" $$
 329                               text (show new_path) $$
 330                               text "on the import path: " <+>
 331                               text (concat (intersperse ":" (map fst dirs))))
 332         old_path
 333     | otherwise = old_path      -- don't warn about innocous shadowings.
 334 \end{code}
 335
 336
 337 %*********************************************************
 338 %*                                                       *
 339 \subsection{Making a search path}
 340 %*                                                       *
 341 %*********************************************************
 342
 343 @mkSearchPath@ takes a string consisting of a colon-separated list
 344 of directories and corresponding suffixes, and turns it into a list
 345 of (directory, suffix) pairs.  For example:
 346
 347 \begin{verbatim}
 348  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
 349    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
 350 \begin{verbatim}
 351
 352 \begin{code}
 353 mkSearchPath :: Maybe String -> SearchPath
 354 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
 355                                       -- the directory the module we're compiling
 356                                       -- lives.
 357 mkSearchPath (Just s) = go s
 358   where
 359     go "" = []
 360     go s  =
 361       case span (/= '%') s of
 362        (dir,'%':rs) ->
 363          case span (/= opt_HiMapSep) rs of
 364           (hisuf,_:rest) -> (dir,hisuf):go rest
 365           (hisuf,[])     -> [(dir,hisuf)]
 366 \end{code}
 367