ghc/compiler/rename/RnIfaces.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
   5
   6 \begin{code}
   7 #include "HsVersions.h"
   8
   9 module RnIfaces (
  10         findHiFiles,
  11         cachedIface,
  12         readIface,
  13         rnIfaces,
  14         finalIfaceInfo,
  15         IfaceCache(..),
  16         VersionInfo(..)
  17     ) where
  18
  19 import Ubiq
  20
  21 import LibDirectory
  22 import PreludeGlaST     ( returnPrimIO, thenPrimIO, seqPrimIO,
  23                           readVar, writeVar, MutableVar(..)
  24                         )
  25
  26 import HsSyn
  27 import RdrHsSyn
  28 import RnHsSyn
  29
  30 import RnMonad
  31 import RnUtils          ( RnEnv(..) )
  32 import ParseIface       ( parseIface, ParsedIface )
  33
  34 import Bag              ( emptyBag )
  35 import CmdLineOpts      ( opt_HiSuffix, opt_SysHiSuffix )
  36 import ErrUtils         ( Error(..), Warning(..) )
  37 import FiniteMap        ( emptyFM, lookupFM, addToFM )
  38 import Pretty
  39 import Maybes           ( MaybeErr(..) )
  40 import Util             ( startsWith, panic )
  41 \end{code}
  42
  43 \begin{code}
  44 type ModuleToIfaceContents = FiniteMap Module ParsedIface
  45 type ModuleToIfaceFilePath = FiniteMap Module FilePath
  46
  47 type IfaceCache
  48   = MutableVar _RealWorld (ModuleToIfaceContents,
  49                            ModuleToIfaceFilePath)
  50 \end{code}
  51
  52 *********************************************************
  53 *                                                       *
  54 \subsection{Looking for interface files}
  55 *                                                       *
  56 *********************************************************
  57
  58 Return a mapping from module-name to
  59 absolute-filename-for-that-interface.
  60 \begin{code}
  61 findHiFiles :: [FilePath] -> [FilePath] -> IO (FiniteMap Module FilePath)
  62
  63 findHiFiles dirs sysdirs
  64   = do_dirs emptyFM (dirs ++ sysdirs)
  65   where
  66     do_dirs env [] = return env
  67     do_dirs env (dir:dirs)
  68       = do_dir  env     dir     >>= \ new_env ->
  69         do_dirs new_env dirs
  70     -------
  71     do_dir env dir
  72       = --trace ("Having a go on..."++dir) $
  73         getDirectoryContents dir    >>= \ entries ->
  74         do_entries env entries
  75     -------
  76     do_entries env [] = return env
  77     do_entries env (e:es)
  78       = do_entry   env     e    >>= \ new_env ->
  79         do_entries new_env es
  80     -------
  81     do_entry env e
  82       = case (acceptable_hi (reverse e)) of
  83           Nothing  -> --trace ("Deemed uncool:"++e) $
  84                       return env
  85           Just mod -> let
  86                             pmod = _PK_ mod
  87                       in
  88                       case (lookupFM env pmod) of
  89                         Nothing -> --trace ("Adding "++mod++" -> "++e) $
  90                                    return (addToFM env pmod e)
  91                         Just xx -> trace ("Already mapped: "++mod++" -> "++xx) $
  92                                    return env
  93     -------
  94     acceptable_hi rev_e -- looking at pathname *backwards*
  95       = case (startsWith (reverse opt_HiSuffix) rev_e) of
  96           Nothing -> Nothing
  97           Just xs -> plausible_modname xs{-reversed-}
  98
  99     -------
 100     plausible_modname rev_e
 101       = let
 102             cand = reverse (takeWhile is_modname_char rev_e)
 103         in
 104         if null cand || not (isUpper (head cand))
 105         then Nothing
 106         else Just cand
 107       where
 108         is_modname_char c = isAlphanum c || c == '_'
 109 \end{code}
 110
 111 *********************************************************
 112 *                                                       *
 113 \subsection{Reading interface files}
 114 *                                                       *
 115 *********************************************************
 116
 117 Return cached info about a Module's interface; otherwise,
 118 read the interface (using our @ModuleToIfaceFilePath@ map
 119 to decide where to look).
 120
 121 \begin{code}
 122 cachedIface :: IfaceCache
 123             -> Module
 124             -> IO (MaybeErr ParsedIface Error)
 125
 126 cachedIface iface_var mod
 127   = readVar iface_var `thenPrimIO` \ (iface_fm, file_fm) ->
 128
 129     case (lookupFM iface_fm mod) of
 130       Just iface -> return (Succeeded iface)
 131       Nothing    ->
 132         case (lookupFM file_fm mod) of
 133           Nothing   -> return (Failed (noIfaceErr mod))
 134           Just file ->
 135             readIface file mod >>= \ read_iface ->
 136             case read_iface of
 137               Failed err      -> return (Failed err)
 138               Succeeded iface ->
 139                 let
 140                     iface_fm' = addToFM iface_fm mod iface
 141                 in
 142                 writeVar iface_var (iface_fm', file_fm) `seqPrimIO`
 143                 return (Succeeded iface)
 144 \end{code}
 145
 146 \begin{code}
 147 readIface :: FilePath -> Module
 148               -> IO (MaybeErr ParsedIface Error)
 149
 150 readIface file mod
 151   = readFile file   `thenPrimIO` \ read_result ->
 152     case read_result of
 153       Left  err      -> return (Failed    (cannaeReadErr file))
 154       Right contents -> return (Succeeded (parseIface contents))
 155 \end{code}
 156
 157
 158 \begin{code}
 159 rnIfaces :: IfaceCache                          -- iface cache
 160          -> RnEnv                               -- original name env
 161          -> UniqSupply
 162          -> RenamedHsModule                     -- module to extend with iface decls
 163          -> [RnName]                            -- imported names required
 164          -> PrimIO (RenamedHsModule,            -- extended module
 165                     ImplicitEnv,                -- implicit names required
 166                     Bag Error,
 167                     Bag Warning)
 168
 169 rnIfaces iface_var occ_env us rn_module todo
 170   = returnPrimIO (rn_module, (emptyFM, emptyFM), emptyBag, emptyBag)
 171 \end{code}
 172
 173
 174 \begin{code}
 175 finalIfaceInfo ::
 176            IfaceCache                           -- iface cache
 177         -> [RnName]                             -- all imported names required
 178         -> [Module]                             -- directly imported modules
 179         -> PrimIO (VersionInfo,                 -- info about version numbers
 180                    [Module])                    -- special instance modules
 181
 182 type VersionInfo = [(Module, Version, [(FAST_STRING, Version)])]
 183
 184 finalIfaceInfo iface_var imps_reqd imp_mods
 185   = returnPrimIO ([], [])
 186 \end{code}
 187
 188
 189 \begin{code}
 190 noIfaceErr mod sty
 191   = ppCat [ppPStr SLIT("Could not find interface for:"), ppPStr mod]
 192
 193 cannaeReadErr file sty
 194   = ppCat [ppPStr SLIT("Failed in reading file:"), ppStr file]
 195 \end{code}