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
   9 Notes on DLLs
  10 ~~~~~~~~~~~~~
  11 When compiling module A, which imports module B, we need to
  12 know whether B will be in the same DLL as A.
  13         If it's in the same DLL, we refer to B_f_closure
  14         If it isn't, we refer to _imp__B_f_closure
  15 When compiling A, we record in B's Module value whether it's
  16 in a different DLL, by setting the DLL flag.
  17
  18
  19
  20
  21 \begin{code}
  22 module Module
  23     (
  24       Module                -- abstract, instance of Eq, Ord, Outputable
  25     , ModuleName
  26
  27     , moduleNameString          -- :: ModuleName -> EncodedString
  28     , moduleNameUserString      -- :: ModuleName -> UserString
  29
  30     , moduleString          -- :: Module -> EncodedString
  31     , moduleUserString      -- :: Module -> UserString
  32     , moduleName            -- :: Module -> ModuleName
  33
  34     , mkVanillaModule       -- :: ModuleName -> Module
  35     , mkThisModule          -- :: ModuleName -> Module
  36     , mkPrelModule          -- :: UserString -> Module
  37     , mkModule              -- :: ModuleName -> PackageName -> Module
  38
  39     , isLocalModule       -- :: Module -> Bool
  40
  41     , mkSrcModule
  42
  43     , mkSrcModuleFS         -- :: UserFS    -> ModuleName
  44     , mkSysModuleFS         -- :: EncodedFS -> ModuleName
  45
  46     , pprModule, pprModuleName
  47
  48     , PackageName
  49
  50         -- Where to find a .hi file
  51     , WhereFrom(..), SearchPath, mkSearchPath
  52     , ModuleHiMap, mkModuleHiMaps
  53
  54     ) where
  55
  56 #include "HsVersions.h"
  57 import OccName
  58 import Outputable
  59 import FiniteMap
  60 import CmdLineOpts      ( opt_Static, opt_InPackage, opt_WarnHiShadows, opt_HiMapSep )
  61 import Constants        ( interfaceFileFormatVersion )
  62 import Maybes           ( seqMaybe )
  63 import Maybe            ( fromMaybe )
  64 import Directory        ( doesFileExist )
  65 import DirUtils         ( getDirectoryContents )
  66 import List             ( intersperse )
  67 import Monad            ( foldM )
  68 import IO               ( hPutStrLn, stderr, isDoesNotExistError )
  69 import FastString       ( FastString )
  70 \end{code}
  71
  72
  73 %************************************************************************
  74 %*                                                                      *
  75 \subsection{Interface file flavour}
  76 %*                                                                      *
  77 %************************************************************************
  78
  79 A further twist to the tale is the support for dynamically linked libraries under
  80 Win32. Here, dealing with the use of global variables that's residing in a DLL
  81 requires special handling at the point of use (there's an extra level of indirection,
  82 i.e., (**v) to get at v's value, rather than just (*v) .) When slurping in an
  83 interface file we then record whether it's coming from a .hi corresponding to a
  84 module that's packaged up in a DLL or not, so that we later can emit the
  85 appropriate code.
  86
  87 The logic for how an interface file is marked as corresponding to a module that's
  88 hiding in a DLL is explained elsewhere (ToDo: give renamer href here.)
  89
  90 \begin{code}
  91 data PackageInfo = ThisPackage                  -- A module from the same package
  92                                                 -- as the one being compiled
  93                  | AnotherPackage PackageName   -- A module from a different package
  94
  95 type PackageName = FastString           -- No encoding at all
  96
  97 preludePackage :: PackageName
  98 preludePackage = SLIT("std")
  99
 100 instance Show PackageInfo where -- Just used in debug prints of lex tokens
 101                                 -- and in debug modde
 102   showsPrec n ThisPackage        s = "<THIS>"   ++ s
 103   showsPrec n (AnotherPackage p) s = (_UNPK_ p) ++ s
 104 \end{code}
 105
 106
 107 %************************************************************************
 108 %*                                                                      *
 109 \subsection{Where from}
 110 %*                                                                      *
 111 %************************************************************************
 112
 113 The @WhereFrom@ type controls where the renamer looks for an interface file
 114
 115 \begin{code}
 116 data WhereFrom = ImportByUser           -- Ordinary user import: look for M.hi
 117                | ImportByUserSource     -- User {- SOURCE -}: look for M.hi-boot
 118                | ImportBySystem         -- Non user import.  Look for M.hi if M is in
 119                                         -- the module this module depends on, or is a system-ish module;
 120                                         -- M.hi-boot otherwise
 121
 122 instance Outputable WhereFrom where
 123   ppr ImportByUser       = empty
 124   ppr ImportByUserSource = ptext SLIT("{- SOURCE -}")
 125   ppr ImportBySystem     = ptext SLIT("{- SYSTEM IMPORT -}")
 126 \end{code}
 127
 128
 129 %************************************************************************
 130 %*                                                                      *
 131 \subsection{The name of a module}
 132 %*                                                                      *
 133 %************************************************************************
 134
 135 \begin{code}
 136 type ModuleName = EncodedFS
 137         -- Haskell module names can include the quote character ',
 138         -- so the module names have the z-encoding applied to them
 139
 140 pprModuleName :: ModuleName -> SDoc
 141 pprModuleName nm = pprEncodedFS nm
 142
 143 moduleNameString :: ModuleName -> EncodedString
 144 moduleNameString mod = _UNPK_ mod
 145
 146 moduleNameUserString :: ModuleName -> UserString
 147 moduleNameUserString mod = decode (_UNPK_ mod)
 148
 149 mkSrcModule :: UserString -> ModuleName
 150 mkSrcModule s = _PK_ (encode s)
 151
 152 mkSrcModuleFS :: UserFS -> ModuleName
 153 mkSrcModuleFS s = encodeFS s
 154
 155 mkSysModuleFS :: EncodedFS -> ModuleName
 156 mkSysModuleFS s = s
 157 \end{code}
 158
 159 \begin{code}
 160 data Module = Module ModuleName PackageInfo
 161 \end{code}
 162
 163 \begin{code}
 164 instance Outputable Module where
 165   ppr = pprModule
 166
 167 instance Eq Module where
 168   (Module m1 _) == (Module m2 _) = m1 == m2
 169
 170 instance Ord Module where
 171   (Module m1 _) `compare` (Module m2 _) = m1 `compare` m2
 172 \end{code}
 173
 174
 175 \begin{code}
 176 pprModule :: Module -> SDoc
 177 pprModule (Module mod p) = getPprStyle $ \ sty ->
 178                            if debugStyle sty then
 179                                 -- Print the package too
 180                                 text (show p) <> dot <> pprModuleName mod
 181                            else
 182                                 pprModuleName mod
 183 \end{code}
 184
 185
 186 \begin{code}
 187 mkModule :: ModuleName  -- Name of the module
 188          -> PackageName
 189          -> Module
 190 mkModule mod_nm pack_name
 191   = Module mod_nm pack_info
 192   where
 193     pack_info | pack_name == opt_InPackage = ThisPackage
 194               | otherwise                  = AnotherPackage pack_name
 195
 196
 197 mkVanillaModule :: ModuleName -> Module
 198 mkVanillaModule name = Module name ThisPackage
 199         -- Used temporarily when we first come across Foo.x in an interface
 200         -- file, but before we've opened Foo.hi.
 201         -- (Until we've opened Foo.hi we don't know what the PackageInfo is.)
 202
 203 mkThisModule :: ModuleName -> Module    -- The module being compiled
 204 mkThisModule name = Module name ThisPackage
 205
 206 mkPrelModule :: ModuleName -> Module
 207 mkPrelModule name = mkModule name preludePackage
 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 isLocalModule :: Module -> Bool
 221 isLocalModule (Module _ ThisPackage) = True
 222 isLocalModule _                      = False
 223 \end{code}
 224
 225
 226 %************************************************************************
 227 %*                                                                      *
 228 \subsection{Finding modules in the file system
 229 %*                                                                      *
 230 %************************************************************************
 231
 232 \begin{code}
 233 type ModuleHiMap = FiniteMap ModuleName String
 234   -- Mapping from module name to
 235   --    * the file path of its corresponding interface file,
 236   --    * the ModuleName
 237 \end{code}
 238
 239 (We allege that) it is quicker to build up a mapping from module names
 240 to the paths to their corresponding interface files once, than to search
 241 along the import part every time we slurp in a new module (which we
 242 do quite a lot of.)
 243
 244 \begin{code}
 245 type SearchPath = [(String,String)]     -- List of (directory,suffix) pairs to search
 246                                         -- for interface files.
 247
 248 mkModuleHiMaps :: SearchPath -> IO (SearchPath, ModuleHiMap, ModuleHiMap)
 249 mkModuleHiMaps dirs = do (hi,hi_boot) <- foldM (getAllFilesMatching dirs) (env,env) dirs
 250                          return (dirs, hi, hi_boot)
 251  where
 252   env = emptyFM
 253
 254 getAllFilesMatching :: SearchPath
 255                     -> (ModuleHiMap, ModuleHiMap)
 256                     -> (FilePath, String)
 257                     -> IO (ModuleHiMap, ModuleHiMap)
 258 getAllFilesMatching dirs hims (dir_path, suffix) = ( do
 259     -- fpaths entries do not have dir_path prepended
 260   fpaths  <- getDirectoryContents dir_path
 261   return (foldl addModules hims fpaths))
 262   -- soft failure
 263       `catch`
 264         (\ err -> do
 265               hPutStrLn stderr
 266                      ("Import path element `" ++ dir_path ++
 267                       if (isDoesNotExistError err) then
 268                          "' does not exist, ignoring."
 269                       else
 270                         "' couldn't read, ignoring.")
 271
 272               return hims
 273         )
 274  where
 275    xiffus        = reverse dotted_suffix
 276    dotted_suffix = case suffix of
 277                       []       -> []
 278                       ('.':xs) -> suffix
 279                       ls       -> '.':ls
 280
 281    hi_boot_version_xiffus =
 282       reverse (show interfaceFileFormatVersion) ++ '-':hi_boot_xiffus
 283    hi_boot_xiffus = "toob-ih." -- .hi-boot reversed!
 284
 285    addModules his@(hi_env, hib_env) filename = fromMaybe his $
 286         FMAP add_hi   (go xiffus                 rev_fname)     `seqMaybe`
 287
 288         FMAP add_vhib (go hi_boot_version_xiffus rev_fname)     `seqMaybe`
 289                 -- If there's a Foo.hi-boot-N file then override any Foo.hi-boot
 290
 291         FMAP add_hib  (go hi_boot_xiffus         rev_fname)
 292      where
 293         rev_fname = reverse filename
 294         path      = dir_path ++ '/':filename
 295
 296           -- In these functions file_nm is the base of the filename,
 297           -- with the path and suffix both stripped off.  The filename
 298           -- is the *unencoded* module name (else 'make' gets confused).
 299           -- But the domain of the HiMaps is ModuleName which is encoded.
 300         add_hi    file_nm = (add_to_map addNewOne hi_env file_nm,   hib_env)
 301         add_vhib  file_nm = (hi_env, add_to_map overrideNew hib_env file_nm)
 302         add_hib   file_nm = (hi_env, add_to_map addNewOne   hib_env file_nm)
 303
 304         add_to_map combiner env file_nm
 305           = addToFM_C combiner env mod_nm path
 306           where
 307             mod_nm = mkSrcModuleFS file_nm
 308
 309    -- go prefix (prefix ++ stuff) == Just (reverse stuff)
 310    go [] xs                     = Just (_PK_ (reverse xs))
 311    go _  []                     = Nothing
 312    go (x:xs) (y:ys) | x == y    = go xs ys
 313                     | otherwise = Nothing
 314
 315    addNewOne | opt_WarnHiShadows = conflict
 316              | otherwise         = stickWithOld
 317
 318    stickWithOld old new = old
 319    overrideNew  old new = new
 320
 321    conflict old_path new_path
 322     | old_path /= new_path =
 323         pprTrace "Warning: " (text "Identically named interface files present on the import path, " $$
 324                               text (show old_path) <+> text "shadows" $$
 325                               text (show new_path) $$
 326                               text "on the import path: " <+>
 327                               text (concat (intersperse ":" (map fst dirs))))
 328         old_path
 329     | otherwise = old_path      -- don't warn about innocous shadowings.
 330 \end{code}
 331
 332
 333 %*********************************************************
 334 %*                                                       *
 335 \subsection{Making a search path}
 336 %*                                                       *
 337 %*********************************************************
 338
 339 @mkSearchPath@ takes a string consisting of a colon-separated list
 340 of directories and corresponding suffixes, and turns it into a list
 341 of (directory, suffix) pairs.  For example:
 342
 343 \begin{verbatim}
 344  mkSearchPath "foo%.hi:.%.p_hi:baz%.mc_hi"
 345    = [("foo",".hi"),( ".", ".p_hi"), ("baz",".mc_hi")]
 346 \begin{verbatim}
 347
 348 \begin{code}
 349 mkSearchPath :: Maybe String -> SearchPath
 350 mkSearchPath Nothing = [(".",".hi")]  -- ToDo: default should be to look in
 351                                       -- the directory the module we're compiling
 352                                       -- lives.
 353 mkSearchPath (Just s) = go s
 354   where
 355     go "" = []
 356     go s  =
 357       case span (/= '%') s of
 358        (dir,'%':rs) ->
 359          case span (/= opt_HiMapSep) rs of
 360           (hisuf,_:rest) -> (dir,hisuf):go rest
 361           (hisuf,[])     -> [(dir,hisuf)]
 362 \end{code}
 363