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