-
-instLoc (Dict _ _ loc) = loc
-instLoc (Method _ _ _ _ loc) = loc
-instLoc (LitInst _ _ _ loc) = loc
-
-dictPred (Dict _ pred _ ) = pred
-dictPred inst = pprPanic "dictPred" (ppr inst)
-
-getDictClassTys (Dict _ pred _) = getClassPredTys pred
+instToVar (ImplicInst {tci_name = nm, tci_tyvars = tvs, tci_given = givens,
+ tci_wanted = wanteds})
+ = mkLocalId nm (mkImplicTy tvs givens wanteds)
+
+instType :: Inst -> Type
+instType (LitInst {tci_ty = ty}) = ty
+instType (Method {tci_id = id}) = idType id
+instType (Dict {tci_pred = pred}) = mkPredTy pred
+instType imp@(ImplicInst {}) = mkImplicTy (tci_tyvars imp) (tci_given imp)
+ (tci_wanted imp)
+
+mkImplicTy tvs givens wanteds -- The type of an implication constraint
+ = ASSERT( all isDict givens )
+ -- pprTrace "mkImplicTy" (ppr givens) $
+ mkForAllTys tvs $
+ mkPhiTy (map dictPred givens) $
+ if isSingleton wanteds then
+ instType (head wanteds)
+ else
+ mkTupleTy Boxed (length wanteds) (map instType wanteds)
+
+dictPred (Dict {tci_pred = pred}) = pred
+dictPred inst = pprPanic "dictPred" (ppr inst)
+
+getDictClassTys (Dict {tci_pred = pred}) = getClassPredTys pred
+getDictClassTys inst = pprPanic "getDictClassTys" (ppr inst)