-instName :: Inst -> Name
-instName (EqInst {tci_name = name}) = name
-instName inst = Var.varName (instToVar inst)
-
-instToId :: Inst -> TcId
-instToId inst = WARN( not (isId id), ppr inst )
- id
- where
- id = instToVar inst
-
-instToVar :: Inst -> Var
-instToVar (LitInst {tci_name = nm, tci_ty = ty})
- = mkLocalId nm ty
-instToVar (Method {tci_id = id})
- = id
-instToVar (Dict {tci_name = nm, tci_pred = pred})
- | isEqPred pred = Var.mkCoVar nm (mkPredTy pred)
- | otherwise = mkLocalId nm (mkPredTy pred)
-instToVar (ImplicInst {tci_name = nm, tci_tyvars = tvs, tci_given = givens,
- tci_wanted = wanteds})
- = mkLocalId nm (mkImplicTy tvs givens wanteds)
-instToVar i@(EqInst {})
- = eitherEqInst i id (\(TyVarTy covar) -> covar)
-
-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)
--- instType i@(EqInst {tci_co = co}) = eitherEqInst i TyVarTy id
-instType (EqInst {tci_left = ty1, tci_right = ty2}) = mkPredTy (EqPred ty1 ty2)
-
-mkImplicTy :: [TyVar] -> [Inst] -> [Inst] -> Type
-mkImplicTy tvs givens wanteds -- The type of an implication constraint
- = ASSERT( all isAbstractableInst givens )
- -- pprTrace "mkImplicTy" (ppr givens) $
- -- See [Equational Constraints in Implication Constraints]
- let dict_wanteds = filter (not . isEqInst) wanteds
- in
- mkForAllTys tvs $
- mkPhiTy (map dictPred givens) $
- mkBigCoreTupTy (map instType dict_wanteds)
-
-dictPred :: Inst -> TcPredType
-dictPred (Dict {tci_pred = pred}) = pred
-dictPred (EqInst {tci_left=ty1,tci_right=ty2}) = EqPred ty1 ty2
-dictPred inst = pprPanic "dictPred" (ppr inst)
-
-getDictClassTys :: Inst -> (Class, [Type])
-getDictClassTys (Dict {tci_pred = pred}) = getClassPredTys pred
-getDictClassTys inst = pprPanic "getDictClassTys" (ppr inst)
-
--- fdPredsOfInst is used to get predicates that contain functional
--- dependencies *or* might do so. The "might do" part is because
--- a constraint (C a b) might have a superclass with FDs
--- Leaving these in is really important for the call to fdPredsOfInsts
--- in TcSimplify.inferLoop, because the result is fed to 'grow',
--- which is supposed to be conservative
-fdPredsOfInst :: Inst -> [TcPredType]
-fdPredsOfInst (Dict {tci_pred = pred}) = [pred]
-fdPredsOfInst (Method {tci_theta = theta}) = theta
-fdPredsOfInst (ImplicInst {tci_given = gs,
- tci_wanted = ws}) = fdPredsOfInsts (gs ++ ws)
-fdPredsOfInst (LitInst {}) = []
-fdPredsOfInst (EqInst {}) = []
-
-fdPredsOfInsts :: [Inst] -> [PredType]
-fdPredsOfInsts insts = concatMap fdPredsOfInst insts
-
-isInheritableInst :: Inst -> Bool
-isInheritableInst (Dict {tci_pred = pred}) = isInheritablePred pred
-isInheritableInst (Method {tci_theta = theta}) = all isInheritablePred theta
-isInheritableInst _ = True
-
-
----------------------------------
--- Get the implicit parameters mentioned by these Insts
--- NB: the results of these functions are insensitive to zonking
-
-ipNamesOfInsts :: [Inst] -> [Name]
-ipNamesOfInst :: Inst -> [Name]
-ipNamesOfInsts insts = [n | inst <- insts, n <- ipNamesOfInst inst]
-
-ipNamesOfInst (Dict {tci_pred = IParam n _}) = [ipNameName n]
-ipNamesOfInst (Method {tci_theta = theta}) = [ipNameName n | IParam n _ <- theta]
-ipNamesOfInst _ = []
-
----------------------------------
-tyVarsOfInst :: Inst -> TcTyVarSet
-tyVarsOfInst (LitInst {tci_ty = ty}) = tyVarsOfType ty
-tyVarsOfInst (Dict {tci_pred = pred}) = tyVarsOfPred pred
-tyVarsOfInst (Method {tci_oid = id, tci_tys = tys}) = tyVarsOfTypes tys `unionVarSet` varTypeTyVars id
- -- The id might have free type variables; in the case of
- -- locally-overloaded class methods, for example
-tyVarsOfInst (ImplicInst {tci_tyvars = tvs, tci_given = givens, tci_wanted = wanteds})
- = (tyVarsOfInsts givens `unionVarSet` tyVarsOfInsts wanteds)
- `minusVarSet` mkVarSet tvs
- `unionVarSet` unionVarSets (map varTypeTyVars tvs)
- -- Remember the free tyvars of a coercion
-tyVarsOfInst (EqInst {tci_left = ty1, tci_right = ty2}) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
-
-tyVarsOfInsts :: [Inst] -> VarSet
-tyVarsOfInsts insts = foldr (unionVarSet . tyVarsOfInst) emptyVarSet insts
-tyVarsOfLIE :: Bag Inst -> VarSet
-tyVarsOfLIE lie = tyVarsOfInsts (lieToList lie)
-
-
---------------------------
-instToDictBind :: Inst -> LHsExpr TcId -> TcDictBinds
-instToDictBind inst rhs
- = unitBag (L (instSpan inst) (VarBind (instToId inst) rhs))
-
-addInstToDictBind :: TcDictBinds -> Inst -> LHsExpr TcId -> TcDictBinds
-addInstToDictBind binds inst rhs = binds `unionBags` instToDictBind inst rhs
+emitWanteds :: CtOrigin -> TcThetaType -> TcM [EvVar]
+emitWanteds origin theta = mapM (emitWanted origin) theta
+
+emitWanted :: CtOrigin -> TcPredType -> TcM EvVar
+emitWanted origin pred = do { loc <- getCtLoc origin
+ ; ev <- newWantedEvVar pred
+ ; emitConstraint (WcEvVar (WantedEvVar ev loc))
+ ; return ev }
+
+newMethodFromName :: CtOrigin -> Name -> TcRhoType -> TcM (HsExpr TcId)
+-- Used when Name is the wired-in name for a wired-in class method,
+-- so the caller knows its type for sure, which should be of form
+-- forall a. C a => <blah>
+-- newMethodFromName is supposed to instantiate just the outer
+-- type variable and constraint
+
+newMethodFromName origin name inst_ty
+ = do { id <- tcLookupId name
+ -- Use tcLookupId not tcLookupGlobalId; the method is almost
+ -- always a class op, but with -XNoImplicitPrelude GHC is
+ -- meant to find whatever thing is in scope, and that may
+ -- be an ordinary function.
+
+ ; let (tvs, theta, _caller_knows_this) = tcSplitSigmaTy (idType id)
+ (the_tv:rest) = tvs
+ subst = zipOpenTvSubst [the_tv] [inst_ty]
+
+ ; wrap <- ASSERT( null rest && isSingleton theta )
+ instCall origin [inst_ty] (substTheta subst theta)
+ ; return (mkHsWrap wrap (HsVar id)) }