[project @ 2001-05-31 11:32:25 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index 49f12f2..a490730 100644 (file)
@@ -8,25 +8,29 @@ module HscTypes (
        ModuleLocation(..),
 
        ModDetails(..), ModIface(..), 
-       HomeSymbolTable, PackageTypeEnv,
+       HomeSymbolTable, emptySymbolTable,
+       PackageTypeEnv,
        HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
        lookupIface, lookupIfaceByModName,
        emptyModIface,
 
+       InteractiveContext(..),
+
        IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
 
-       VersionInfo(..), initialVersionInfo,
+       VersionInfo(..), initialVersionInfo, lookupVersion,
 
        TyThing(..), isTyClThing, implicitTyThingIds,
 
-       TypeEnv, lookupType, mkTypeEnv, extendTypeEnvList, 
-       typeEnvClasses, typeEnvTyCons,
+       TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
+       extendTypeEnvList, extendTypeEnvWithIds,
+       typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
-       WhetherHasOrphans, ImportVersion, WhatsImported(..),
-       PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
-       IfaceInsts, IfaceRules, GatedDecl, IsExported,
-       OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
-       AvailEnv, AvailInfo, GenAvailInfo(..),
+       ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
+       PersistentRenamerState(..), IsBootInterface, DeclsMap,
+       IfaceInsts, IfaceRules, GatedDecl, GatedDecls, IsExported,
+       NameSupply(..), OrigNameCache, OrigIParamCache,
+       Avails, AvailEnv, GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
        PersistentCompilerState(..),
 
        Deprecations(..), lookupDeprec,
@@ -34,7 +38,9 @@ module HscTypes (
        InstEnv, ClsInstEnv, DFunId,
        PackageInstEnv, PackageRuleBase,
 
-       GlobalRdrEnv, RdrAvailInfo, pprGlobalRdrEnv,
+       GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
+       LocalRdrEnv, extendLocalRdrEnv,
+       
 
        -- Provenance
        Provenance(..), ImportReason(..), 
@@ -44,15 +50,16 @@ module HscTypes (
 
 #include "HsVersions.h"
 
-import RdrName         ( RdrNameEnv, emptyRdrEnv, rdrEnvToList )
-import Name            ( Name, NamedThing, getName, nameModule, nameSrcLoc )
-import Name -- Env
+import RdrName         ( RdrNameEnv, addListToRdrEnv, emptyRdrEnv, mkRdrUnqual, rdrEnvToList )
+import Name            ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
+import NameEnv
 import OccName         ( OccName )
 import Module          ( Module, ModuleName, ModuleEnv,
                          lookupModuleEnv, lookupModuleEnvByName, emptyModuleEnv
                        )
 import InstEnv         ( InstEnv, ClsInstEnv, DFunId )
 import Rules           ( RuleBase )
+import CoreSyn         ( CoreBind )
 import Id              ( Id )
 import Class           ( Class, classSelIds )
 import TyCon           ( TyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
@@ -68,7 +75,7 @@ import CoreSyn                ( IdCoreRule )
 
 import FiniteMap       ( FiniteMap )
 import Bag             ( Bag )
-import Maybes          ( seqMaybe )
+import Maybes          ( seqMaybe, orElse )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
 import Util            ( thenCmp, sortLt )
@@ -86,7 +93,7 @@ data ModuleLocation
    = ModuleLocation {
         ml_hs_file   :: Maybe FilePath,
         ml_hspp_file :: Maybe FilePath,  -- path of preprocessed source
-        ml_hi_file   :: Maybe FilePath,
+        ml_hi_file   :: FilePath,
         ml_obj_file  :: Maybe FilePath
      }
      deriving Show
@@ -150,24 +157,8 @@ mkIfaceDecls tycls rules insts
                 dcl_rules = sortLt lt_rule rules,
                 dcl_insts = insts }
   where
-    d1 `lt_tycl` d2 = nameOccName (tyClDeclName      d1) < nameOccName (tyClDeclName      d2)
-    r1 `lt_rule` r2 = nameOccName (ifaceRuleDeclName r1) < nameOccName (ifaceRuleDeclName r2)
-
-       -- I wanted to sort just by the Name, but there's a problem: we are comparing
-       -- the old version of an interface with the new version.  The latter will use
-       -- local names like 'lvl23' that were constructed not by the renamer but by
-       -- the simplifier.  So the unqiues aren't going to line up.
-       --
-       -- It's ok to compare by OccName because this comparison only drives the
-       -- computation of new version numbers.
-       --
-       -- Better solutions:    Compare in a way that is insensitive to the name used
-       --                      for local things.  This would decrease the wobbles due
-       --                      to 'lvl23' changing to 'lvl24'.
-       --
-       -- NB: there's a related comparision on MkIface.diffDecls!  
-
-
+    d1 `lt_tycl` d2 = tyClDeclName      d1 < tyClDeclName      d2
+    r1 `lt_rule` r2 = ifaceRuleDeclName r1 < ifaceRuleDeclName r2
 
 
 -- typechecker should only look at this, not ModIface
@@ -177,18 +168,45 @@ data ModDetails
        -- The next three fields are created by the typechecker
         md_types    :: TypeEnv,
         md_insts    :: [DFunId],       -- Dfun-ids for the instances in this module
-        md_rules    :: [IdCoreRule]    -- Domain may include Ids from other modules
+        md_rules    :: [IdCoreRule],   -- Domain may include Ids from other modules
+       md_binds    :: [CoreBind]
      }
+
+-- The ModDetails takes on several slightly different forms:
+--
+-- After typecheck + desugar
+--     md_types        Contains TyCons, Classes, and hasNoBinding Ids
+--     md_insts        All instances from this module (incl derived ones)
+--     md_rules        All rules from this module
+--     md_binds        Desugared bindings
+--
+-- After simplification
+--     md_types        Same as after typecheck
+--     md_insts        Ditto
+--     md_rules        Orphan rules only (local ones now attached to binds)
+--     md_binds        With rules attached
+--
+-- After CoreTidy
+--     md_types        Now contains Ids as well, replete with final IdInfo
+--                        The Ids are only the ones that are visible from
+--                        importing modules.  Without -O that means only
+--                        exported Ids, but with -O importing modules may
+--                        see ids mentioned in unfoldings of exported Ids
+--
+--     md_insts        Same DFunIds as before, but with final IdInfo,
+--                        and the unique might have changed; remember that
+--                        CoreTidy links up the uniques of old and new versions
+--
+--     md_rules        All rules for exported things, substituted with final Ids
+--
+--     md_binds        Tidied
+--
+-- Passed back to compilation manager
+--     Just as after CoreTidy, but with md_binds nuked
+
 \end{code}
 
 \begin{code}
-emptyModDetails :: ModDetails
-emptyModDetails
-  = ModDetails { md_types = emptyTypeEnv,
-                 md_insts = [],
-                 md_rules = []
-    }
-
 emptyModIface :: Module -> ModIface
 emptyModIface mod
   = ModIface { mi_module   = mod,
@@ -215,6 +233,9 @@ type PackageIfaceTable  = IfaceTable
 
 type HomeSymbolTable    = SymbolTable  -- Domain = modules in the home package
 
+emptySymbolTable :: SymbolTable
+emptySymbolTable = emptyModuleEnv
+
 emptyIfaceTable :: IfaceTable
 emptyIfaceTable = emptyModuleEnv
 \end{code}
@@ -238,6 +259,26 @@ lookupIfaceByModName hit pit mod
 
 %************************************************************************
 %*                                                                     *
+\subsection{The interactive context}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+data InteractiveContext 
+  = InteractiveContext { 
+       ic_module :: Module,            -- The current module in which 
+                                       -- the  user is sitting
+
+       ic_rn_env :: LocalRdrEnv,       -- Lexical context for variables bound
+                                       -- during interaction
+
+       ic_type_env :: TypeEnv          -- Ditto for types
+    }
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Type environment stuff}
 %*                                                                     *
 %************************************************************************
@@ -264,6 +305,7 @@ instance Outputable TyThing where
 
 typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
 typeEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts env] 
+typeEnvIds     env = [id | AnId id   <- nameEnvElts env] 
 
 implicitTyThingIds :: [TyThing] -> [Id]
 -- Add the implicit data cons and selectors etc 
@@ -290,10 +332,11 @@ mkTypeEnv things = extendTypeEnvList emptyTypeEnv things
                
 extendTypeEnvList :: TypeEnv -> [TyThing] -> TypeEnv
 extendTypeEnvList env things
-  = foldl add_thing env things
-  where
-    add_thing :: TypeEnv -> TyThing -> TypeEnv
-    add_thing env thing = extendNameEnv env (getName thing) thing
+  = extendNameEnvList env [(getName thing, thing) | thing <- things]
+
+extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv
+extendTypeEnvWithIds env ids
+  = extendNameEnvList env [(getName id, AnId id) | id <- ids]
 \end{code}
 
 \begin{code}
@@ -324,13 +367,19 @@ data VersionInfo
                -- The version of an Id changes if its fixity changes
                -- Ditto data constructors, class operations, except that the version of
                -- the parent class/tycon changes
+               --
+               -- If a name isn't in the map, it means 'initialVersion'
     }
 
 initialVersionInfo :: VersionInfo
 initialVersionInfo = VersionInfo { vers_module  = initialVersion,
                                   vers_exports = initialVersion,
                                   vers_rules   = initialVersion,
-                                  vers_decls   = emptyNameEnv }
+                                  vers_decls   = emptyNameEnv
+                       }
+
+lookupVersion :: NameEnv Version -> Name -> Version
+lookupVersion env name = lookupNameEnv env name `orElse` initialVersion
 
 data Deprecations = NoDeprecs
                  | DeprecAll DeprecTxt                         -- Whole module deprecated
