+ n_normal_tvs = length tvs
+ ex_tvs' = drop n_normal_tvs all_tvs'
+ result_ty = mkTyConApp tycon (take n_normal_tvs ty_args')
+ in
+ newDicts orig stupid_theta' `thenM` \ stupid_dicts ->
+ newDicts orig ex_theta' `thenM` \ ex_dicts ->
+
+ -- Note that we return the stupid theta *only* in the LIE;
+ -- we don't otherwise use it at all
+ extendLIEs stupid_dicts `thenM_`
+
+ returnM (ty_args', ex_dicts, arg_tys', result_ty, ex_tvs')
+
+newMethodFromName :: InstOrigin -> TcType -> Name -> TcM TcId
+newMethodFromName origin ty name
+ = tcLookupId name `thenM` \ id ->
+ -- Use tcLookupId not tcLookupGlobalId; the method is almost
+ -- always a class op, but with -fno-implicit-prelude GHC is
+ -- meant to find whatever thing is in scope, and that may
+ -- be an ordinary function.
+ getInstLoc origin `thenM` \ loc ->
+ tcInstClassOp loc id [ty] `thenM` \ inst ->
+ extendLIE inst `thenM_`
+ returnM (instToId inst)
+
+newMethodWithGivenTy orig id tys theta tau
+ = getInstLoc orig `thenM` \ loc ->
+ newMethod loc id tys theta tau `thenM` \ inst ->
+ extendLIE inst `thenM_`
+ returnM (instToId inst)
+
+--------------------------------------------
+-- tcInstClassOp, and newMethod do *not* drop the
+-- Inst into the LIE; they just returns the Inst
+-- This is important because they are used by TcSimplify
+-- to simplify Insts
+
+tcInstClassOp :: InstLoc -> Id -> [TcType] -> TcM Inst
+tcInstClassOp inst_loc sel_id tys
+ = let
+ (tyvars,rho) = tcSplitForAllTys (idType sel_id)
+ rho_ty = ASSERT( length tyvars == length tys )
+ substTyWith tyvars tys rho
+ (preds,tau) = tcSplitPhiTy rho_ty
+ in
+ newMethod inst_loc sel_id tys preds tau