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