[project @ 2000-10-26 07:19:52 by simonpj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index 84b129b..9550ac6 100644 (file)
@@ -9,24 +9,28 @@ module HscTypes (
 
        ModDetails(..), ModIface(..), GlobalSymbolTable, 
        HomeSymbolTable, PackageSymbolTable,
-       HomeIfaceTable, PackageIfaceTable,
+       HomeIfaceTable, PackageIfaceTable, 
+       lookupTable, lookupTableByModName,
 
-       VersionInfo(..),
+       IfaceDecls(..), 
 
-       TyThing(..), groupTyThings,
+       VersionInfo(..), initialVersionInfo,
 
-       TypeEnv, extendTypeEnv, lookupTypeEnv, 
+       TyThing(..), groupTyThings, isTyClThing,
 
-       lookupFixityEnv,
+       TypeEnv, extendTypeEnv, lookupTypeEnv, 
 
        WhetherHasOrphans, ImportVersion, WhatsImported(..),
        PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
-       IfaceInsts, IfaceRules, Deprecations(..), GatedDecl,
+       IfaceInsts, IfaceRules, GatedDecl,
        OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
        AvailEnv, AvailInfo, GenAvailInfo(..),
        PersistentCompilerState(..),
 
+       Deprecations(..), lookupDeprec,
+
        InstEnv, ClsInstEnv, DFunId,
+       PackageInstEnv, PackageRuleBase,
 
        GlobalRdrEnv, RdrAvailInfo,
 
@@ -46,28 +50,31 @@ import Name         ( Name, NameEnv, NamedThing,
 import NameSet         ( NameSet )
 import OccName         ( OccName )
 import Module          ( Module, ModuleName, ModuleEnv,
-                         lookupModuleEnv )
+                         lookupModuleEnv, lookupModuleEnvByName
+                       )
+import Rules           ( RuleBase )
 import VarSet          ( TyVarSet )
-import VarEnv          ( IdEnv, emptyVarEnv )
 import Id              ( Id )
 import Class           ( Class )
 import TyCon           ( TyCon )
 
-import BasicTypes      ( Version, Fixity )
+import BasicTypes      ( Version, initialVersion, Fixity )
 
 import HsSyn           ( DeprecTxt )
-import RdrHsSyn                ( RdrNameHsDecl )
-import RnHsSyn         ( RenamedHsDecl )
+import RdrHsSyn                ( RdrNameHsDecl, RdrNameTyClDecl )
+import RnHsSyn         ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl )
 
-import CoreSyn         ( CoreRule )
+import CoreSyn         ( CoreRule, IdCoreRule )
 import Type            ( Type )
 
 import FiniteMap       ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
 import Bag             ( Bag )
+import Maybes          ( seqMaybe )
 import UniqFM          ( UniqFM )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
 import Util            ( thenCmp )
+import UniqSupply      ( UniqSupply )
 \end{code}
 
 %************************************************************************
@@ -114,9 +121,13 @@ data ModIface
         mi_version  :: VersionInfo,            -- Module version number
         mi_orphan   :: WhetherHasOrphans,       -- Whether this module has orphans
 
-        mi_usages   :: [ImportVersion Name],   -- Usages
+        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_exports  :: Avails,                 -- What it exports; kept sorted by (mod,occ),
+        mi_exports  :: [(ModuleName,Avails)],  -- What it exports
+                                               -- Kept sorted by (mod,occ),
                                                -- to make version comparisons easier
 
         mi_globals  :: GlobalRdrEnv,           -- Its top level environment
@@ -124,10 +135,13 @@ data ModIface
         mi_fixities :: NameEnv Fixity,         -- Fixities
        mi_deprecs  :: Deprecations,            -- Deprecations
 
-       mi_decls    :: [RenamedHsDecl]          -- types, classes 
-                                               -- inst decls, rules, iface sigs
+       mi_decls    :: IfaceDecls               -- The RnDecls form of ModDetails
      }
 
+data IfaceDecls = IfaceDecls { dcl_tycl  :: [RenamedTyClDecl], -- Sorted
+                              dcl_rules :: [RenamedRuleDecl],  -- Sorted
+                              dcl_insts :: [RenamedInstDecl] } -- Unsorted
+
 -- typechecker should only look at this, not ModIface
 -- Should be able to construct ModDetails from mi_decls in ModIface
 data ModDetails
@@ -135,7 +149,7 @@ 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    :: RuleEnv         -- Domain may include Ids from other modules
+        md_rules    :: [IdCoreRule]    -- Domain may include Ids from other modules
      }
 \end{code}
 
@@ -144,7 +158,7 @@ emptyModDetails :: ModDetails
 emptyModDetails
   = ModDetails { md_types = emptyTypeEnv,
                  md_insts = [],
-                 md_rules = emptyRuleEnv
+                 md_rules = []
     }
 
 emptyModIface :: Module -> ModIface
