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