[project @ 2001-11-26 10:26:59 by simonpj]

--------------------------------------
	Finally get rid of tcAddImportedIdInfo
	--------------------------------------

TcEnv.tcAddImportedIdInfo is a notorious source of space leaks.
Simon M got rid of the need for it on default methods.
This commit gets rid of the need for it for dictionary function Ids,
and finally nukes the beast altogether. Hurrah!

The change really involves putting tcInterfaceSigs *before*
tcInstDecls1, so that any imported DFunIds are in the typechecker's
environment before we get to tcInstDecls.

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 10e11ea..a54f5e3 100644 (file)
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -17,7 +17,7 @@ module HsDecls (
        hsDeclName, instDeclName, 
        tyClDeclName, tyClDeclNames, tyClDeclSysNames, tyClDeclTyVars,
        isClassDecl, isSynDecl, isDataDecl, isIfaceSigDecl, countTyClDecls,
-       mkClassDeclSysNames, isIfaceRuleDecl, ifaceRuleDeclName,
+       mkClassDeclSysNames, isIfaceRuleDecl, isIfaceInstDecl, ifaceRuleDeclName,
        getClassDeclSysNames, conDetailsTys,
        collectRuleBndrSigTys
     ) where
@@ -47,7 +47,7 @@ import Util           ( eqListBy, count )
 import SrcLoc          ( SrcLoc )
 import FastString
 
-import Maybe           ( isNothing, fromJust ) 
+import Maybe           ( isNothing, isJust, fromJust ) 
 \end{code}
 
 
@@ -661,6 +661,9 @@ data InstDecl name pat
                                        -- Nothing for source-file instance decls
 
                SrcLoc
+
+isIfaceInstDecl :: InstDecl name pat -> Bool
+isIfaceInstDecl (InstDecl _ _ _ maybe_dfun _) = isJust maybe_dfun
 \end{code}
 
 \begin{code}

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index f171f16..49229c1 100644 (file)
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -13,7 +13,8 @@ import CmdLineOpts    ( DynFlag(..) )
 
 import HsSyn           ( HsDecl(..), InstDecl(..), TyClDecl(..), HsType(..),
                          MonoBinds(..), HsExpr(..),  HsLit(..), Sig(..), HsTyVarBndr(..),
-                         andMonoBindList, collectMonoBinders, isClassDecl, toHsType
+                         andMonoBindList, collectMonoBinders, 
+                         isClassDecl, isIfaceInstDecl, toHsType
                        )
 import RnHsSyn         ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl, 
                          RenamedMonoBinds, RenamedTyClDecl, RenamedHsType, 
@@ -34,7 +35,7 @@ import Inst           ( InstOrigin(..),
                          LIE, mkLIE, emptyLIE, plusLIE, plusLIEs )
 import TcDeriv         ( tcDeriving )
 import TcEnv           ( TcEnv, tcExtendGlobalValEnv, 
-                         tcExtendTyVarEnvForMeths, 
+                         tcExtendTyVarEnvForMeths, tcLookupId,
                          tcAddImportedIdInfo, tcLookupClass,
                          InstInfo(..), pprInstInfo, simpleInstInfoTyCon, 
                          simpleInstInfoTy, newDFunName,
@@ -176,9 +177,11 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity this_mod decls
        inst_decls = [inst_decl | InstD inst_decl <- decls]     
        tycl_decls = [decl      | TyClD decl <- decls]
        clas_decls = filter isClassDecl tycl_decls
+       (imported_inst_ds, local_inst_ds) = partition isIfaceInstDecl inst_decls
     in
        -- (1) Do the ordinary instance declarations
-    mapNF_Tc tcInstDecl1 inst_decls            `thenNF_Tc` \ inst_infos ->
+    mapNF_Tc tcInstDecl1 local_inst_ds         `thenNF_Tc` \ local_inst_infos ->
+    mapNF_Tc tcInstDecl1 imported_inst_ds      `thenNF_Tc` \ imported_inst_infos ->
 
        -- (2) Instances from generic class declarations
     getGenericInstances clas_decls             `thenTc` \ generic_inst_info -> 
@@ -191,17 +194,14 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity this_mod decls
        --      e) generic instances                                    inst_env4
        -- The result of (b) replaces the cached InstEnv in the PCS
     let
-       (local_inst_info, imported_inst_info) 
-               = partition (isLocalThing this_mod . iDFunId) (concat inst_infos)
-
-       imported_dfuns   = map (tcAddImportedIdInfo unf_env . iDFunId) 
-                              imported_inst_info
-       hst_dfuns        = foldModuleEnv ((++) . md_insts) [] hst
+       local_inst_info    = concat local_inst_infos
+       imported_inst_info = concat imported_inst_infos
+       hst_dfuns          = foldModuleEnv ((++) . md_insts) [] hst
     in 
 
 --    pprTrace "tcInstDecls" (vcat [ppr imported_dfuns, ppr hst_dfuns]) $
 