@@ -173,11 +187,17 @@ type GlobalSymbolTable  = SymbolTable     -- Domain = all modules
 Simple lookups in the symbol table.
 
 \begin{code}
-lookupFixityEnv :: IfaceTable -> Name -> Maybe Fixity
-lookupFixityEnv tbl name
-  = case lookupModuleEnv tbl (nameModule name) of
-       Nothing      -> Nothing
-       Just details -> lookupNameEnv (mi_fixities details) name
+lookupTable :: ModuleEnv a -> ModuleEnv a -> Name -> Maybe a
+-- We often have two Symbol- or IfaceTables, and want to do a lookup
+lookupTable ht pt name
+  = lookupModuleEnv ht mod `seqMaybe` lookupModuleEnv pt mod
+  where
+    mod = nameModule name
+
+lookupTableByModName :: ModuleEnv a -> ModuleEnv a -> ModuleName -> Maybe a
+-- We often have two Symbol- or IfaceTables, and want to do a lookup
+lookupTableByModName ht pt mod
+  = lookupModuleEnvByName ht mod `seqMaybe` lookupModuleEnvByName pt mod
 \end{code}
 
 
@@ -195,6 +215,11 @@ data TyThing = AnId   Id
             | ATyCon TyCon
             | AClass Class
 
+isTyClThing :: TyThing -> Bool
+isTyClThing (ATyCon _) = True
+isTyClThing (AClass _) = True
+isTyClThing (AnId   _) = False
+
 instance NamedThing TyThing where
   getName (AnId id)   = getName id
   getName (ATyCon tc) = getName tc
@@ -261,18 +286,31 @@ data VersionInfo
                -- the parent class/tycon changes
     }
 
+initialVersionInfo :: VersionInfo
+initialVersionInfo = VersionInfo { vers_module  = initialVersion,
+                                  vers_exports = initialVersion,
+                                  vers_rules   = initialVersion,
+                                  vers_decls   = emptyNameEnv }
+
 data Deprecations = NoDeprecs
-                 | DeprecAll DeprecTxt                 -- Whole module deprecated
-                 | DeprecSome (NameEnv DeprecTxt)      -- Some things deprecated
-                                                       -- Just "big" names
+                 | DeprecAll DeprecTxt                         -- Whole module deprecated
+                 | DeprecSome (NameEnv (Name,DeprecTxt))       -- Some things deprecated
+                                                               -- Just "big" names
+               -- We keep the Name in the range, so we can print them out
+
+lookupDeprec :: ModIface -> Name -> Maybe DeprecTxt
+lookupDeprec iface name
+  = case mi_deprecs iface of
+       NoDeprecs      -> Nothing
+       DeprecAll txt  -> Just txt
+       DeprecSome env -> case lookupNameEnv env name of
+                           Just (_, txt) -> Just txt
+                           Nothing       -> Nothing
 
 type InstEnv    = UniqFM ClsInstEnv            -- Maps Class to instances for that class
+
 type ClsInstEnv = [(TyVarSet, [Type], DFunId)] -- The instances for a particular class
 type DFunId    = Id
-
-type RuleEnv    = NameEnv [CoreRule]
-
-emptyRuleEnv    = emptyVarEnv
 \end{code}
 
 
@@ -349,14 +387,18 @@ data PersistentCompilerState
    = PCS {
         pcs_PIT :: PackageIfaceTable,  -- Domain = non-home-package modules
                                        --   the mi_decls component is empty
+
         pcs_PST :: PackageSymbolTable, -- Domain = non-home-package modules
                                        --   except that the InstEnv components is empty
-       pcs_insts :: InstEnv,           -- The total InstEnv accumulated from all
+
+       pcs_insts :: PackageInstEnv,    -- The total InstEnv accumulated from all
                                        --   the non-home-package modules
-       pcs_rules :: RuleEnv,           -- Ditto RuleEnv
+
+       pcs_rules :: PackageRuleBase,   -- Ditto RuleEnv
 
         pcs_PRS :: PersistentRenamerState
      }
+
 \end{code}
 
 The @PersistentRenamerState@ persists across successive calls to the
@@ -379,11 +421,15 @@ It contains:
     interface files but not yet sucked in, renamed, and typechecked
 
 \begin{code}
+type PackageRuleBase = RuleBase
+type PackageInstEnv  = InstEnv
+
 data PersistentRenamerState
   = PRS { prsOrig  :: OrigNameEnv,
          prsDecls :: DeclsMap,
          prsInsts :: IfaceInsts,
-         prsRules :: IfaceRules
+         prsRules :: IfaceRules,
+         prsNS    :: UniqSupply
     }
 \end{code}
 
@@ -417,7 +463,7 @@ including the constructors of a type decl etc.  The Bool is True just
 for the 'main' Name.
 
 \begin{code}
-type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameHsDecl))
+type DeclsMap = NameEnv (AvailInfo, Bool, (Module, RdrNameTyClDecl))
 
 type IfaceInsts = Bag GatedDecl
 type IfaceRules = Bag GatedDecl