[project @ 2000-10-23 16:39:11 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / RnMonad.lhs
index d322c20..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,21 +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, dopt_D_dump_rn_trace )
-import SrcLoc          ( SrcLoc, mkGeneratedSrcLoc )
+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 CmFind          ( Finder )
 import PrelNames       ( mkUnboundName )
-import HscTypes                ( GlobalSymbolTable, OrigNameEnv, AvailEnv, 
-                         WhetherHasOrphans, ImportVersion, ExportItem,
-                         PersistentRenamerState(..), IsBootInterface, Avails,
-                         DeclsMap, IfaceInsts, IfaceRules, DeprecationEnv )
+import Maybes          ( maybeToBool, seqMaybe, orElse )
 
 infixr 9 `thenRn`, `thenRn_`
 \end{code}
@@ -83,7 +89,7 @@ ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok))
            
 traceRn :: SDoc -> RnM d ()
 traceRn msg
-   = doptsRn dopt_D_dump_rn_trace `thenRn` \b ->
+   = doptRn Opt_D_dump_rn_trace `thenRn` \b ->
      if b then putDocRn msg else returnRn ()
 
 putDocRn :: SDoc -> RnM d ()
@@ -110,17 +116,23 @@ type RnMG r  = RnM ()    r                -- Getting global names etc
        -- Common part
 data RnDown
   = RnDown {
-       rn_mod     :: Module,                   -- This module
-       rn_loc     :: SrcLoc,                   -- Current locn
+       rn_mod     :: Module,           -- This module
+       rn_loc     :: SrcLoc,           -- Current locn
 
        rn_finder  :: Finder,
        rn_dflags  :: DynFlags,
-       rn_gst     :: GlobalSymbolTable,        -- Both home modules and packages,
-                                               -- at the moment we started compiling 
-                                               -- this module
+
+       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),
-       rn_ns      :: IORef (UniqSupply, OrigNameEnv),
+
+       -- The second and third components are a flattened-out OrigNameEnv
+       rn_ns      :: IORef (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv),
        rn_ifaces  :: IORef Ifaces
     }
 
@@ -138,10 +150,10 @@ data SDown = SDown {
                        -- We still need the unsullied global name env so that
                        --   we can look up record field names
 
-                 rn_fixenv :: FixityEnv        -- Local fixities
+                 rn_fixenv :: LocalFixityEnv   -- Local fixities
                        -- The global fixities are held in the
                        -- rn_ifaces field.  Why?  See the comments
-                       -- with RnIfaces.lookupFixity
+                       -- with RnIfaces.lookupLocalFixity
                }
 
 data RnMode    = SourceMode                    -- Renaming source code
@@ -154,19 +166,14 @@ data RnMode       = SourceMode                    -- Renaming source code
 
 \begin{code}
 --------------------------------
-type GlobalRdrEnv = RdrNameEnv [Name]  -- The list is because there may be name clashes
-                                       -- These only get reported on lookup,
-                                       -- not on construction
-type LocalRdrEnv  = RdrNameEnv Name
-
---------------------------------
-type FixityEnv = NameEnv RenamedFixitySig
+type LocalRdrEnv    = RdrNameEnv Name
+type LocalFixityEnv = NameEnv RenamedFixitySig
        -- We keep the whole fixity sig so that we
        -- can report line-number info when there is a duplicate
        -- fixity declaration
 
-lookupFixity :: FixityEnv -> Name -> Fixity
-lookupFixity env name
+lookupLocalFixity :: LocalFixityEnv -> Name -> Fixity
+lookupLocalFixity env name
   = case lookupNameEnv env name of 
        Just (FixitySig _ fix _) -> fix
        Nothing                  -> defaultFixity
