[project @ 1999-12-09 12:30:56 by simonpj]

[ghc-hetmet.git] / ghc / compiler / rename / RnMonad.lhs

diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs
index 5494fe3..99cc716 100644 (file)
--- a/ghc/compiler/rename/RnMonad.lhs
+++ b/ghc/compiler/rename/RnMonad.lhs
@@ -20,7 +20,9 @@ module RnMonad(
 
 #include "HsVersions.h"
 
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 302
+#if   defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 405
+import IOExts          ( fixIO )
+#elif defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 302
 import PrelIOBase      ( fixIO )       -- Should be in GlaExts
 #else
 import IOBase          ( fixIO )
@@ -40,11 +42,11 @@ import Name         ( Name, OccName, NamedThing(..),
                          decode, mkLocalName
                        )
 import Module          ( Module, ModuleName, ModuleHiMap, SearchPath, WhereFrom,
-                         mkModuleHiMaps, moduleName
+                         mkModuleHiMaps, moduleName, mkVanillaModule, mkSearchPath
                        )
 import NameSet         
 import RdrName         ( RdrName, dummyRdrVarName, rdrNameOcc )
-import CmdLineOpts     ( opt_D_dump_rn_trace, opt_IgnoreIfacePragmas )
+import CmdLineOpts     ( opt_D_dump_rn_trace, opt_HiMap )
 import PrelInfo                ( builtinNames )
 import TysWiredIn      ( boolTyCon )
 import SrcLoc          ( SrcLoc, mkGeneratedSrcLoc )
@@ -197,12 +199,14 @@ type FixityEnv = NameEnv RenamedFixitySig
 type RnNameSupply
  = ( UniqSupply
 
-   , FiniteMap (OccName, OccName) Int
+   , FiniteMap String Int
        -- This is used as a name supply for dictionary functions
-       -- From the inst decl we derive a (class, tycon) pair;
+       -- From the inst decl we derive a string, usually by glomming together
+       -- the class and tycon name -- but it doesn't matter exactly how;
        -- this map then gives a unique int for each inst decl with that
-       -- (class, tycon) pair.  (In Haskell 98 there can only be one,
-       -- but not so in more extended versions.)
+       -- string.  (In Haskell 98 there can only be one,
+       -- but not so in more extended versions; also class CC type T
+       -- and class C type TT might both give the string CCT
        --      
        -- We could just use one Int for all the instance decls, but this
        -- way the uniques change less when you add an instance decl,   
@@ -214,7 +218,10 @@ type RnNameSupply
 
 
 --------------------------------
-data ExportEnv   = ExportEnv Avails Fixities
+data ExportEnv   = ExportEnv Avails Fixities [ModuleName]
+                       -- The list of modules is the modules exported
+                       -- with 'module M' in the export list
+
 type Avails      = [AvailInfo]
 type Fixities    = [(Name, Fixity)]
 
@@ -283,7 +290,7 @@ type InterfaceDetails = (WhetherHasOrphans,
 
 -- needed by Main to fish out the fixities assoc list.
 getIfaceFixities :: InterfaceDetails -> Fixities
-getIfaceFixities (_, _, ExportEnv _ fs) = fs
+getIfaceFixities (_, _, ExportEnv _ fs _) = fs
 
 
 type RdrNamePragma = ()                                -- Fudge for now
@@ -292,7 +299,9 @@ type RdrNamePragma = ()                             -- Fudge for now
 data Ifaces = Ifaces {
                iImpModInfo :: ImportedModuleInfo,
                                -- Modules this one depends on: that is, the union 
-                               -- of the modules its direct imports depend on.
+                               -- of the modules its *direct* imports depend on.
+                               -- NB: The direct imports have .hi files that enumerate *all* the
+                               -- dependencies (direct or not) of the imported module.
 
                iDecls :: DeclsMap,     -- A single, global map of Names to decls
 
@@ -441,12 +450,15 @@ renameSourceCode mod_name name_supply m
        -- only do any I/O if we need to read in a fixity declaration;
        -- and that doesn't happen in pragmas etc
 
+        mkModuleHiMaps (mkSearchPath opt_HiMap) >>= \ himaps ->
        newIORef name_supply            >>= \ names_var ->
        newIORef (emptyBag,emptyBag)    >>= \ errs_var ->
        let
            rn_down = RnDown { rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
-                              rn_errs = errs_var,
-                              rn_mod = mod_name }
+                              rn_errs = errs_var, rn_hi_maps = himaps,
+                              rn_mod = mod_name, 
+                              rn_ifaces = panic "rnameSourceCode: rn_ifaces"  -- Not required
+                            }
            s_down = SDown { rn_mode = InterfaceMode,
                               -- So that we can refer to PrelBase.True etc
                             rn_genv = emptyRdrEnv, rn_lenv = emptyRdrEnv,
@@ -615,7 +627,7 @@ setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
   = writeIORef names_var names'
 
 -- See comments with RnNameSupply above.
-newInstUniq :: (OccName, OccName) -> RnM d Int
+newInstUniq :: String -> RnM d Int
 newInstUniq key (RnDown {rn_ns = names_var}) l_down
   = readIORef names_var                                >>= \ (us, mapInst, cache) ->
     let
@@ -722,3 +734,13 @@ getHiMaps :: RnM d (ModuleHiMap, ModuleHiMap)
 getHiMaps (RnDown {rn_hi_maps = himaps}) _ 
   = return himaps
 \end{code}
+
+\begin{code}
+lookupModuleRn :: ModuleName -> RnM d Module
+lookupModuleRn x = 
+  getHiMaps `thenRn` \ (himap, _) ->
+  case lookupFM himap x of
+    Nothing    -> returnRn (mkVanillaModule x)
+    Just (_,x) -> returnRn x
+
+\end{code}