[project @ 2002-05-01 09:30:04 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index 95904c9..046f44a 100644 (file)
@@ -5,13 +5,15 @@
 
 \begin{code}
 module HscTypes ( 
-       ModuleLocation(..),
+       GhciMode(..),
+
+       ModuleLocation(..), showModMsg,
 
        ModDetails(..), ModIface(..), 
        HomeSymbolTable, emptySymbolTable,
        PackageTypeEnv,
        HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
-       lookupIface, lookupIfaceByModName,
+       lookupIface, lookupIfaceByModName, moduleNameToModule,
        emptyModIface,
 
        InteractiveContext(..),
@@ -19,18 +21,21 @@ module HscTypes (
        IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
 
        VersionInfo(..), initialVersionInfo, lookupVersion,
+       FixityEnv, lookupFixity, collectFixities,
 
        TyThing(..), isTyClThing, implicitTyThingIds,
 
        TypeEnv, lookupType, mkTypeEnv, emptyTypeEnv,
        extendTypeEnvList, extendTypeEnvWithIds,
-       typeEnvClasses, typeEnvTyCons, typeEnvIds,
+       typeEnvElts, typeEnvClasses, typeEnvTyCons, typeEnvIds,
 
        ImportedModuleInfo, WhetherHasOrphans, ImportVersion, WhatsImported(..),
        PersistentRenamerState(..), IsBootInterface, DeclsMap,
-       IfaceInsts, IfaceRules, GatedDecl, IsExported,
+       IfaceInsts, IfaceRules, GatedDecl, GatedDecls, GateFn, IsExported,
        NameSupply(..), OrigNameCache, OrigIParamCache,
-       Avails, AvailEnv, GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
+       Avails, AvailEnv, emptyAvailEnv,
+       GenAvailInfo(..), AvailInfo, RdrAvailInfo, 
+       ExportItem, RdrExportItem,
        PersistentCompilerState(..),
 
        Deprecations(..), lookupDeprec,
@@ -50,40 +55,53 @@ module HscTypes (
 
 #include "HsVersions.h"
 
-import RdrName         ( RdrNameEnv, addListToRdrEnv, emptyRdrEnv, mkRdrUnqual, rdrEnvToList )
+import RdrName         ( RdrName, RdrNameEnv, addListToRdrEnv, 
+                         mkRdrUnqual, rdrEnvToList )
 import Name            ( Name, NamedThing, getName, nameOccName, nameModule, nameSrcLoc )
 import NameEnv
 import OccName         ( OccName )
-import Module          ( Module, ModuleName, ModuleEnv,
-                         lookupModuleEnv, lookupModuleEnvByName, emptyModuleEnv
-                       )
+import Module
 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 DataCon         ( dataConId, dataConWrapId )
+import TyCon           ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
+import DataCon         ( dataConWorkId, dataConWrapId )
 
-import BasicTypes      ( Version, initialVersion, Fixity )
+import BasicTypes      ( Version, initialVersion, Fixity, defaultFixity, IPName )
 
-import HsSyn           ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
+import HsSyn           ( DeprecTxt, TyClDecl, tyClDeclName, ifaceRuleDeclName,
+                         tyClDeclNames )
 import RdrHsSyn                ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
 import RnHsSyn         ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
 
 import CoreSyn         ( IdCoreRule )
 
-import FiniteMap       ( FiniteMap )
+import FiniteMap
 import Bag             ( Bag )
-import Maybes          ( seqMaybe, orElse )
+import Maybes          ( seqMaybe, orElse, expectJust )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
 import Util            ( thenCmp, sortLt )
 import UniqSupply      ( UniqSupply )
+import Maybe           ( fromJust )
 \end{code}
 
 %************************************************************************
 %*                                                                     *
+\subsection{Which mode we're in
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+data GhciMode = Batch | Interactive | OneShot 
+     deriving Eq
+\end{code}
+
+
+%************************************************************************
+%*                                                                     *
 \subsection{Module locations}
 %*                                                                     *
 %************************************************************************
@@ -93,13 +111,25 @@ 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
 
 instance Outputable ModuleLocation where
    ppr = text . show
+
+-- Probably doesn't really belong here, but used in HscMain and InteractiveUI.
+
+showModMsg :: Bool -> Module -> ModuleLocation -> String
+showModMsg use_object mod location =
+    mod_str ++ replicate (max 0 (16 - length mod_str)) ' '
+    ++" ( " ++ expectJust "showModMsg" (ml_hs_file location) ++ ", "
+    ++ (if use_object
+         then expectJust "showModMsg" (ml_obj_file location)
+         else "interpreted")
+    ++ " )"
+ where mod_str = moduleUserString mod
 \end{code}
 
 For a module in another package, the hs_file and obj_file
@@ -119,32 +149,43 @@ where the object file will reside if/when it is created.
 
 A @ModIface@ plus a @ModDetails@ summarises everything we know 
 about a compiled module.  The @ModIface@ is the stuff *before* linking,
-and can be written out to an interface file.  The @ModDetails@ is after
-linking; it is the "linked" form of the mi_decls field.
+and can be written out to an interface file.  (The @ModDetails@ is after 
+linking; it is the "linked" form of the mi_decls field.)
+
+When we *read* an interface file, we also construct a @ModIface@ from it,
+except that the mi_decls part is empty; when reading we consolidate
+the declarations into a single indexed map in the @PersistentRenamerState@.
 
 \begin{code}
 data ModIface 
    = ModIface {
-        mi_module   :: Module,                 -- Complete with package info
-        mi_version  :: VersionInfo,            -- Module version number
-        mi_orphan   :: WhetherHasOrphans,       -- Whether this module has orphans
-       mi_boot     :: IsBootInterface,         -- Whether this interface was read from an hi-boot file
+        mi_module   :: !Module,
+       mi_package  :: !PackageName,        -- Which package the module comes from
+        mi_version  :: !VersionInfo,       -- Module version number
 
-        mi_usages   :: [ImportVersion Name],   -- Usages; kept sorted so that it's easy
-                                               -- to decide whether to write a new iface file
-                                               -- (changing usages doesn't affect the version of
-                                               --  this module)
+        mi_orphan   :: WhetherHasOrphans,   -- Whether this module has orphans
+               -- NOT STRICT!  we fill this field with _|_ sometimes
 
-        mi_exports  :: [(ModuleName,Avails)],  -- What it exports
-                                               -- Kept sorted by (mod,occ),
-                                               -- to make version comparisons easier
+       mi_boot     :: !IsBootInterface,    -- read from an hi-boot file?
 
-        mi_globals  :: GlobalRdrEnv,           -- Its top level environment
+        mi_usages   :: ![ImportVersion Name],  
+               -- Usages; kept sorted so that it's easy to decide
+               -- whether to write a new iface file (changing usages
+               -- doesn't affect the version of this module)
 
-        mi_fixities :: NameEnv Fixity,         -- Fixities
-       mi_deprecs  :: Deprecations,            -- Deprecations
+        mi_exports  :: ![ExportItem],
+               -- What it exports Kept sorted by (mod,occ), to make
+               -- version comparisons easier
 
-       mi_decls    :: IfaceDecls               -- The RnDecls form of ModDetails
+        mi_globals  :: !(Maybe GlobalRdrEnv),
+               -- Its top level environment or Nothing if we read this
+               -- interface from a file.
+
+        mi_fixities :: !FixityEnv,         -- Fixities
+       mi_deprecs  :: !Deprecations,       -- Deprecations
+
+       mi_decls    :: IfaceDecls           -- The RnDecls form of ModDetails
+               -- NOT STRICT!  we fill this field with _|_ sometimes
      }
 
 data IfaceDecls = IfaceDecls { dcl_tycl  :: [RenamedTyClDecl], -- Sorted
@@ -166,16 +207,16 @@ mkIfaceDecls tycls rules insts
 data ModDetails
    = 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_binds    :: [CoreBind]
+        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_binds    :: ![CoreBind]
      }
 
 -- The ModDetails takes on several slightly different forms:
 --
 -- After typecheck + desugar
---     md_types        Contains TyCons, Classes, and hasNoBinding Ids
+--     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
@@ -207,23 +248,17 @@ data ModDetails
 \end{code}
 
 \begin{code}
-emptyModDetails :: ModDetails
-emptyModDetails
-  = ModDetails { md_types = emptyTypeEnv,
-                 md_insts = [],
-                 md_rules = []
-    }
-
 emptyModIface :: Module -> ModIface
 emptyModIface mod
   = ModIface { mi_module   = mod,
+              mi_package  = preludePackage, -- XXX fully bogus
               mi_version  = initialVersionInfo,
               mi_usages   = [],
               mi_orphan   = False,
               mi_boot     = False,
               mi_exports  = [],
               mi_fixities = emptyNameEnv,
-              mi_globals  = emptyRdrEnv,
+              mi_globals  = Nothing,
               mi_deprecs  = NoDeprecs,
               mi_decls    = panic "emptyModIface: decls"
     }          
@@ -261,6 +296,14 @@ lookupIfaceByModName :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> May
 -- We often have two IfaceTables, and want to do a lookup
 lookupIfaceByModName hit pit mod
   = lookupModuleEnvByName hit mod `seqMaybe` lookupModuleEnvByName pit mod
+
+-- Use instead of Finder.findModule if possible: this way doesn't
+-- require filesystem operations, and it is guaranteed not to fail
+-- when the IfaceTables are properly populated (i.e. after the renamer).
+moduleNameToModule :: HomeIfaceTable -> PackageIfaceTable -> ModuleName
+   -> Module
+moduleNameToModule hit pit mod 
+   = mi_module (fromJust (lookupIfaceByModName hit pit mod))
 \end{code}
 
 
@@ -273,10 +316,19 @@ lookupIfaceByModName hit pit mod
 \begin{code}
 data InteractiveContext 
   = InteractiveContext { 
-       ic_module :: Module,            -- The current module in which 
-                                       -- the  user is sitting
+       ic_toplev_scope :: [Module],    -- Include the "top-level" scope of
+                                       -- these modules
+
+       ic_exports :: [Module],         -- Include just the exports of these
+                                       -- modules
+
+       ic_rn_gbl_env :: GlobalRdrEnv,  -- The cached GlobalRdrEnv, built from
+                                       -- ic_toplev_scope and ic_exports
 
-       ic_rn_env :: LocalRdrEnv,       -- Lexical context for variables bound
+       ic_print_unqual :: PrintUnqualified,
+                                       -- cached PrintUnqualified, as above
+
+       ic_rn_local_env :: LocalRdrEnv, -- Lexical context for variables bound
                                        -- during interaction
 
        ic_type_env :: TypeEnv          -- Ditto for types
@@ -310,9 +362,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 
@@ -323,9 +382,14 @@ implicitTyThingIds things
     go (AClass cl) = classSelIds cl
     go (ATyCon tc) = tyConGenIds tc ++
                     tyConSelIds tc ++
-                    [ n | dc <- tyConDataConsIfAvailable tc, 
-                          n  <- [dataConId dc, dataConWrapId dc] ] 
+                    [ n | dc <- tyConDataCons_maybe tc `orElse` [],
+                          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     = [dataConWorkId dc, dataConWrapId dc]
 \end{code}
 
 
@@ -424,8 +488,14 @@ data GenAvailInfo name     = Avail name     -- An ordinary identifier
                        deriving( Eq )
                        -- Equality used when deciding if the interface has changed
 
-type AvailEnv    = NameEnv AvailInfo   -- Maps a Name to the AvailInfo that contains it
-                               
+type RdrExportItem = (ModuleName, [RdrAvailInfo])
+type ExportItem    = (ModuleName, [AvailInfo])
+
+type AvailEnv = NameEnv AvailInfo      -- Maps a Name to the AvailInfo that contains it
+
+emptyAvailEnv :: AvailEnv
+emptyAvailEnv = emptyNameEnv
+
 instance Outputable n => Outputable (GenAvailInfo n) where
    ppr = pprAvail
 
@@ -437,6 +507,20 @@ pprAvail (AvailTC n ns) = ppr n <> case {- filter (/= n) -} ns of
 pprAvail (Avail n) = ppr n
 \end{code}
 
+\begin{code}
+type FixityEnv = NameEnv Fixity
+
+lookupFixity :: FixityEnv -> Name -> Fixity
+lookupFixity env n = lookupNameEnv env n `orElse` defaultFixity
+
+collectFixities :: FixityEnv -> [TyClDecl Name pat] -> [(Name,Fixity)]
+collectFixities env decls
+  = [ (n, fix) 
+    | d <- decls, (n,_) <- tyClDeclNames d,
+      Just fix <- [lookupNameEnv env n]
+    ]
+\end{code}
+
 
 %************************************************************************
 %*                                                                     *
@@ -490,42 +574,48 @@ type IsExported = Name -> Bool            -- True for names that are exported from this mo
 %*                                                                     *
 %************************************************************************
 
+The @PersistentCompilerState@ persists across successive calls to the
+compiler.
+
+  * A ModIface for each non-home-package module
+
+  * An accumulated TypeEnv from all the modules in imported packages
+
+  * An accumulated InstEnv from all the modules in imported packages
+    The point is that we don't want to keep recreating it whenever
+    we compile a new module.  The InstEnv component of pcPST is empty.
+    (This means we might "see" instances that we shouldn't "really" see;
+    but the Haskell Report is vague on what is meant to be visible, 
+    so we just take the easy road here.)
+
+  * Ditto for rules
+  * The persistent renamer state
+
 \begin{code}
 data PersistentCompilerState 
    = PCS {
-        pcs_PIT :: PackageIfaceTable,  -- Domain = non-home-package modules
+        pcs_PIT :: !PackageIfaceTable, -- Domain = non-home-package modules
                                        --   the mi_decls component is empty
 
-        pcs_PTE :: PackageTypeEnv,     -- Domain = non-home-package modules
+        pcs_PTE :: !PackageTypeEnv,    -- Domain = non-home-package modules
                                        --   except that the InstEnv components is empty
 
-       pcs_insts :: PackageInstEnv,    -- The total InstEnv accumulated from all
+       pcs_insts :: !PackageInstEnv,   -- The total InstEnv accumulated from all
                                        --   the non-home-package modules
 
-       pcs_rules :: PackageRuleBase,   -- Ditto RuleEnv
+       pcs_rules :: !PackageRuleBase,  -- Ditto RuleEnv
 
-        pcs_PRS :: PersistentRenamerState
+        pcs_PRS :: !PersistentRenamerState
      }
 \end{code}
 
-The @PersistentRenamerState@ persists across successive calls to the
-compiler.
 
-It contains:
+The persistent renamer state contains:
+
   * A name supply, which deals with allocating unique names to
     (Module,OccName) original names, 
  
-  * An accumulated TypeEnv from all the modules in imported packages
-
-  * An accumulated InstEnv from all the modules in imported packages
-    The point is that we don't want to keep recreating it whenever
-    we compile a new module.  The InstEnv component of pcPST is empty.
-    (This means we might "see" instances that we shouldn't "really" see;
-    but the Haskell Report is vague on what is meant to be visible, 
-    so we just take the easy road here.)
-
-  * Ditto for rules
-
   * A "holding pen" for declarations that have been read out of
     interface files but not yet sucked in, renamed, and typechecked
 
@@ -535,11 +625,14 @@ type PackageRuleBase = RuleBase
 type PackageInstEnv  = InstEnv
 
 data PersistentRenamerState
-  = PRS { prsOrig    :: NameSupply,
-         prsImpMods :: ImportedModuleInfo,
-         prsDecls   :: DeclsMap,
-         prsInsts   :: IfaceInsts,
-         prsRules   :: IfaceRules
+  = PRS { prsOrig    :: !NameSupply,
+         prsImpMods :: !ImportedModuleInfo,
+
+               -- Holding pens for stuff that has been read in
+               -- but not yet slurped into the renamer
+         prsDecls   :: !DeclsMap,
+         prsInsts   :: !IfaceInsts,
+         prsRules   :: !IfaceRules
     }
 \end{code}
 
@@ -566,7 +659,7 @@ data NameSupply
    }
 
 type OrigNameCache   = FiniteMap (ModuleName,OccName) Name
-type OrigIParamCache = FiniteMap OccName Name
+type OrigIParamCache = FiniteMap (IPName RdrName) (IPName Name)
 \end{code}
 
 @ImportedModuleInfo@ contains info ONLY about modules that have not yet 
@@ -592,7 +685,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}
 
 
@@ -690,11 +789,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}