@@ -186,6 +193,7 @@ type ExportAvails = (FiniteMap ModuleName Avails,
 %===================================================
 
 \begin{code}
+type ExportItem = (ModuleName, [RdrAvailInfo])
 
 data ParsedIface
   = ParsedIface {
@@ -193,18 +201,13 @@ 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
     }
-
-
-type RdrNamePragma = ()                                -- Fudge for now
--------------------
-
 \end{code}
 
 %************************************************************************
@@ -215,74 +218,59 @@ type RdrNamePragma = ()                           -- Fudge for now
 
 \begin{code}
 data Ifaces = Ifaces {
-
-       -- PERSISTENT FIELDS
-               iImpModInfo :: ImportedModuleInfo,
-                               -- Modules this one depends on: that is, the union 
-                               -- 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
-                                       -- we can get away with importing them abstractly
-
-               iInsts :: IfaceInsts,
+    -- PERSISTENT FIELDS
+       iPIT :: PackageIfaceTable,
+               -- The ModuleIFaces for modules in other packages
+               -- whose interfaces we have opened
+               -- 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
+               -- The iPIT field is initialised from the compiler's persistent
+               -- package symbol table, and the renamer incrementally adds
+               -- to it.
+
+       iDecls :: DeclsMap,     
+               -- A single, global map of Names to unslurped decls
+
+       iInsts :: IfaceInsts,
                -- The as-yet un-slurped instance decls; this bag is depleted when we
                -- slurp an instance decl so that we don't slurp the same one twice.
                -- Each is 'gated' by the names that must be available before
                -- this instance decl is needed.
 
-               iRules :: IfaceRules,
+       iRules :: IfaceRules,
                -- Similar to instance decls, only for rules
 
-       -- SEMI-EPHEMERAL FIELDS
-               -- iFixes and iDeprecs are accumulated here while one module
-               -- is compiled, but are transferred to the package symbol table
-               -- at the end.  We don't add them to the table as we encounter them
-               -- because doing so would require us to have a mutable symbol table
-               -- which is yukky.
-
-               iFixes :: FixityEnv,            -- A single, global map of Names to fixities
-                                               -- See comments with RnIfaces.lookupFixity
-               iDeprecs :: DeprecationEnv,
-
-       -- EPHEMERAL FIELDS
-       -- These fields persist during the compilation of a single module only
+    -- EPHEMERAL FIELDS
+    -- These fields persist during the compilation of a single module only
+       iImpModInfo :: ImportedModuleInfo,
+                       -- Modules this one depends on: that is, the union 
+                       -- 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.
 
-               iSlurp :: NameSet,
+       iSlurp :: NameSet,
                -- 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.
-       }
-
-type ImportedModuleInfo 
-     = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface, 
-                            Maybe (Module, Version, Version, Version, WhereFrom, Avails))
-                               -- The three Versions are module version, fixity version, rules version
-
-               -- Suppose the domain element is module 'A'
-               --
-               -- The first Bool is True if A contains 
-               -- 'orphan' rules or instance decls
-
-               -- The second Bool is true if the interface file actually
-               -- read was an .hi-boot file
-
-               -- Nothing => A's interface not yet read, but this module has
-               --            imported a module, B, that itself depends on A
-               --
-               -- Just xx => A's interface has been read.  The Module in 
-               --              the Just has the correct Dll flag
-
-               -- This set is used to decide whether to look for
-               -- A.hi or A.hi-boot when importing A.f.
-               -- Basically, we look for A.hi if A is in the map, and A.hi-boot
-               -- otherwise
+               -- 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 
+                                   (WhetherHasOrphans, IsBootInterface, IsLoaded)
+type IsLoaded = Bool
 \end{code}
 
 
@@ -293,49 +281,73 @@ type ImportedModuleInfo
 %************************************************************************
 
 \begin{code}
-initRn :: DynFlags -> Finder -> GlobalSymbolTable
-       -> PersistentRenamerState
-       -> Module -> SrcLoc
+initRn :: DynFlags 
+       -> Finder 
+       -> HomeIfaceTable
+       -> HomeSymbolTable
+       -> PersistentCompilerState
+       -> Module 
+       -> SrcLoc
        -> RnMG t
