X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=ghc%2Fcompiler%2Ftypecheck%2FInst.lhs;h=63422595b01e8748ac1476f24dc45ff7c54ecbaa;hb=f43ebad1020dccdf6fde2fddc91994b27d0f565e;hp=020d139b20d973abadc4f43c7cf4c2d79e32bbc9;hpb=1c3601593186639f1086bc402582ff56fd3fe9f8;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 020d139..6342259 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -43,25 +43,25 @@ import TcHsSyn	( TcExpr, TcId,
 		  mkHsTyApp, mkHsDictApp, mkHsConApp, zonkId
 		)
 import TcMonad
-import TcEnv	( TcIdSet, tcGetInstEnv, lookupInstEnv, InstLookupResult(..),
-		  tcLookupValue, tcLookupGlobalValue
-		)
+import TcEnv	( TcIdSet, tcGetInstEnv, tcLookupGlobalId )
+import InstEnv ( InstLookupResult(..), lookupInstEnv )
 import TcType	( TcThetaType,
 		  TcType, TcTauType, TcTyVarSet,
 		  zonkTcTyVars, zonkTcType, zonkTcTypes, 
 		  zonkTcThetaType
 		)
-import Bag
+import CoreFVs	( idFreeTyVars )
 import Class	( Class, FunDep )
 import FunDeps	( instantiateFdClassTys )
-import Id	( Id, idFreeTyVars, idType, mkUserLocal, mkSysLocal )
+import Id	( Id, idType, mkUserLocal, mkSysLocal )
 import PrelInfo	( isStandardClass, isCcallishClass, isNoDictClass )
 import Name	( mkDictOcc, mkMethodOcc, mkIPOcc, getOccName, nameUnique )
 import PprType	( pprPred )	
 import Type	( Type, PredType(..), 
 		  isTyVarTy, mkDictTy, mkPredTy,
 		  splitForAllTys, splitSigmaTy, funArgTy,
-		  splitRhoTy, tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
+		  splitMethodTy, splitRhoTy,
+		  tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
 		  tidyOpenType, tidyOpenTypes
 		)
 import Subst	( emptyInScopeSet, mkSubst, mkInScopeSet,
@@ -75,9 +75,10 @@ import TysWiredIn ( isIntTy,
 		    doubleDataCon, isDoubleTy,
 		    isIntegerTy, voidTy
 		  ) 
-import PrelNames( Unique, hasKey, fromIntClassOpKey, fromIntegerClassOpKey )
+import PrelNames( Unique, hasKey, fromIntName, fromIntegerClassOpKey )
 import Maybe	( catMaybes )
 import Util	( thenCmp, zipWithEqual, mapAccumL )
+import Bag
 import Outputable
 \end{code}
 
@@ -355,9 +356,9 @@ newMethod orig id tys
     let
 	(tyvars, rho) = splitForAllTys (idType id)
 	rho_ty	      = substTy (mkTyVarSubst tyvars tys) rho
-	(theta, tau)  = splitRhoTy rho_ty
+	(pred, tau)  = splitMethodTy rho_ty
     in
-    newMethodWithGivenTy orig id tys theta tau	`thenNF_Tc` \ meth_inst ->
+    newMethodWithGivenTy orig id tys [pred] tau	`thenNF_Tc` \ meth_inst ->
     returnNF_Tc (unitLIE meth_inst, instToId meth_inst)
 
 instOverloadedFun orig v arg_tys theta tau
@@ -553,7 +554,8 @@ pprInst (Dict u pred loc) = pprPred pred <+> show_uniq u
 pprInst m@(Method u id tys theta tau loc)
   = hsep [ppr id, ptext SLIT("at"), 
 	  brackets (interppSP tys) {- ,
-	  ppr theta, ppr tau,
+	  ptext SLIT("theta"), ppr theta,
+	  ptext SLIT("tau"), ppr tau
 	  show_uniq u,
 	  ppr (instToId m) -}]
 
@@ -663,7 +665,7 @@ lookupInst inst@(LitInst u (HsIntegral i from_integer_name) ty loc)
 							-- (i.e. no funny business with user-defined
 							--  packages of numeric classes)
   =	-- So we can use the Prelude fromInt 
-    tcLookupGlobalId fromIntClassOpName	`thenNF_Tc` \ from_int ->
+    tcLookupGlobalId fromIntName		`thenNF_Tc` \ from_int ->
     newMethodAtLoc loc from_int [ty]		`thenNF_Tc` \ (method_inst, method_id) ->
     returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) int_lit))
 
@@ -685,7 +687,7 @@ lookupInst inst@(LitInst u (HsFractional f from_rat_name) ty loc)
   | isDoubleTy ty   = returnNF_Tc (GenInst [] double_lit)
 
   | otherwise 
-  = tcLookupGlobalValue from_rat_name		`thenNF_Tc` \ from_rational ->
+  = tcLookupGlobalId from_rat_name		`thenNF_Tc` \ from_rational ->
     newMethodAtLoc loc from_rational [ty]	`thenNF_Tc` \ (method_inst, method_id) ->
     let
 	rational_ty  = funArgTy (idType method_id)