X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FInst.lhs;h=c34bf6d2409d8d21dc6ad99fe438b482b72b4dc5;hb=4e5faff9152918cd00dcdad9068b0f1eba1fcd68;hp=2fc44ddd42261a20b780c3b92484f7ac3ee162ad;hpb=f4510d27c5883fe7e8570f4dd49d45a8b0122f2c;p=ghc-hetmet.git

diff --git a/compiler/typecheck/Inst.lhs b/compiler/typecheck/Inst.lhs
index 2fc44dd..c34bf6d 100644
--- a/compiler/typecheck/Inst.lhs
+++ b/compiler/typecheck/Inst.lhs
@@ -24,7 +24,7 @@ module Inst (
 
 	tyVarsOfInst, tyVarsOfInsts, tyVarsOfLIE, 
 	ipNamesOfInst, ipNamesOfInsts, fdPredsOfInst, fdPredsOfInsts,
-	instLoc, getDictClassTys, dictPred,
+	getDictClassTys, dictPred,
 
 	lookupSimpleInst, LookupInstResult(..), lookupPred, 
 	tcExtendLocalInstEnv, tcGetInstEnvs, getOverlapFlag,
@@ -110,7 +110,8 @@ instType imp@(ImplicInst {})      = mkImplicTy (tci_tyvars imp) (tci_given imp)
 					       (tci_wanted imp)
 
 mkImplicTy tvs givens wanteds	-- The type of an implication constraint
-  = -- pprTrace "mkImplicTy" (ppr givens) $
+  = ASSERT( all isDict givens )
+    -- pprTrace "mkImplicTy" (ppr givens) $
     mkForAllTys tvs $ 
     mkPhiTy (map dictPred givens) $
     if isSingleton wanteds then
@@ -118,8 +119,6 @@ mkImplicTy tvs givens wanteds	-- The type of an implication constraint
     else
 	mkTupleTy Boxed (length wanteds) (map instType wanteds)
 
-instLoc inst = tci_loc inst
-
 dictPred (Dict {tci_pred = pred}) = pred
 dictPred inst		          = pprPanic "dictPred" (ppr inst)
 
@@ -332,6 +331,7 @@ mkPredName uniq loc pred_ty
     occ = case pred_ty of
 	    ClassP cls tys -> mkDictOcc (getOccName cls)
 	    IParam ip ty   -> getOccName (ipNameName ip)
+	    EqPred _ _     -> pprPanic "mkPredName" (ppr pred_ty)
 \end{code}
 
 %************************************************************************
@@ -665,7 +665,7 @@ lookupSimpleInst :: Inst -> TcM LookupInstResult
 -- the LIE.  Instead, any Insts needed by the lookup are returned in
 -- the LookupInstResult, where they can be further processed by tcSimplify
 
---------------------- Impliciations ------------------------
+--------------------- Implications ------------------------
 lookupSimpleInst (ImplicInst {}) = return NoInstance
 
 --------------------- Methods ------------------------
@@ -785,7 +785,7 @@ lookupPred pred@(ClassP clas tys)
 			; return Nothing }
 	}}
 
-lookupPred ip_pred = return Nothing
+lookupPred ip_pred = return Nothing	-- Implicit parameters
 
 record_dfun_usage dfun_id 
   = do	{ hsc_env <- getTopEnv