-       -> IO (t, (Bag WarnMsg, Bag ErrMsg))
-
-initRn dflags finder gst prs mod loc do_rn
-  = do uniqs     <- mkSplitUniqSupply 'r'
-       names_var <- newIORef (uniqs, prsOrig prs)
-       errs_var  <- newIORef (emptyBag,emptyBag)
-       iface_var <- newIORef (initIfaces prs)
-       let rn_down = RnDown { rn_mod = mod,
-                             rn_loc = loc, 
-    
-                             rn_finder = finder,
-                             rn_dflags = dflags,
-                             rn_gst    = gst,
-                                    
-                             rn_ns     = names_var, 
-                             rn_errs   = errs_var, 
-                             rn_ifaces = iface_var,
-                    }
-
-       -- do the business
-       res <- do_rn rn_down ()
-
-       -- grab errors and return
-       (warns, errs) <- readIORef errs_var
-
-       return (res, (warns, errs))
-
-
-initIfaces :: PersistentRenamerState -> Ifaces
-initIfaces prs
-  = Ifaces { iDecls = prsDecls prs,
+       -> IO (t, (Bag WarnMsg, Bag ErrMsg), PersistentCompilerState)
+
+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))
+       errs_var  <- newIORef (emptyBag,emptyBag)
+       iface_var <- newIORef (initIfaces pcs)
+       let rn_down = RnDown { rn_mod = mod,
+                              rn_loc = loc, 
+       
+                              rn_finder = finder,
+                              rn_dflags = dflags,
+                              rn_hit    = hit,
+                              rn_done   = is_done hst pst,
+                                            
+                              rn_ns     = names_var, 
+                              rn_errs   = errs_var, 
+                              rn_ifaces = iface_var,
+                            }
+       
+       -- do the business
+       res <- do_rn rn_down ()
+       
+       -- Grab state and record it
+       (warns, errs)              <- readIORef errs_var
+       new_ifaces                 <- readIORef iface_var
+       (_, new_origN, new_origIP) <- readIORef names_var
+       let new_orig = Orig { origNames = new_origN, origIParam = new_origIP }
+       let new_prs = prs { prsOrig = new_orig,
+                           prsDecls = iDecls new_ifaces,
+                           prsInsts = iInsts new_ifaces,
+                           prsRules = iRules new_ifaces }
+       let new_pcs = pcs { pcs_PIT = iPIT new_ifaces, 
+                           pcs_PRS = new_prs }
+       
+       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_PIT = pit, pcs_PRS = prs })
+  = Ifaces { iPIT   = pit,
+            iDecls = prsDecls prs,
             iInsts = prsInsts prs,
             iRules = prsRules prs,
 
-            iFixes   = emptyNameEnv,
-            iDeprecs = emptyNameEnv,
-
             iImpModInfo = emptyFM,
-            --iDeferred   = emptyNameSet,
             iSlurp      = unitNameSet (mkUnboundName dummyRdrVarName),
                        -- Pretend that the dummy unbound name has already been
                        -- slurped.  This is what's returned for an out-of-scope name,
@@ -344,7 +356,7 @@ initIfaces prs
       }
 
 