@@ -344,6 +393,13 @@ lookupDeprec (DeprecAll  txt) name = Just txt
 lookupDeprec (DeprecSome env) name = case lookupNameEnv env name of
                                            Just (_, txt) -> Just txt
                                            Nothing       -> Nothing
+
+instance Eq Deprecations where
+  -- Used when checking whether we need write a new interface
+  NoDeprecs       == NoDeprecs      = True
+  (DeprecAll t1)  == (DeprecAll t2)  = t1 == t2
+  (DeprecSome e1) == (DeprecSome e2) = nameEnvElts e1 == nameEnvElts e2
+  d1             == d2              = False
 \end{code}
 
 
@@ -443,7 +499,6 @@ data PersistentCompilerState
 
         pcs_PRS :: PersistentRenamerState
      }
-
 \end{code}
 
 The @PersistentRenamerState@ persists across successive calls to the
@@ -473,15 +528,15 @@ type PackageRuleBase = RuleBase
 type PackageInstEnv  = InstEnv
 
 data PersistentRenamerState
-  = PRS { prsOrig  :: OrigNameEnv,
-         prsDecls :: DeclsMap,
-         prsInsts :: IfaceInsts,
-         prsRules :: IfaceRules,
-         prsNS    :: UniqSupply
+  = PRS { prsOrig    :: NameSupply,
+         prsImpMods :: ImportedModuleInfo,
+         prsDecls   :: DeclsMap,
+         prsInsts   :: IfaceInsts,
+         prsRules   :: IfaceRules
     }
 \end{code}
 
-The OrigNameEnv makes sure that there is just one Unique assigned for
+The NameSupply makes sure that there is just one Unique assigned for
 each original name; i.e. (module-name, occ-name) pair.  The Name is
 always stored as a Global, and has the SrcLoc of its binding location.
 Actually that's not quite right.  When we first encounter the original
@@ -494,17 +549,29 @@ encounter the occurrence, we may not know the details of the module, so
 we just store junk.  Then when we find the binding site, we fix it up.
 
 \begin{code}
-data OrigNameEnv
- = Orig { origNames  :: OrigNameNameEnv,
+data NameSupply
+ = NameSupply { nsUniqs :: UniqSupply,
+               -- Supply of uniques
+               nsNames :: OrigNameCache,
                -- Ensures that one original name gets one unique
-         origIParam :: OrigNameIParamEnv
+               nsIPs   :: OrigIParamCache
                -- Ensures that one implicit parameter name gets one unique
    }
 
-type OrigNameNameEnv   = FiniteMap (ModuleName,OccName) Name
-type OrigNameIParamEnv = FiniteMap OccName Name
+type OrigNameCache   = FiniteMap (ModuleName,OccName) Name
+type OrigIParamCache = FiniteMap OccName Name
 \end{code}
 
+@ImportedModuleInfo@ contains info ONLY about modules that have not yet 
+been loaded into the iPIT.  These modules are mentioned in interfaces we've
+already read, so we know a tiny bit about them, but we havn't yet looked
+at the interface file for the module itself.  It needs to persist across 
+invocations of the renamer, at least from Rename.checkOldIface to Rename.renameSource.
+And there's no harm in it persisting across multiple compilations.
+
+\begin{code}
+type ImportedModuleInfo = FiniteMap ModuleName (WhetherHasOrphans, IsBootInterface)
+\end{code}
 
 A DeclsMap contains a binding for each Name in the declaration
 including the constructors of a type decl etc.  The Bool is True just
@@ -528,19 +595,32 @@ type GatedDecl  d = ([Name], (Module, d))
 %*                                                                     *
 %************************************************************************
 
+A LocalRdrEnv is used for local bindings (let, where, lambda, case)
+
+\begin{code}
+type LocalRdrEnv = RdrNameEnv Name
+
+extendLocalRdrEnv :: LocalRdrEnv -> [Name] -> LocalRdrEnv
+extendLocalRdrEnv env names
+  = addListToRdrEnv env [(mkRdrUnqual (nameOccName n), n) | n <- names]
+\end{code}
+
 The GlobalRdrEnv gives maps RdrNames to Names.  There is a separate
 one for each module, corresponding to that module's top-level scope.
 
 \begin{code}
-type GlobalRdrEnv = RdrNameEnv [(Name,Provenance)]     -- The list is because there may be name clashes
-                                                       -- These only get reported on lookup,
-                                                       -- not on construction
+type GlobalRdrEnv = RdrNameEnv [GlobalRdrElt]
+       -- The list is because there may be name clashes
+       -- These only get reported on lookup, not on construction
+
+data GlobalRdrElt = GRE Name Provenance (Maybe DeprecTxt)
+       -- The Maybe DeprecTxt tells whether this name is deprecated
 
 pprGlobalRdrEnv env
   = vcat (map pp (rdrEnvToList env))
   where
     pp (rn, nps) = ppr rn <> colon <+> 
-                  vcat [ppr n <+> pprNameProvenance n p | (n,p) <- nps]
+                  vcat [ppr n <+> pprNameProvenance n p | (GRE n p _) <- nps]
 \end{code}
 
 The "provenance" of something says how it came to be in scope.
@@ -603,11 +683,11 @@ hasBetterProv _                                     _                            = False
 pprNameProvenance :: Name -> Provenance -> SDoc
 pprNameProvenance name LocalDef         = ptext SLIT("defined at") <+> ppr (nameSrcLoc name)
 pprNameProvenance name (NonLocalDef why) = sep [ppr_reason why, 
-                                               nest 2 (parens (ppr_defn (nameSrcLoc name)))]
+                                               nest 2 (ppr_defn (nameSrcLoc name))]
 
 ppr_reason ImplicitImport        = ptext SLIT("implicitly imported")
 ppr_reason (UserImport mod loc _) = ptext SLIT("imported from") <+> ppr mod <+> ptext SLIT("at") <+> ppr loc
 
-ppr_defn loc | isGoodSrcLoc loc = ptext SLIT("at") <+> ppr loc
+ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("at") <+> ppr loc)
             | otherwise        = empty
 \end{code}