[project @ 2000-10-13 14:14:31 by sewardj]
[ghc-hetmet.git] / ghc / compiler / main / HscTypes.lhs
index f18b11e..cb91e51 100644 (file)
@@ -4,11 +4,44 @@
 \section[HscTypes]{Types for the per-module compiler}
 
 \begin{code}
-module HscTypes  ( )
+module HscTypes ( TyThing(..), GlobalSymbolTable, OrigNameEnv, AvailEnv,
+                 WhetherHasOrphans, ImportVersion, ExportItem,
+                 PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
+                 IfaceInsts, IfaceRules, DeprecationEnv, ModDetails(..),
+                 InstEnv, lookupTypeEnv )
 where
 
 #include "HsVersions.h"
 
+import Name            ( Name, NameEnv, NamedThing,
+                         unitNameEnv, extendNameEnv, plusNameEnv, 
+                         lookupNameEnv, emptyNameEnv, getName, nameModule )
+import Module          ( Module, ModuleName,
+                         extendModuleEnv, lookupModuleEnv )
+import Class           ( Class )
+import OccName         ( OccName )
+import RdrName         ( RdrNameEnv, emptyRdrEnv )
+import Outputable      ( SDoc )
+import UniqFM          ( UniqFM )
+import FiniteMap       ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM )
+import Bag             ( Bag )
+import Id              ( Id )
+import VarEnv          ( IdEnv )
+import BasicTypes      ( Version, Fixity, defaultFixity )
+import TyCon           ( TyCon )
+import ErrUtils                ( ErrMsg, WarnMsg )
+import CmLink          ( Linkable )
+import RdrHsSyn                ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameHsDecl,
+                         RdrNameDeprecation, RdrNameFixitySig )
+import UniqSupply      ( UniqSupply )
+import HsDecls         ( DeprecTxt )
+import CoreSyn         ( CoreRule )
+import NameSet         ( NameSet )
+import Type            ( Type )
+import VarSet          ( TyVarSet )
+import {-# SOURCE #-} 
+       TcInstUtil ( emptyInstEnv )
+import Panic           ( panic )
 \end{code}
 
 %************************************************************************
@@ -17,7 +50,7 @@ where
 %*                                                                     *
 %************************************************************************
 
-A @ModDetails@ summarises everything we know about a compiled module
+A @ModDetails@ summarises everything we know about a compiled module.
 
 \begin{code}
 data ModDetails
@@ -34,17 +67,18 @@ data ModDetails
         ruleEnv       :: RuleEnv               -- Domain may include Id from other modules
      }
 
-emptyModDetails :: Module -> ModuleDetails
+emptyModDetails :: Module -> ModDetails
 emptyModDetails mod
   = ModDetails { moduleId      = mod,
                 moduleExports = [],
                 moduleEnv     = emptyRdrEnv,
                 fixityEnv     = emptyNameEnv,
-                deptecEnv     = emptyNameEnv,
+                deprecEnv     = emptyNameEnv,
                 typeEnv       = emptyNameEnv,
                 instEnv       = emptyInstEnv,
-    }           ruleEnv       = emptyRuleEnv
-               
+                ruleEnv       = emptyRuleEnv
+    }          
+emptyRuleEnv = panic "emptyRuleEnv"
 \end{code}
 
 Symbol tables map modules to ModDetails:
@@ -56,8 +90,7 @@ type PackageSymbolTable = SymbolTable -- Domain = modules in the some other pack
 type GlobalSymbolTable  = SymbolTable  -- Domain = all modules
 \end{code}
 
-
-Simple lookups in the symbol table
+Simple lookups in the symbol table.
 
 \begin{code}
 lookupFixityEnv :: SymbolTable -> Name -> Fixity
@@ -99,9 +132,10 @@ lookupTypeEnv tbl name
        Nothing      -> Nothing
 
 
-groupTyThings :: [TyThing] -> [(Module, TypeEnv)]
+groupTyThings :: [TyThing] -> FiniteMap Module TypeEnv
+  -- Finite map because we want the range too
 groupTyThings things
-  = fmToList (foldl add emptyFM things)
+  = foldl add emptyFM things
   where
     add :: FiniteMap Module TypeEnv -> TyThing -> FiniteMap Module TypeEnv
     add tbl thing = addToFM tbl mod new_env
@@ -112,16 +146,18 @@ groupTyThings things
                                Nothing  -> unitNameEnv name thing
                                Just env -> extendNameEnv env name thing
                
-extendTypeEnv :: SymbolTable -> [TyThing] -> SymbolTable
+extendTypeEnv :: SymbolTable -> FiniteMap Module TypeEnv -> SymbolTable
 extendTypeEnv tbl things
