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