ghc/compiler/basicTypes/Module.lhs

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