-  = foldl add tbl (groupTyThings things)
+  = foldFM add tbl things
   where
-    add tbl (mod,type_env)
-       = extendModuleEnv mod new_details
+    add mod type_env tbl
+       = panic "extendTypeEnv" --extendModuleEnv mod new_details
        where
-         new_details = case lookupModuleEnv tbl mod of
-                           Nothing      -> emptyModDetails mod {typeEnv = type_env}
-                           Just details -> details {typeEnv = typeEnv details `plusNameEnv` type_env})
+         new_details 
+             = case lookupModuleEnv tbl mod of
+                  Nothing      -> (emptyModDetails mod) {typeEnv = type_env}
+                  Just details -> details {typeEnv = typeEnv details 
+                                                     `plusNameEnv` type_env}
 \end{code}
 
 
@@ -189,6 +225,44 @@ data ModIFace
         mi_rules     :: (Version, [RdrNameRuleDecl]),  -- Rules, with their version
         mi_deprecs   :: [RdrNameDeprecation]           -- Deprecations
      }
+
+type ExportItem                 = (ModuleName, [RdrAvailInfo])
+
+type ImportVersion name  = (ModuleName, WhetherHasOrphans, IsBootInterface, WhatsImported name)
+
+type ModVersionInfo    = (Version,             -- Version of the whole module
+                          Version,             -- Version number for all fixity decls together
+                          Version)             -- ...ditto all rules together
+
+type WhetherHasOrphans   = Bool
+       -- An "orphan" is 
+       --      * an instance decl in a module other than the defn module for 
+       --              one of the tycons or classes in the instance head
+       --      * a transformation rule in a module other than the one defining
+       --              the function in the head of the rule.
+
+type IsBootInterface     = Bool
+
+data WhatsImported name  = NothingAtAll                                -- The module is below us in the
+                                                               -- hierarchy, but we import nothing
+
+                        | Everything Version                   -- The module version
+
+                        | Specifically Version                 -- Module version
+                                       Version                 -- Fixity version
+                                       Version                 -- Rules version
+                                       [(name,Version)]        -- List guaranteed non-empty
+                        deriving( Eq )
+       -- 'Specifically' doesn't let you say "I imported f but none of the fixities in
+       -- the module". If you use anything in the module you get its fixity and rule version
+       -- So if the fixities or rules change, you'll recompile, even if you don't use either.
+       -- This is easy to implement, and it's safer: you might not have used the rules last
+       -- time round, but if someone has added a new rule you might need it this time
+
+       -- 'Everything' means there was a "module M" in 
+       -- this module's export list, so we just have to go by M's version,
+       -- not the list of (name,version) pairs
+
 \end{code}
 
 
@@ -203,9 +277,9 @@ data PersistentCompilerState
    = PCS {
         pcsPST :: PackageSymbolTable,          -- Domain = non-home-package modules
                                                --   except that the InstEnv components is empty
-       pcsInsts :: InstEnv                     -- The total InstEnv accumulated from all
+       pcsInsts :: InstEnv,                    -- The total InstEnv accumulated from all
                                                --   the non-home-package modules
-       pcsRules :: RuleEnv                     -- Ditto RuleEnv
+       pcsRules :: RuleEnv,                    -- Ditto RuleEnv
 
         pcsPRS :: PersistentRenamerState
      }
@@ -235,12 +309,12 @@ data PersistentRenamerState
   = PRS { prsOrig  :: OrigNameEnv,
          prsDecls :: DeclsMap,
          prsInsts :: IfaceInsts,
-         prsRules :: IfaceRules,
+         prsRules :: IfaceRules
     }
 
 data OrigNameEnv
- = Orig { origNames  :: FiniteMap (Module,OccName) Name        -- Ensures that one original name gets one unique
-         origIParam :: FiniteMap OccName Name          -- Ensures that one implicit parameter name gets one unique
+ = Orig { origNames  :: FiniteMap (Module,OccName) Name, -- Ensures that one original name gets one unique
+         origIParam :: FiniteMap OccName Name           -- Ensures that one implicit parameter name gets one unique
    }
 
 type DeclsMap = NameEnv (Version, AvailInfo, Bool, (Module, RdrNameHsDecl))
@@ -283,9 +357,9 @@ data CompResult
 
 data HscResult
    = HscOK   ModDetails                -- new details (HomeSymbolTable additions)
-            Maybe ModIFace             -- new iface (if any compilation was done)
-            Maybe String               -- generated stub_h
-            Maybe String               -- generated stub_c
+            (Maybe ModIFace)           -- new iface (if any compilation was done)
+            (Maybe String)             -- generated stub_h
+            (Maybe String)             -- generated stub_c
              PersistentCompilerState   -- updated PCS
              [SDoc]                    -- warnings