[project @ 2000-10-18 12:47:55 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 7c9ae96..63f80de 100644 (file)
--- a/ghc/compiler/main/HscTypes.lhs
+++ b/ghc/compiler/main/HscTypes.lhs
@@ -8,11 +8,16 @@ module HscTypes (
        ModDetails(..), GlobalSymbolTable, 
        HomeSymbolTable, PackageSymbolTable,
 
-       TyThing(..), lookupTypeEnv,
+       TyThing(..), groupTyThings,
 
-       WhetherHasOrphans, ImportVersion, ExportItem,
+       TypeEnv, extendTypeEnv, lookupTypeEnv, 
+
+       lookupFixityEnv,
+
+       WhetherHasOrphans, ImportVersion, ExportItem, WhatsImported(..),
        PersistentRenamerState(..), IsBootInterface, Avails, DeclsMap,
-       IfaceInsts, IfaceRules, DeprecationEnv, OrigNameEnv, 
+       IfaceInsts, IfaceRules, DeprecationEnv, 
+       OrigNameEnv(..), OrigNameNameEnv, OrigNameIParamEnv,
        AvailEnv, AvailInfo, GenAvailInfo(..),
        PersistentCompilerState(..),
 
@@ -20,6 +25,8 @@ module HscTypes (
 
        GlobalRdrEnv, RdrAvailInfo,
 
+       CompResult(..), HscResult(..),
+
        -- Provenance
        Provenance(..), ImportReason(..), PrintUnqualified,
         pprNameProvenance, hasBetterProv
@@ -49,6 +56,7 @@ import ErrUtils               ( ErrMsg, WarnMsg )
 import CmLink          ( Linkable )
 import RdrHsSyn                ( RdrNameInstDecl, RdrNameRuleDecl, RdrNameHsDecl,
                          RdrNameDeprecation, RdrNameFixitySig )
+import InterpSyn       ( UnlinkedIBind )
 import UniqSupply      ( UniqSupply )
 import HsDecls         ( DeprecTxt )
 import CoreSyn         ( CoreRule )
@@ -58,6 +66,7 @@ import VarSet         ( TyVarSet )
 import Panic           ( panic )
 import Outputable
 import SrcLoc          ( SrcLoc, isGoodSrcLoc )
+import Util            ( thenCmp )
 \end{code}
 
 %************************************************************************
@@ -357,9 +366,14 @@ we just store junk.  Then when we find the binding site, we fix it up.
 
 \begin{code}
 data OrigNameEnv
- = Orig { origNames  :: FiniteMap (ModuleName,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  :: OrigNameNameEnv,
+               -- Ensures that one original name gets one unique
+         origIParam :: OrigNameIParamEnv
+               -- Ensures that one implicit parameter name gets one unique
    }
+
+type OrigNameNameEnv   = FiniteMap (ModuleName,OccName) Name
+type OrigNameIParamEnv = FiniteMap OccName Name
 \end{code}
 
 
@@ -408,14 +422,14 @@ data HscResult
             (Maybe ModIFace)        -- new iface (if any compilation was done)
             (Maybe String)          -- generated stub_h filename (in /tmp)
             (Maybe String)          -- generated stub_c filename (in /tmp)
+            (Maybe [UnlinkedIBind]) -- interpreted code, if any
              PersistentCompilerState -- updated PCS
-             [SDoc]                  -- warnings
+             (Bag WarnMsg)             -- warnings
 
    | HscErrs PersistentCompilerState -- updated PCS
-             [SDoc]                  -- errors
-             [SDoc]                  -- warnings
+             (Bag ErrMsg)              -- errors
+             (Bag WarnMsg)             -- warnings
 
-       
 -- These two are only here to avoid recursion between CmCompile and
 -- CompManager.  They really ought to be in the latter.
 type ModuleEnv a = UniqFM a   -- Domain is Module
@@ -450,6 +464,29 @@ data Provenance
        ImportReason
        PrintUnqualified
 
+-- Just used for grouping error messages (in RnEnv.warnUnusedBinds)
+instance Eq Provenance where
+  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
+
+instance Eq ImportReason where
+  p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
+
+instance Ord Provenance where
+   compare LocalDef LocalDef = EQ
+   compare LocalDef (NonLocalDef _ _) = LT
+   compare (NonLocalDef _ _) LocalDef = GT
+
+   compare (NonLocalDef reason1 _) (NonLocalDef reason2 _) 
+      = compare reason1 reason2
+
+instance Ord ImportReason where
+   compare ImplicitImport ImplicitImport = EQ
+   compare ImplicitImport (UserImport _ _ _) = LT
+   compare (UserImport _ _ _) ImplicitImport = GT
+   compare (UserImport m1 loc1 _) (UserImport m2 loc2 _) 
+      = (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
+
+
 {-
 Moved here from Name.
 pp_prov (LocalDef _ Exported)          = char 'x'