[project @ 2000-10-23 16:39:11 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnMonad.lhs
index ddff54f..1b3bcfc 100644 (file)
@@ -35,6 +35,16 @@ import IOExts                ( IORef, newIORef, readIORef, writeIORef, unsafePerformIO )
 import HsSyn           
 import RdrHsSyn
 import RnHsSyn         ( RenamedFixitySig )
+import HscTypes                ( Finder,
+                         AvailEnv, lookupTypeEnv,
+                         OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
+                         WhetherHasOrphans, ImportVersion, 
+                         PersistentRenamerState(..), IsBootInterface, Avails,
+                         DeclsMap, IfaceInsts, IfaceRules, 
+                         HomeSymbolTable, PackageSymbolTable,
+                         PersistentCompilerState(..), GlobalRdrEnv,
+                         HomeIfaceTable, PackageIfaceTable,
+                         RdrAvailInfo, ModIface )
 import BasicTypes      ( Version, defaultFixity )
 import ErrUtils                ( addShortErrLocLine, addShortWarnLocLine,
                          pprBagOfErrors, ErrMsg, WarnMsg, Message
@@ -49,24 +59,17 @@ import Name         ( Name, OccName, NamedThing(..), getSrcLoc,
                          NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, 
                          extendNameEnvList
                        )
-import Module          ( Module, ModuleName, WhereFrom, moduleName )
+import Module          ( Module, ModuleName, lookupModuleEnvByName )
 import NameSet         
 import CmdLineOpts     ( DynFlags, DynFlag(..), dopt )
 import SrcLoc          ( SrcLoc, generatedSrcLoc )
 import Unique          ( Unique )
-import FiniteMap       ( FiniteMap, emptyFM, listToFM, plusFM )
-import Bag             ( Bag, mapBag, emptyBag, isEmptyBag, snocBag )
+import FiniteMap       ( FiniteMap, emptyFM )
+import Bag             ( Bag, emptyBag, isEmptyBag, snocBag )
 import UniqSupply
 import Outputable
-import Finder          ( Finder )
 import PrelNames       ( mkUnboundName )
-import HscTypes                ( GlobalSymbolTable, AvailEnv, 
-                         OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
-                         WhetherHasOrphans, ImportVersion, ExportItem,
-                         PersistentRenamerState(..), IsBootInterface, Avails,
-                         DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv,
-                         HomeSymbolTable, PackageSymbolTable,
-                         PersistentCompilerState(..), GlobalRdrEnv )
+import Maybes          ( maybeToBool, seqMaybe, orElse )
 
 infixr 9 `thenRn`, `thenRn_`
 \end{code}
@@ -118,7 +121,13 @@ data RnDown
 
        rn_finder  :: Finder,
        rn_dflags  :: DynFlags,
-       rn_hst     :: HomeSymbolTable,
+
+       rn_hit     :: HomeIfaceTable,
+       rn_done    :: Name -> Bool,     -- Tells what things (both in the
+                                       -- home package and other packages)
+                                       -- were already available (i.e. in
+                                       -- the relevant SymbolTable) before 
+                                       -- compiling this module
 
        rn_errs    :: IORef (Bag WarnMsg, Bag ErrMsg),
 
@@ -184,6 +193,7 @@ type ExportAvails = (FiniteMap ModuleName Avails,
 %===================================================
 
 \begin{code}
+type ExportItem = (ModuleName, [RdrAvailInfo])
 
 data ParsedIface
   = ParsedIface {
@@ -191,10 +201,10 @@ data ParsedIface
       pi_vers     :: Version,                          -- Module version number
       pi_orphan    :: WhetherHasOrphans,               -- Whether this module has orphans
       pi_usages           :: [ImportVersion OccName],          -- Usages
-      pi_exports   :: [ExportItem],                    -- Exports
+      pi_exports   :: (Version, [ExportItem]),         -- Exports
       pi_insts    :: [RdrNameInstDecl],                -- Local instance declarations
       pi_decls    :: [(Version, RdrNameHsDecl)],       -- Local definitions
-      pi_fixity           :: (Version, [RdrNameFixitySig]),    -- Local fixity declarations, with their version
+      pi_fixity           :: [RdrNameFixitySig],               -- Local fixity declarations,
       pi_rules    :: (Version, [RdrNameRuleDecl]),     -- Rules, with their version
       pi_deprecs   :: [RdrNameDeprecation]             -- Deprecations
     }
@@ -209,18 +219,18 @@ data ParsedIface
 \begin{code}
 data Ifaces = Ifaces {
     -- PERSISTENT FIELDS
-       iPST :: PackageSymbolTable,     
-               -- The ModuleDetails for modules in other packages
+       iPIT :: PackageIfaceTable,
+               -- The ModuleIFaces for modules in other packages
                -- whose interfaces we have opened
-               -- The contents of those interface files may be mostly
-               -- in the iDecls, iInsts, iRules (below), but what *will*
-               -- be in the PackageSymbolTable is:
+               -- The declarations in these interface files are held in
+               -- iDecls, iInsts, iRules (below), not in the mi_decls fields
+               -- of the iPIT.  What _is_ in the iPIT is:
                --      * The Module 
                --      * Version info
                --      * Its exports
                --      * Fixities
                --      * Deprecations
-               -- This field is initialised from the compiler's persistent
+               -- The iPIT field is initialised from the compiler's persistent
                -- package symbol table, and the renamer incrementally adds
                -- to it.
 
@@ -248,11 +258,14 @@ data Ifaces = Ifaces {
                -- All the names (whether "big" or "small", whether wired-in or not,
                -- whether locally defined or not) that have been slurped in so far.
 
-       iVSlurp :: [(Name,Version)]
+       iVSlurp :: [Name]
                -- All the (a) non-wired-in (b) "big" (c) non-locally-defined 
                -- names that have been slurped in so far, with their versions.
                -- This is used to generate the "usage" information for this module.
                -- Subset of the previous field.
+               -- It's worth keeping separately, because there's no very easy 
+               -- way to distinguish the "big" names from the "non-big" ones.
+               -- But this is a decision we might want to revisit.
     }
 
 type ImportedModuleInfo = FiniteMap ModuleName 
@@ -268,15 +281,21 @@ type IsLoaded = Bool
 %************************************************************************
 
 \begin{code}
-initRn :: DynFlags -> Finder -> HomeSymbolTable
+initRn :: DynFlags 
+       -> Finder 
+       -> HomeIfaceTable
+       -> HomeSymbolTable
        -> PersistentCompilerState
-       -> Module -> SrcLoc
+       -> Module 
+       -> SrcLoc
        -> RnMG t
-       -> IO (t, PersistentCompilerState, (Bag WarnMsg, Bag ErrMsg))
+       -> IO (t, (Bag WarnMsg, Bag ErrMsg), PersistentCompilerState)
 
-initRn dflags finder hst pcs mod loc do_rn
+initRn dflags finder hit hst pcs mod loc do_rn
   = do 
        let prs = pcs_PRS pcs
+       let pst = pcs_PST pcs
+
        uniqs     <- mkSplitUniqSupply 'r'
        names_var <- newIORef (uniqs, origNames (prsOrig prs), 
                                      origIParam (prsOrig prs))
@@ -287,7 +306,8 @@ initRn dflags finder hst pcs mod loc do_rn
        
                               rn_finder = finder,
                               rn_dflags = dflags,
-                              rn_hst    = hst,
+                              rn_hit    = hit,
+                              rn_done   = is_done hst pst,
                                             
                               rn_ns     = names_var, 
                               rn_errs   = errs_var, 
@@ -306,15 +326,23 @@ initRn dflags finder hst pcs mod loc do_rn
                            prsDecls = iDecls new_ifaces,
                            prsInsts = iInsts new_ifaces,
                            prsRules = iRules new_ifaces }
-       let new_pcs = pcs { pcs_PST = iPST new_ifaces, 
+       let new_pcs = pcs { pcs_PIT = iPIT new_ifaces, 
                            pcs_PRS = new_prs }
        
-       return (res, new_pcs, (warns, errs))
+       return (res, (warns, errs), new_pcs)
+
+is_done :: HomeSymbolTable -> PackageSymbolTable -> Name -> Bool
+-- Returns True iff the name is in either symbol table
+is_done hst pst n = maybeToBool (lookupTypeEnv pst n `seqMaybe` lookupTypeEnv hst n)
 
+lookupIface :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> ModIface
+lookupIface hit pit mod = lookupModuleEnvByName hit mod `orElse` 
+                         lookupModuleEnvByName pit mod `orElse`
+                         pprPanic "lookupIface" (ppr mod)
 
 initIfaces :: PersistentCompilerState -> Ifaces
-initIfaces (PCS { pcs_PST = pst, pcs_PRS = prs })
-  = Ifaces { iPST   = pst,
+initIfaces (PCS { pcs_PIT = pit, pcs_PRS = prs })
+  = Ifaces { iPIT   = pit,
             iDecls = prsDecls prs,
             iInsts = prsInsts prs,
             iRules = prsRules prs,
@@ -373,7 +401,8 @@ renameSourceCode dflags mod prs m
                               rn_loc = generatedSrcLoc, rn_ns = names_var,
                               rn_errs = errs_var, 
                               rn_mod = mod, 
-                              rn_ifaces = panic "rnameSourceCode: rn_ifaces"  -- Not required
+                              rn_done   = bogus "rn_done",     rn_hit    = bogus "rn_hit",
+                              rn_ifaces = bogus "rn_ifaces",   rn_finder = bogus "rn_finder"
                             }
            s_down = SDown { rn_mode = InterfaceMode,
                               -- So that we can refer to PrelBase.True etc
@@ -398,6 +427,8 @@ renameSourceCode dflags mod prs m
   where
     display errs = pprBagOfErrors errs
 
+bogus s = panic ("rnameSourceCode: " ++ s)  -- Used for unused record fields
+
 {-# INLINE thenRn #-}
 {-# INLINE thenRn_ #-}
 {-# INLINE returnRn #-}
@@ -530,7 +561,7 @@ getDOptsRn (RnDown { rn_dflags = dflags}) l_down
 
 
 %================
-\subsubsection{  Source location}
+\subsubsection{Source location}
 %=====================
 
 \begin{code}
@@ -551,8 +582,11 @@ getSrcLocRn down l_down
 getFinderRn :: RnM d Finder
 getFinderRn down l_down = return (rn_finder down)
 
-getHomeSymbolTableRn :: RnM d HomeSymbolTable
-getHomeSymbolTableRn down l_down = return (rn_hst down)
+getHomeIfaceTableRn :: RnM d HomeIfaceTable
+getHomeIfaceTableRn down l_down = return (rn_hit down)
+
+checkAlreadyAvailable :: Name -> RnM d Bool
+checkAlreadyAvailable name down l_down = return (rn_done down name)
 \end{code}
 
 %================