[project @ 2001-05-04 08:10:30 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcInstDcls.lhs

diff --git a/ghc/compiler/typecheck/TcInstDcls.lhs b/ghc/compiler/typecheck/TcInstDcls.lhs
index 1a38a13..324ee71 100644 (file)
--- a/ghc/compiler/typecheck/TcInstDcls.lhs
+++ b/ghc/compiler/typecheck/TcInstDcls.lhs
@@ -13,7 +13,7 @@ import CmdLineOpts    ( DynFlag(..), dopt )
 
 import HsSyn           ( HsDecl(..), InstDecl(..), TyClDecl(..), HsType(..),
                          MonoBinds(..), HsExpr(..),  HsLit(..), Sig(..), 
-                         andMonoBindList, collectMonoBinders, isClassDecl
+                         andMonoBindList, collectMonoBinders, isClassDecl, toHsType
                        )
 import RnHsSyn         ( RenamedHsBinds, RenamedInstDecl, RenamedHsDecl, 
                          RenamedMonoBinds, RenamedTyClDecl, RenamedHsType, 
@@ -52,7 +52,7 @@ import FunDeps                ( checkInstFDs )
 import Generics                ( validGenericInstanceType )
 import Module          ( Module, foldModuleEnv )
 import Name            ( getSrcLoc )
-import NameSet         ( emptyNameSet, mkNameSet, nameSetToList )
+import NameSet         ( emptyNameSet, unitNameSet, nameSetToList )
 import PrelInfo                ( eRROR_ID )
 import PprType         ( pprClassPred, pprPred )
 import TyCon           ( TyCon, isSynTyCon )
@@ -512,8 +512,9 @@ tcInstDecl2 :: InstInfo -> NF_TcM (LIE, TcMonoBinds)
 tcInstDecl2 (InstInfo { iDFunId = dfun_id, 
                        iBinds = monobinds, iPrags = uprags })
   =     -- Prime error recovery
-    recoverNF_Tc (returnNF_Tc (emptyLIE, EmptyMonoBinds))  $
-    tcAddSrcLoc (getSrcLoc dfun_id)                       $
+    recoverNF_Tc (returnNF_Tc (emptyLIE, EmptyMonoBinds))      $
+    tcAddSrcLoc (getSrcLoc dfun_id)                            $
+    tcAddErrCtxt (instDeclCtxt (toHsType (idType dfun_id)))    $
 
        -- Instantiate the instance decl with tc-style type variables
     tcInstType (idType dfun_id)                `thenNF_Tc` \ (inst_tyvars', dfun_theta', dict_ty') ->
@@ -601,7 +602,11 @@ tcInstDecl2 (InstInfo { iDFunId = dfun_id,
         dict_constr   = classDataCon clas
        scs_and_meths = map instToId (sc_dicts ++ meth_insts)
        this_dict_id  = instToId this_dict
-       inlines       = mkNameSet [idName dfun_id | InlineInstSig _ _ <- uprags]
+       inlines       = unitNameSet (idName dfun_id)
+               -- Always inline the dfun; this is an experimental decision
+               -- because it makes a big performance difference sometimes.
+               -- Often it means we can do the method selection, and then
+               -- inline the method as well.  Marcin's idea.
 
        dict_rhs
          | null scs_and_meths
@@ -729,7 +734,8 @@ check_tyvars dflags clas inst_taus
   | otherwise                                = [the_err]
   where
     the_err = instTypeErr clas inst_taus msg
-    msg     = ptext SLIT("There must be at least one non-type-variable in the instance head")
+    msg     =  ptext SLIT("There must be at least one non-type-variable in the instance head")
+           $$ ptext SLIT("Use -fallow-undecidable-instances to lift this restriction")
 
 check_fundeps dflags theta clas inst_taus
   | checkInstFDs theta clas inst_taus = []