-    addInstDFuns inst_env0 imported_dfuns      `thenNF_Tc` \ inst_env1 ->
+    addInstInfos inst_env0 imported_inst_info  `thenNF_Tc` \ inst_env1 ->
     addInstDFuns inst_env1 hst_dfuns           `thenNF_Tc` \ inst_env2 ->
     addInstInfos inst_env2 local_inst_info     `thenNF_Tc` \ inst_env3 ->
     addInstInfos inst_env3 generic_inst_info   `thenNF_Tc` \ inst_env4 ->
@@ -210,7 +210,7 @@ tcInstDecls1 inst_env0 prs hst unf_env get_fixity this_mod decls
        --     note that we only do derivings for things in this module; 
        --     we ignore deriving decls from interfaces!
        -- This stuff computes a context for the derived instance decl, so it
-       -- needs to know about all the instances possible; hecne inst_env4
+       -- needs to know about all the instances possible; hence inst_env4
     tcDeriving prs this_mod inst_env4 get_fixity tycl_decls
                                        `thenTc` \ (deriv_inst_info, deriv_binds) ->
     addInstInfos inst_env4 deriv_inst_info             `thenNF_Tc` \ final_inst_env ->
@@ -266,14 +266,15 @@ tcInstDecl1 decl@(InstDecl poly_ty binds uprags maybe_dfun_name src_loc)
            checkValidInstHead tau                      `thenTc_`
            checkTc (checkInstFDs theta clas inst_tys)
                    (instTypeErr (pprClassPred clas inst_tys) msg)      `thenTc_`
-           newDFunName clas inst_tys src_loc
+           newDFunName clas inst_tys src_loc                           `thenTc` \ dfun_name ->
+           returnTc (mkDictFunId dfun_name clas tyvars inst_tys theta)
 
        Just dfun_name ->       -- An interface-file instance declaration
-                           returnNF_Tc dfun_name
-    )                                                          `thenNF_Tc` \ dfun_name ->
-    let
-       dfun_id = mkDictFunId dfun_name clas tyvars inst_tys theta
-    in
+                               -- Should be in scope by now, because we should
+                               -- have sucked in its interface-file definition
+                               -- So it will be replete with its unfolding etc
+                         tcLookupId dfun_name
+    )                                                  `thenNF_Tc` \ dfun_id ->
     returnTc [InstInfo { iDFunId = dfun_id, iBinds = binds, iPrags = uprags }]
   where
     msg  = parens (ptext SLIT("the instance types do not agree with the functional dependencies of the class"))

diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs
index 6a0fb1d..eea3a21 100644 (file)
--- a/ghc/compiler/typecheck/TcModule.lhs
+++ b/ghc/compiler/typecheck/TcModule.lhs
@@ -553,24 +553,25 @@ tcImports unf_env pcs hst get_fixity this_mod decls
     tcTyAndClassDecls unf_env this_mod tycl_decls      `thenTc` \ env ->
     tcSetEnv env                                       $
     
+       -- Interface type signatures
+       -- We tie a knot so that the Ids read out of interfaces are in scope
+       --   when we read their pragmas.
+       -- What we rely on is that pragmas are typechecked lazily; if
+       --   any type errors are found (ie there's an inconsistency)
+       --   we silently discard the pragma
+    traceTc (text "Tc2")                       `thenNF_Tc_`
+    tcInterfaceSigs unf_env this_mod tycl_decls        `thenTc` \ sig_ids ->
+    tcExtendGlobalValEnv sig_ids               $
+    
        -- Typecheck the instance decls, includes deriving
-    traceTc (text "Tc2")       `thenNF_Tc_`
+       -- Note that imported dictionary functions are already
+       -- in scope from the preceding tcInterfaceSigs
+    traceTc (text "Tc3")       `thenNF_Tc_`
     tcInstDecls1 (pcs_insts pcs) (pcs_PRS pcs) 
             hst unf_env get_fixity this_mod 
             decls                      `thenTc` \ (new_pcs_insts, inst_env, local_insts, deriv_binds) ->
     tcSetInstEnv inst_env                      $
     
-    -- Interface type signatures
-    -- We tie a knot so that the Ids read out of interfaces are in scope
-    --   when we read their pragmas.
-    -- What we rely on is that pragmas are typechecked lazily; if
-    --   any type errors are found (ie there's an inconsistency)
-    --   we silently discard the pragma
-    traceTc (text "Tc3")                       `thenNF_Tc_`
-    tcInterfaceSigs unf_env this_mod tycl_decls        `thenTc` \ sig_ids ->
-    tcExtendGlobalValEnv sig_ids               $
-    
-    
     tcIfaceRules unf_env (pcs_rules pcs) this_mod iface_rules  `thenNF_Tc` \ (new_pcs_rules, local_rules) ->
        -- When relinking this module from its interface-file decls
        -- we'll have IfaceRules that are in fact local to this module