[project @ 2001-10-18 16:29:12 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index eea91a4..c29421c 100644 (file)
@@ -5,28 +5,34 @@
 
 \begin{code}
 module HscTypes ( 
+       GhciMode(..),
+
        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, typeEnvIds,
+       TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
+       extendTypeEnvList, extendTypeEnvWithIds,
+       typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
        ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
-       PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
-       IfaceInsts, IfaceRules, GatedDecl, IsExported,
+       PersistentRenamerState(..), IsBootInterface, DeclsMap,
+       IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, IsExported,
        NameSupply(..), OrigNameCache, OrigIParamCache,
-       AvailEnv, AvailInfo, GenAvailInfo(..),
+       Avails, AvailEnv, GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
        PersistentCompilerState(..),
 
        Deprecations(..), lookupDeprec,
@@ -34,7 +40,9 @@ module HscTypes (
        InstEnv, ClsInstEnv, DFunId,
        PackageInstEnv, PackageRuleBase,
 
-       GlobalRdrEnv, GlobalRdrElt(..), RdrAvailInfo, pprGlobalRdrEnv,
+       GlobalRdrEnv, GlobalRdrElt(..), pprGlobalRdrEnv,
+       LocalRdrEnv, extendLocalRdrEnv,
+       
 
        -- Provenance
        Provenance(..), ImportReason(..), 
@@ -44,18 +52,19 @@ 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 )
+import TyCon           ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
 import DataCon         ( dataConId, dataConWrapId )
 
 import BasicTypes      ( Version, initialVersion, Fixity )
@@ -68,7 +77,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 )
@@ -77,6 +86,18 @@ import UniqSupply    ( UniqSupply )
 
 %************************************************************************
 %*                                                                     *
+\subsection{Which mode we're in
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+data GhciMode = Batch | Interactive | OneShot 
+     deriving Eq
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Module locations}
 %*                                                                     *
 %************************************************************************
@@ -86,7 +107,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
@@ -161,18 +182,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 implicit 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,
@@ -199,6 +247,9 @@ type PackageIfaceTable  = IfaceTable
 
 type HomeSymbolTable    = SymbolTable  -- Domain = modules in the home package
 
+emptySymbolTable :: SymbolTable
+emptySymbolTable = emptyModuleEnv
+
 emptyIfaceTable :: IfaceTable
 emptyIfaceTable = emptyModuleEnv
 \end{code}
@@ -222,6 +273,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}
 %*                                                                     *
 %************************************************************************
@@ -246,9 +317,16 @@ instance Outputable TyThing where
   ppr (ATyCon tc) = ptext SLIT("ATyCon") <+> ppr tc
   ppr (AClass cl) = ptext SLIT("AClass") <+> ppr cl
 
-typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
-typeEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts env] 
-typeEnvIds     env = [id | AnId id   <- nameEnvElts env] 
+
+typeEnvElts    :: TypeEnv -> [TyThing]
+typeEnvClasses :: TypeEnv -> [Class]
+typeEnvTyCons  :: TypeEnv -> [TyCon]
+typeEnvIds     :: TypeEnv -> [Id]
+
+typeEnvElts    env = nameEnvElts env
+typeEnvClasses env = [cl | AClass cl <- typeEnvElts env]
+typeEnvTyCons  env = [tc | ATyCon tc <- typeEnvElts env] 
+typeEnvIds     env = [id | AnId id   <- typeEnvElts env] 
 
 implicitTyThingIds :: [TyThing] -> [Id]
 -- Add the implicit data cons and selectors etc 
@@ -260,8 +338,13 @@ implicitTyThingIds things
     go (ATyCon tc) = tyConGenIds tc ++
                     tyConSelIds tc ++
                     [ n | dc <- tyConDataConsIfAvailable tc, 
-                          n  <- [dataConId dc, dataConWrapId dc] ] 
+                          n  <- implicitConIds tc dc]
                -- Synonyms return empty list of constructors and selectors
+
+    implicitConIds tc dc       -- Newtypes have a constructor wrapper,
+                               -- but no worker
+       | isNewTyCon tc = [dataConWrapId dc]
+       | otherwise     = [dataConId dc, dataConWrapId dc]
 \end{code}
 
 
@@ -275,10 +358,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}
@@ -309,13 +393,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
@@ -521,7 +611,13 @@ type IfaceInsts = GatedDecls RdrNameInstDecl
 type IfaceRules = GatedDecls RdrNameRuleDecl
 
 type GatedDecls d = (Bag (GatedDecl d), Int)   -- The Int says how many have been sucked in
-type GatedDecl  d = ([Name], (Module, d))
+type GatedDecl  d = (GateFn, (Module, d))
+type GateFn       = (Name -> Bool) -> Bool     -- Returns True <=> gate is open
+                                               -- The (Name -> Bool) fn returns True for visible Names
+       -- For example, suppose this is in an interface file
+       --      instance C T where ...
+       -- We want to slurp this decl if both C and T are "visible" in 
+       -- the importing module.  See "The gating story" in RnIfaces for details.
 \end{code}
 
 
@@ -531,6 +627,16 @@ 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.
 
@@ -609,11 +715,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}