[project @ 2000-10-27 13:50:25 by sewardj]

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

diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs
index 02da223..ec776c7 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -5,20 +5,21 @@
 
 \begin{code}
 module HscTypes ( 
-       Finder, ModuleLocation(..),
+       ModuleLocation(..),
 
        ModDetails(..), ModIface(..), GlobalSymbolTable, 
        HomeSymbolTable, PackageSymbolTable,
-       HomeIfaceTable, PackageIfaceTable, 
+       HomeIfaceTable, PackageIfaceTable, emptyIfaceTable,
        lookupTable, lookupTableByModName,
 
        IfaceDecls(..), 
 
        VersionInfo(..), initialVersionInfo,
 
-       TyThing(..), groupTyThings,
+       TyThing(..), groupTyThings, isTyClThing,
 
        TypeEnv, extendTypeEnv, lookupTypeEnv, 
+       typeEnvClasses, typeEnvTyCons,
 
        WhetherHasOrphans, ImportVersion, WhatsImported(..),
        PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
@@ -46,14 +47,14 @@ import RdrName              ( RdrNameEnv, emptyRdrEnv )
 import Name            ( Name, NameEnv, NamedThing,
                          emptyNameEnv, unitNameEnv, extendNameEnv, plusNameEnv, 
                          lookupNameEnv, emptyNameEnv, getName, nameModule,
-                         nameSrcLoc )
+                         nameSrcLoc, nameEnvElts )
 import NameSet         ( NameSet )
 import OccName         ( OccName )
 import Module          ( Module, ModuleName, ModuleEnv,
-                         lookupModuleEnv, lookupModuleEnvByName
+                         extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName
                        )
+import Rules           ( RuleBase )
 import VarSet          ( TyVarSet )
-import VarEnv          ( emptyVarEnv )
 import Id              ( Id )
 import Class           ( Class )
 import TyCon           ( TyCon )
@@ -64,13 +65,13 @@ import HsSyn                ( DeprecTxt )
 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 UniqFM          ( UniqFM, emptyUFM )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
 import Util            ( thenCmp )
@@ -79,19 +80,21 @@ import UniqSupply   ( UniqSupply )
 
 %************************************************************************
 %*                                                                     *
-\subsection{The Finder type}
+\subsection{Module locations}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-type Finder = ModuleName -> IO (Maybe (Module, ModuleLocation))
-
 data ModuleLocation
    = ModuleLocation {
        hs_file  :: FilePath,
        hi_file  :: FilePath,
        obj_file :: FilePath
-      }
+     }
+     deriving Show
+
+instance Outputable ModuleLocation where
+   ppr = text . show
 \end{code}
 
 For a module in another package, the hs_file and obj_file
@@ -126,7 +129,7 @@ data ModIface
                                                -- (changing usages doesn't affect the version of
                                                --  this module)
 
-        mi_exports  :: Avails,                 -- What it exports
+        mi_exports  :: [(ModuleName,Avails)],  -- What it exports
                                                -- Kept sorted by (mod,occ),
                                                -- to make version comparisons easier
 
@@ -149,7 +152,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    :: RuleBase                -- Domain may include Ids from other modules
+        md_rules    :: [IdCoreRule]    -- Domain may include Ids from other modules
      }
 \end{code}
 
@@ -158,7 +161,7 @@ emptyModDetails :: ModDetails
 emptyModDetails
   = ModDetails { md_types = emptyTypeEnv,
                  md_insts = [],
-                 md_rules = emptyRuleBase
+                 md_rules = []
     }
 
 emptyModIface :: Module -> ModIface
@@ -182,6 +185,9 @@ type PackageIfaceTable  = IfaceTable
 type HomeSymbolTable    = SymbolTable  -- Domain = modules in the home package
 type PackageSymbolTable = SymbolTable  -- Domain = modules in the some other package
 type GlobalSymbolTable  = SymbolTable  -- Domain = all modules
+
+emptyIfaceTable :: IfaceTable
+emptyIfaceTable = emptyUFM
 \end{code}
 
 Simple lookups in the symbol table.
@@ -215,10 +221,19 @@ 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
   getName (AClass cl) = getName cl
+
+typeEnvClasses env = [cl | AClass cl <- nameEnvElts env]
+typeEnvTyCons  env = [tc | ATyCon tc <- nameEnvElts env] 
+
 \end{code}
 
 
@@ -249,7 +264,7 @@ extendTypeEnv tbl things
   = foldFM add tbl things
   where
     add mod type_env tbl
-       = panic "extendTypeEnv" --extendModuleEnv mod new_details
+       = extendModuleEnv tbl mod new_details
        where
          new_details 
              = case lookupModuleEnv tbl mod of
@@ -288,16 +303,19 @@ initialVersionInfo = VersionInfo { vers_module  = 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 -> lookupNameEnv env name
+       DeprecSome env -> case lookupNameEnv env name of
+                           Just (_, txt) -> Just txt
+                           Nothing       -> Nothing
 
 type InstEnv    = UniqFM ClsInstEnv            -- Maps Class to instances for that class
 
@@ -386,7 +404,7 @@ data PersistentCompilerState
        pcs_insts :: PackageInstEnv,    -- The total InstEnv accumulated from all
                                        --   the non-home-package modules
 
-       pcs_rules :: PackageRuleEnv,    -- Ditto RuleEnv
+       pcs_rules :: PackageRuleBase,   -- Ditto RuleEnv
 
         pcs_PRS :: PersistentRenamerState
      }