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