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
  25     , isDynamicModule       -- :: Module -> Bool
  26     , isLibModule
  27
  28     , mkSrcModule
  29
  30     , mkSrcModuleFS         -- :: UserFS    -> ModuleName
  31     , mkSysModuleFS         -- :: EncodedFS -> ModuleName
  32
  33     , pprModule, pprModuleName
  34
  35         -- DllFlavour
  36     , DllFlavour, dll, notDll
  37
  38         -- ModFlavour
  39     , ModFlavour, libMod, userMod
  40
  41         -- Where to find a .hi file
  42     , WhereFrom(..), SearchPath, mkSearchPath
  43     , ModuleHiMap, mkModuleHiMaps
  44
  45     ) where
  46
  47 #include "HsVersions.h"
  48 import OccName
  49 import Outputable
  50 import FiniteMap
  51 import CmdLineOpts      ( opt_Static, opt_CompilingPrelude, opt_WarnHiShadows, opt_HiMapSep )
  52 import Constants        ( interfaceFileFormatVersion )
  53 import Maybes           ( seqMaybe )
  54 import Maybe            ( fromMaybe )
  55 import Directory        ( doesFileExist )
  56 import DirUtils         ( getDirectoryContents )
  57 import List             ( intersperse )
  58 import Monad            ( foldM )
  59 import IO               ( hPutStrLn, stderr, isDoesNotExistError )
  60 \end{code}
  61
  62
  63 %************************************************************************
  64 %*                                                                      *
  65 \subsection{Interface file flavour}
  66 %*                                                                      *
  67 %************************************************************************
  68
  69 A further twist to the tale is the support for dynamically linked libraries under
  70 Win32. Here, dealing with the use of global variables that's residing in a DLL
  71 requires special handling at the point of use (there's an extra level of indirection,
  72 i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an
  73 interface file we then record whether it's coming from a .hi corresponding to a
  74 module that's packaged up in a DLL or not, so that we later can emit the
  75 appropriate code.
  76
  77 The logic for how an interface file is marked as corresponding to a module that's
  78 hiding in a DLL is explained elsewhere (ToDo: give renamer href here.)
  79
  80 \begin{code}
  81 data DllFlavour = NotDll        -- Ordinary module
  82                 | Dll           -- The module's object code lives in a DLL.
  83                 deriving( Eq )
  84
  85 dll    = Dll
  86 notDll = NotDll
  87
  88 instance Text DllFlavour where  -- Just used in debug prints of lex tokens
  89   showsPrec n NotDll s = s
  90   showsPrec n Dll    s = "dll " ++ 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 \begin{code}
 105 data ModFlavour = LibMod        -- A library-ish module
 106                 | UserMod       -- Not library-ish
 107
 108 libMod  = LibMod
 109 userMod = UserMod
 110 \end{code}
 111
 112
 113 %************************************************************************
 114 %*                                                                      *
 115 \subsection{Where from}
 116 %*                                                                      *
 117 %************************************************************************
 118
 119 The @WhereFrom@ type controls where the renamer looks for an interface file
 120
 121 \begin{code}
 122 data WhereFrom = ImportByUser           -- Ordinary user import: look for M.hi
 123                | ImportByUserSource     -- User {- SOURCE -}: look for M.hi-boot
 124                | ImportBySystem         -- Non user import.  Look for M.hi if M is in
 125                                         -- the module this module depends on, or is a system-ish module;
 126                                         -- M.hi-boot otherwise
 127
 128 instance Outputable WhereFrom where
 129   ppr ImportByUser       = empty
 130   ppr ImportByUserSource = ptext SLIT("{- SOURCE -}")
 131   ppr ImportBySystem     = ptext SLIT("{- SYSTEM IMPORT -}")
 132 \end{code}
 133
 134
 135 %************************************************************************
 136 %*                                                                      *
 137 \subsection{The name of a module}
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 \begin{code}
 142 type ModuleName = EncodedFS
 143         -- Haskell module names can include the quote character ',
 144         -- so the module names have the z-encoding applied to them
 145
 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
 168                 ModuleName
 169                 ModFlavour
 170                 DllFlavour
 171 \end{code}
 172
 173 \begin{code}
 174 instance Outputable Module where
 175   ppr = pprModule
 176
 177 instance Eq Module where
 178   (Module m1 _  _) == (Module m2 _ _) = m1 == m2
 179
 180 instance Ord Module where
 181   (Module m1 _ _) `compare` (Module m2 _ _) = m1 `compare` m2
 182 \end{code}
 183
 184
 185 \begin{code}
 186 pprModule :: Module -> SDoc
 187 pprModule (Module mod _ _) = pprEncodedFS mod
 188 \end{code}
 189
 190
 191 \begin{code}
 192 mkModule = Module
 193
 194 mkVanillaModule :: ModuleName -> Module
 195 mkVanillaModule name = Module name UserMod dell
 196  where
 197   dell | opt_Static || opt_CompilingPrelude = NotDll
 198        | otherwise                          = Dll
 199
 200
 201 mkThisModule :: ModuleName -> Module    -- The module being comiled
 202 mkThisModule name =
 203   Module name UserMod NotDll -- This is fine, a Dll flag is only
 204                              -- pinned on imported modules.
 205
 206 mkPrelModule :: ModuleName -> Module
 207 mkPrelModule name = Module name sys dll
 208  where
 209   sys | opt_CompilingPrelude = UserMod
 210       | otherwise            = LibMod
 211
 212   dll | opt_Static || opt_CompilingPrelude = NotDll
 213       | otherwise                          = Dll
 214
 215 moduleString :: Module -> EncodedString
 216 moduleString (Module mod _ _) = _UNPK_ mod
 217
 218 moduleName :: Module -> ModuleName
 219 moduleName (Module mod _ _) = mod
 220
 221 moduleUserString :: Module -> UserString
 222 moduleUserString (Module mod _ _) = moduleNameUserString mod
 223 \end{code}
 224
 225 \begin{code}
 226 isDynamicModule :: Module -> Bool
 227 isDynamicModule (Module _ _ Dll)  = True
 228 isDynamicModule _                 = False
 229
 230 isLibModule :: Module -> Bool
 231 isLibModule (Module _ LibMod _) = True
 232 isLibModule _                   = False
 233 \end{code}
 234
 235
 236 %************************************************************************
 237 %*                                                                      *
 238 \subsection{Finding modules in the file system
 239 %*                                                                      *
 240 %************************************************************************
 241
 242 \begin{code}
 243 type ModuleHiMap = FiniteMap ModuleName (String, Module)
 244   -- Mapping from module name to
 245   --    * the file path of its corresponding interface file,
 246   --    * the Module, decorated with it's properties
 247 \end{code}
 248
 249 (We allege that) it is quicker to build up a mapping from module names
 250 to the paths to their corresponding interface files once, than to search
 251 along the import part every time we slurp in a new module (which we
 252 do quite a lot of.)
 253
 254 \begin{code}
 255 type SearchPath = [(String,String)]     -- List of (directory,suffix) pairs to search
 256                                         -- for interface files.
 257
 258 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
 259 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
 260  where
 261   env = emptyFM
 262
 263 {- A pseudo file, currently "dLL_ifs.hi",
 264    signals that the interface files
 265    contained in a particular directory have got their
 266    corresponding object codes stashed away in a DLL
 267
 268    This stuff is only needed to deal with Win32 DLLs,
 269    and conceivably we conditionally compile in support
 270    for handling it. (ToDo?)
 271 -}
 272 dir_contain_dll_his = "dLL_ifs.hi"
 273
 274 getAllFilesMatching :: SearchPath
 275                     -> (ModuleHiMap, ModuleHiMap)
 276                     -> (FilePath, String)
 277                     -> IO (ModuleHiMap, ModuleHiMap)
 278 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 279     -- fpaths entries do not have dir_path prepended
 280   fpaths  <- getDirectoryContents dir_path
 281   is_dll <- catch
 282                 (if opt_Static || dir_path == "." then
 283                      return NotDll
 284                  else
 285                      do  exists <- doesFileExist (dir_path ++ '/': dir_contain_dll_his)
 286                          return (if exists then Dll else NotDll)
 287                 )
 288                 (\ _ {-don't care-} -> return NotDll)
 289   return (foldl (addModules is_dll) hims fpaths)
 290   )  -- soft failure
 291       `catch`
 292         (\ err -> do
 293               hPutStrLn stderr
 294                      ("Import path element `" ++ dir_path ++
 295                       if (isDoesNotExistError err) then
 296                          "' does not exist, ignoring."
 297                       else
 298                         "' couldn't read, ignoring.")
 299
 300               return hims
 301         )
 302  where
 303
 304    is_sys | isLibraryPath dir_path = LibMod
 305           | otherwise              = UserMod
 306
 307         -- Dreadfully crude way to tell whether a module is a "library"
 308         -- module or not.  The current story is simply that if path is
 309         -- absolute we treat it as a library.  Specifically:
 310         --      /usr/lib/ghc/
 311         --      C:/usr/lib/ghc
 312         --      C:\user\lib
 313    isLibraryPath ('/' : _             ) = True
 314    isLibraryPath (_   : ':' : '/'  : _) = True
 315    isLibraryPath (_   : ':' : '\\' : _) = True
 316    isLibraryPath other                  = False
 317
 318    xiffus        = reverse dotted_suffix
 319    dotted_suffix = case suffix of
 320                       []       -> []
 321                       ('.':xs) -> suffix
 322                       ls       -> '.':ls
 323
 324    hi_boot_version_xiffus =
 325       reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
 326    hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
 327
 328    addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $
 329         FMAP add_hi   (go xiffus                 rev_fname)     `seqMaybe`
 330
 331         FMAP add_vhib (go hi_boot_version_xiffus rev_fname)     `seqMaybe`
 332                 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
 333
 334         FMAP add_hib  (go hi_boot_xiffus         rev_fname)
 335      where
 336         rev_fname = reverse filename
 337         path      = dir_path ++ '/':filename
 338
 339           -- In these functions file_nm is the base of the filename,
 340           -- with the path and suffix both stripped off.  The filename
 341           -- is the *unencoded* module name (else 'make' gets confused).
 342           -- But the domain of the HiMaps is ModuleName which is encoded.
 343         add_hi    file_nm = (add_to_map addNewOne hi_env file_nm,   hib_env)
 344         add_vhib  file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
 345         add_hib   file_nm = (hi_env, add_to_map addNewOne   hib_env file_nm)
 346
 347         add_to_map combiner env file_nm
 348           = addToFM_C combiner env mod_nm (path, mkModule mod_nm is_sys is_dll)
 349           where
 350             mod_nm = mkSrcModuleFS file_nm
 351
 352    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
 353    go [] xs                     = Just (_PK_ (reverse xs))
 354    go _  []                     = Nothing
 355    go (x:xs) (y:ys) | x == y    = go xs ys
 356                     | otherwise = Nothing
 357
 358    addNewOne | opt_WarnHiShadows = conflict
 359              | otherwise         = stickWithOld
 360
 361    stickWithOld old new = old
 362    overrideNew  old new = new
 363
 364    conflict (old_path,mod) (new_path,_)
 365     | old_path /= new_path =
 366         pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
 367                               text (show old_path) <+> text "shadows" $$
 368                               text (show new_path) $$
 369                               text "on the import path: " <+>
 370                               text (concat (intersperse ":" (map fst dirs))))
 371         (old_path,mod)
 372     | otherwise = (old_path,mod)  -- don't warn about innocous shadowings.
 373 \end{code}
 374
 375
 376 %*********************************************************
 377 %*                                                       *
 378 \subsection{Making a search path}
 379 %*                                                       *
 380 %*********************************************************
 381
 382 @mkSearchPath@ takes a string consisting of a colon-separated list
 383 of directories and corresponding suffixes, and turns it into a list
 384 of (directory, suffix) pairs.  For example:
 385
 386 \begin{verbatim}
 387  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
 388    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
 389 \begin{verbatim}
 390
 391 \begin{code}
 392 mkSearchPath :: Maybe String -> SearchPath
 393 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
 394                                       -- the directory the module we're compiling
 395                                       -- lives.
 396 mkSearchPath (Just s) = go s
 397   where
 398     go "" = []
 399     go s  =
 400       case span (/= '%') s of
 401        (dir,'%':rs) ->
 402          case span (/= opt_HiMapSep) rs of
 403           (hisuf,_:rest) -> (dir,hisuf):go rest
 404           (hisuf,[])     -> [(dir,hisuf)]
 405 \end{code}
 406