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 )
  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 type ModuleNameSet = FiniteMap ModuleName
 147 elemModuleNameSet  s x = elemFM s x
 148 moduleNameSetElems s   = eltsFM s
 149
 150
 151 pprModuleName :: ModuleName -> SDoc
 152 pprModuleName nm = pprEncodedFS nm
 153
 154 moduleNameString :: ModuleName -> EncodedString
 155 moduleNameString mod = _UNPK_ mod
 156
 157 moduleNameUserString :: ModuleName -> UserString
 158 moduleNameUserString mod = decode (_UNPK_ mod)
 159
 160 mkSrcModule :: UserString -> ModuleName
 161 mkSrcModule s = _PK_ (encode s)
 162
 163 mkSrcModuleFS :: UserFS -> ModuleName
 164 mkSrcModuleFS s = encodeFS s
 165
 166 mkSysModuleFS :: EncodedFS -> ModuleName
 167 mkSysModuleFS s = s
 168 \end{code}
 169
 170 \begin{code}
 171 data Module = Module
 172                 ModuleName
 173                 ModFlavour
 174                 DllFlavour
 175 \end{code}
 176
 177 \begin{code}
 178 instance Outputable Module where
 179   ppr = pprModule
 180
 181 instance Eq Module where
 182   (Module m1 _  _) == (Module m2 _ _) = m1 == m2
 183
 184 instance Ord Module where
 185   (Module m1 _ _) `compare` (Module m2 _ _) = m1 `compare` m2
 186 \end{code}
 187
 188
 189 \begin{code}
 190 pprModule :: Module -> SDoc
 191 pprModule (Module mod _ _) = pprEncodedFS mod
 192 \end{code}
 193
 194
 195 \begin{code}
 196 mkModule = Module
 197
 198 mkVanillaModule :: ModuleName -> Module
 199 mkVanillaModule name = Module name UserMod NotDll
 200
 201 mkThisModule :: ModuleName -> Module    -- The module being comiled
 202 mkThisModule name = Module name UserMod NotDll  -- ToDo: correct Dll flag?
 203
 204 mkPrelModule :: ModuleName -> Module
 205 mkPrelModule name = Module name sys dll
 206  where
 207   sys | opt_CompilingPrelude = UserMod
 208       | otherwise            = LibMod
 209
 210   dll | opt_Static || opt_CompilingPrelude = NotDll
 211       | otherwise                          = Dll
 212
 213 moduleString :: Module -> EncodedString
 214 moduleString (Module mod _ _) = _UNPK_ mod
 215
 216 moduleName :: Module -> ModuleName
 217 moduleName (Module mod _ _) = mod
 218
 219 moduleUserString :: Module -> UserString
 220 moduleUserString (Module mod _ _) = moduleNameUserString mod
 221 \end{code}
 222
 223 \begin{code}
 224 isDynamicModule :: Module -> Bool
 225 isDynamicModule (Module _ _ Dll)  = True
 226 isDynamicModule _                 = False
 227
 228 isLibModule :: Module -> Bool
 229 isLibModule (Module _ LibMod _) = True
 230 isLibModule _                   = False
 231 \end{code}
 232
 233
 234 %************************************************************************
 235 %*                                                                      *
 236 \subsection{Finding modules in the file system
 237 %*                                                                      *
 238 %************************************************************************
 239
 240 \begin{code}
 241 type ModuleHiMap = FiniteMap ModuleName (String, Module)
 242   -- Mapping from module name to
 243   --    * the file path of its corresponding interface file,
 244   --    * the Module, decorated with it's properties
 245 \end{code}
 246
 247 (We allege that) it is quicker to build up a mapping from module names
 248 to the paths to their corresponding interface files once, than to search
 249 along the import part every time we slurp in a new module (which we
 250 do quite a lot of.)
 251
 252 \begin{code}
 253 type SearchPath = [(String,String)]     -- List of (directory,suffix) pairs to search
 254                                         -- for interface files.
 255
 256 mkModuleHiMaps :: SearchPath -> IO (ModuleHiMap, ModuleHiMap)
 257 mkModuleHiMaps dirs = foldM (getAllFilesMatching dirs) (env,env) dirs
 258  where
 259   env = emptyFM
 260
 261 {- A pseudo file, currently "dLL_ifs.hi",
 262    signals that the interface files
 263    contained in a particular directory have got their
 264    corresponding object codes stashed away in a DLL
 265
 266    This stuff is only needed to deal with Win32 DLLs,
 267    and conceivably we conditionally compile in support
 268    for handling it. (ToDo?)
 269 -}
 270 dir_contain_dll_his = "dLL_ifs.hi"
 271
 272 getAllFilesMatching :: SearchPath
 273                     -> (ModuleHiMap, ModuleHiMap)
 274                     -> (FilePath, String)
 275                     -> IO (ModuleHiMap, ModuleHiMap)
 276 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 277     -- fpaths entries do not have dir_path prepended
 278   fpaths  <- getDirectoryContents dir_path
 279   is_dll <- catch
 280                 (if opt_Static || dir_path == "." then
 281                      return NotDll
 282                  else
 283                      do  exists <- doesFileExist (dir_path ++ '/': dir_contain_dll_his)
 284                          return (if exists then Dll else NotDll)
 285                 )
 286                 (\ _ {-don't care-} -> return NotDll)
 287   return (foldl (addModules is_dll) hims fpaths)
 288   )  -- soft failure
 289       `catch`
 290         (\ err -> do
 291               hPutStrLn stderr
 292                      ("Import path element `" ++ dir_path ++
 293                       if (isDoesNotExistError err) then
 294                          "' does not exist, ignoring."
 295                       else
 296                         "' couldn't read, ignoring.")
 297
 298               return hims
 299         )
 300  where
 301
 302         -- Dreadfully crude.  We want a better way to distinguish
 303         -- "library-ish" modules.
 304    is_sys | head dir_path == '/' = LibMod
 305           | otherwise            = UserMod
 306
 307    xiffus        = reverse dotted_suffix
 308    dotted_suffix = case suffix of
 309                       []       -> []
 310                       ('.':xs) -> suffix
 311                       ls       -> '.':ls
 312
 313    hi_boot_version_xiffus =
 314       reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
 315    hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
 316
 317    addModules is_dll his@(hi_env, hib_env) filename = fromMaybe his $
 318         FMAP add_hi   (go xiffus                 rev_fname)     `seqMaybe`
 319         FMAP add_vhib (go hi_boot_version_xiffus rev_fname)     `seqMaybe`
 320         FMAP add_hib  (go hi_boot_xiffus         rev_fname)
 321     where
 322      rev_fname = reverse filename
 323      path      = dir_path ++ '/':filename
 324
 325      mk_module mod_nm = Module mod_nm is_sys is_dll
 326      add_hi    mod_nm = (addToFM_C addNewOne hi_env mod_nm (path, mk_module mod_nm), hib_env)
 327      add_vhib  mod_nm = (hi_env, addToFM_C overrideNew hib_env mod_nm (path, mk_module mod_nm))
 328      add_hib   mod_nm = (hi_env, addToFM_C addNewOne   hib_env mod_nm (path, mk_module mod_nm))
 329
 330
 331    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
 332    go [] xs                     = Just (_PK_ (reverse xs))
 333    go _  []                     = Nothing
 334    go (x:xs) (y:ys) | x == y    = go xs ys
 335                     | otherwise = Nothing
 336
 337    addNewOne | opt_WarnHiShadows = conflict
 338              | otherwise         = stickWithOld
 339
 340    stickWithOld old new = old
 341    overrideNew  old new = new
 342
 343    conflict (old_path,mod) (new_path,_)
 344     | old_path /= new_path =
 345         pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
 346                               text (show old_path) <+> text "shadows" $$
 347                               text (show new_path) $$
 348                               text "on the import path: " <+>
 349                               text (concat (intersperse ":" (map fst dirs))))
 350         (old_path,mod)
 351     | otherwise = (old_path,mod)  -- don't warn about innocous shadowings.
 352 \end{code}
 353
 354
 355 %*********************************************************
 356 %*                                                       *
 357 \subsection{Making a search path}
 358 %*                                                       *
 359 %*********************************************************
 360
 361 @mkSearchPath@ takes a string consisting of a colon-separated list
 362 of directories and corresponding suffixes, and turns it into a list
 363 of (directory, suffix) pairs.  For example:
 364
 365 \begin{verbatim}
 366  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
 367    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
 368 \begin{verbatim}
 369
 370 \begin{code}
 371 mkSearchPath :: Maybe String -> SearchPath
 372 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
 373                                       -- the directory the module we're compiling
 374                                       -- lives.
 375 mkSearchPath (Just s) = go s
 376   where
 377     go "" = []
 378     go s  =
 379       case span (/= '%') s of
 380        (dir,'%':rs) ->
 381          case span (/= ':') rs of
 382           (hisuf,_:rest) -> (dir,hisuf):go rest
 383           (hisuf,[])     -> [(dir,hisuf)]
 384 \end{code}
 385