X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcSimplify.lhs;h=bcb90dd97cf1443b565638b3cdf5cc78732dd34c;hb=ca5a4a480d10d61e5b7a52eb4d556e8b8c33e69d;hp=ff30d6f70da3d20567a5d36775b1e6462d36478d;hpb=7b0181919416d8f04324575b7e17031ca692f5b0;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index ff30d6f..bcb90dd 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -19,7 +19,7 @@ import HsSyn		( MonoBinds(..), HsExpr(..), InPat, OutPat, HsLit,
 			  GRHSsAndBinds, Stmt, Fake )
 import TcHsSyn		( TcIdOcc(..), TcIdBndr(..), TcExpr(..), TcMonoBinds(..) )
 
-import TcMonad
+import TcMonad		hiding ( rnMtoTcM )
 import Inst		( lookupInst, tyVarsOfInst, isTyVarDict, isDict, matchesInst,
 			  instToId, instBindingRequired, instCanBeGeneralised, newDictsAtLoc,
 			  Inst(..), LIE(..), zonkLIE, emptyLIE, plusLIE, unitLIE, consLIE,
@@ -31,11 +31,13 @@ import Unify		( unifyTauTy )
 import Bag		( Bag, unitBag, listToBag, foldBag, filterBag, emptyBag, bagToList, 
 			  snocBag, consBag, unionBags, isEmptyBag )
 import Class		( isNumericClass, isStandardClass, isCcallishClass,
-			  isSuperClassOf, getSuperDictSelId )
+			  isSuperClassOf, classSuperDictSelId
+			)
 import Id		( GenId )
 import Maybes		( expectJust, firstJust, catMaybes, seqMaybe, maybeToBool, Maybe(..) )
 import Outputable	( Outputable(..){-instance * []-} )
-import PprType		( GenType, GenTyVar )
+import PprStyle--ToDo:rm
+import PprType		( GenType, GenTyVar, GenClass{-instance Outputable;ToDo:rm-} )
 import Pretty
 import SrcLoc		( mkUnknownSrcLoc )
 import Util
@@ -271,7 +273,8 @@ tcSimplifyCheckThetas :: InstOrigin s		-- context; for error msg
 		      -> [(Class, TauType)]	-- Simplify this
 		      -> TcM s ()
 
-tcSimplifyCheckThetas = panic "tcSimplifyCheckThetas"
+tcSimplifyCheckThetas x y = _trace "tcSimplifyCheckThetas: does nothing" $
+		        returnTc ()
 
 {- 	LATER
 tcSimplifyCheckThetas origin theta
@@ -489,7 +492,7 @@ trySC givens wanted@(Dict _ wanted_class wanted_ty wanted_orig loc)
     let
 	mk_bind (dict,clas) dict_sub@(Dict _ dict_sub_class ty _ _)
 	  = ((dict_sub, dict_sub_class),
-	     (instToId dict, DictApp (TyApp (HsVar (RealId (getSuperDictSelId dict_sub_class 
+	     (instToId dict, DictApp (TyApp (HsVar (RealId (classSuperDictSelId dict_sub_class 
 									      clas)))
 					    [ty])
 				     [instToId dict_sub]))
@@ -698,15 +701,9 @@ all are standard; or all are CcallIsh.
 isStandardNumericDefaultable :: [Class] -> Bool
 
 isStandardNumericDefaultable classes
-  | any isNumericClass classes && all isStandardClass classes
-  = True
-
-isStandardNumericDefaultable classes
-  | all isCcallishClass classes
-  = True
-
-isStandardNumericDefaultable classes
-  = False
+  = --pprTrace "isStdNumeric:\n" (ppAboves [ppCat (map (ppr PprDebug) classes), ppCat (map (ppr PprDebug . isNumericClass) classes), ppCat (map (ppr PprDebug . isStandardClass) classes), ppCat (map (ppr PprDebug . isCcallishClass) classes)]) $
+     (any isNumericClass classes && all isStandardClass classes)
+  || (all isCcallishClass classes)
 \end{code}