-initRnMS :: GlobalRdrEnv -> FixityEnv -> RnMode -> RnMS r -> RnM d r
+initRnMS :: GlobalRdrEnv -> LocalFixityEnv -> RnMode -> RnMS r -> RnM d r
 initRnMS rn_env fixity_env mode thing_inside rn_down g_down
   = let
        s_down = SDown { rn_genv = rn_env, rn_lenv = emptyRdrEnv, 
@@ -380,15 +392,17 @@ renameSourceCode dflags mod prs m
        -- only do any I/O if we need to read in a fixity declaration;
        -- and that doesn't happen in pragmas etc
 
-        mkSplitUniqSupply 'r'                  >>= \ new_us ->
-       newIORef (new_us, prsOrig prs)          >>= \ names_var ->
-       newIORef (emptyBag,emptyBag)            >>= \ errs_var ->
+        mkSplitUniqSupply 'r'                          >>= \ new_us ->
+       newIORef (new_us, origNames (prsOrig prs), 
+                         origIParam (prsOrig prs))     >>= \ names_var ->
+       newIORef (emptyBag,emptyBag)                    >>= \ errs_var ->
        let
            rn_down = RnDown { rn_dflags = dflags,
-                              rn_loc = mkGeneratedSrcLoc, rn_ns = names_var,
+                              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
@@ -413,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 #-}
@@ -534,14 +550,18 @@ checkErrsRn (RnDown {rn_errs = errs_var}) l_down
   = readIORef  errs_var                                        >>=  \ (warns,errs) ->
     return (isEmptyBag errs)
 
-doptsRn :: (DynFlags -> Bool) -> RnM d Bool
-doptsRn dopt (RnDown { rn_dflags = dflags}) l_down
-   = return (dopt dflags)
+doptRn :: DynFlag -> RnM d Bool
+doptRn dflag (RnDown { rn_dflags = dflags}) l_down
+   = return (dopt dflag dflags)
+
+getDOptsRn :: RnM d DynFlags
+getDOptsRn (RnDown { rn_dflags = dflags}) l_down
+   = return dflags
 \end{code}
 
 
 %================
-\subsubsection{  Source location}
+\subsubsection{Source location}
 %=====================
 
 \begin{code}
@@ -555,25 +575,40 @@ getSrcLocRn down l_down
 \end{code}
 
 %================
-\subsubsection{  Name supply}
+\subsubsection{The finder and home symbol table}
 %=====================
 
 \begin{code}
-getNameSupplyRn :: RnM d (UniqSupply, OrigNameEnv)
+getFinderRn :: RnM d Finder
+getFinderRn down l_down = return (rn_finder 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}
+
+%================
+\subsubsection{Name supply}
+%=====================
+
+\begin{code}
+getNameSupplyRn :: RnM d (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv)
 getNameSupplyRn rn_down l_down
   = readIORef (rn_ns rn_down)
 
-setNameSupplyRn :: (UniqSupply, OrigNameEnv) -> RnM d ()
+setNameSupplyRn :: (UniqSupply, OrigNameNameEnv, OrigNameIParamEnv) -> RnM d ()
 setNameSupplyRn names' (RnDown {rn_ns = names_var}) l_down
   = writeIORef names_var names'
 
 getUniqRn :: RnM d Unique
 getUniqRn (RnDown {rn_ns = names_var}) l_down
- = readIORef names_var >>= \ (us, {-cache,-} ipcache) ->
+ = readIORef names_var >>= \ (us, cache, ipcache) ->
    let
      (us1,us') = splitUniqSupply us
    in
-   writeIORef names_var (us', {-cache,-} ipcache)  >>
+   writeIORef names_var (us', cache, ipcache)  >>
    return (uniqFromSupply us1)
 \end{code}
 
@@ -603,10 +638,6 @@ setModuleRn new_mod enclosed_thing rn_down l_down
 %=====================
 
 \begin{code}
-getNameEnvs :: RnMS (GlobalRdrEnv, LocalRdrEnv)
-getNameEnvs rn_down (SDown {rn_genv = global_env, rn_lenv = local_env})
-  = return (global_env, local_env)
-
 getLocalNameEnv :: RnMS LocalRdrEnv
 getLocalNameEnv rn_down (SDown {rn_lenv = local_env})
   = return local_env
@@ -619,7 +650,7 @@ setLocalNameEnv :: LocalRdrEnv -> RnMS a -> RnMS a
 setLocalNameEnv local_env' m rn_down l_down
   = m rn_down (l_down {rn_lenv = local_env'})
 
-getFixityEnv :: RnMS FixityEnv
+getFixityEnv :: RnMS LocalFixityEnv
 getFixityEnv rn_down (SDown {rn_fixenv = fixity_env})
   = return fixity_env