[project @ 2002-02-13 15:19:17 by simonpj]

[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 756aa6f..6077dda 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -7,7 +7,7 @@
 module HscTypes ( 
        GhciMode(..),
 
-       ModuleLocation(..),
+       ModuleLocation(..), showModMsg,
 
        ModDetails(..), ModIface(..), 
        HomeSymbolTable, emptySymbolTable,
@@ -21,6 +21,7 @@ module HscTypes (
        IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
 
        VersionInfo(..), initialVersionInfo, lookupVersion,
+       FixityEnv, lookupFixity,
 
        TyThing(..), isTyClThing, implicitTyThingIds,
 
@@ -53,23 +54,21 @@ module HscTypes (
 
 #include "HsVersions.h"
 
-import RdrName         ( RdrName, RdrNameEnv, addListToRdrEnv, emptyRdrEnv, 
+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, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataConsIfAvailable )
+import TyCon           ( TyCon, isNewTyCon, tyConGenIds, tyConSelIds, tyConDataCons_maybe )
 import DataCon         ( dataConId, dataConWrapId )
 
-import BasicTypes      ( Version, initialVersion, Fixity, IPName )
+import BasicTypes      ( Version, initialVersion, Fixity, defaultFixity, IPName )
 
 import HsSyn           ( DeprecTxt, tyClDeclName, ifaceRuleDeclName )
 import RdrHsSyn                ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameTyClDecl )
@@ -82,7 +81,7 @@ import Bag            ( Bag )
 import Maybes          ( seqMaybe, orElse )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
-import Util            ( thenCmp, sortLt )
+import Util            ( thenCmp, sortLt, unJust )
 import UniqSupply      ( UniqSupply )
 \end{code}
 
@@ -116,6 +115,18 @@ data ModuleLocation
 
 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)) ' '
+    ++" ( " ++ unJust "showModMsg" (ml_hs_file location) ++ ", "
+    ++ (if use_object
+         then unJust "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
@@ -145,9 +156,13 @@ the declarations into a single indexed map in the @PersistentRenamerState@.
 \begin{code}
 data ModIface 
    = ModIface {
-        mi_module   :: !Module,                    -- Complete with package info
+        mi_module   :: !Module,
+       mi_package  :: !PackageName,        -- Which package the module comes from
         mi_version  :: !VersionInfo,       -- Module version number
+
         mi_orphan   :: WhetherHasOrphans,   -- Whether this module has orphans
+               -- NOT STRICT!  we fill this field with _|_ sometimes
+
        mi_boot     :: !IsBootInterface,    -- read from an hi-boot file?
 
         mi_usages   :: ![ImportVersion Name],  
@@ -159,12 +174,15 @@ data ModIface
                -- What it exports Kept sorted by (mod,occ), to make
                -- version comparisons easier
 
-        mi_globals  :: !GlobalRdrEnv,      -- Its top level environment
+        mi_globals  :: !(Maybe GlobalRdrEnv),
+               -- Its top level environment or Nothing if we read this
+               -- interface from a file.
 
-        mi_fixities :: !(NameEnv Fixity),   -- Fixities
+        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
@@ -230,13 +248,14 @@ data ModDetails
 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"
     }          
@@ -286,10 +305,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
@@ -343,7 +371,7 @@ implicitTyThingIds things
     go (AClass cl) = classSelIds cl
     go (ATyCon tc) = tyConGenIds tc ++
                     tyConSelIds tc ++
-                    [ n | dc <- tyConDataConsIfAvailable tc, 
+                    [ n | dc <- tyConDataCons_maybe tc `orElse` [],
                           n  <- implicitConIds tc dc]
                -- Synonyms return empty list of constructors and selectors
 
@@ -465,6 +493,13 @@ 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
+\end{code}
+
 
 %************************************************************************
 %*                                                                     *