+ 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
+ -- Instantiate the specified class op, but *only* with the main
+ -- class dictionary. For example, given 'op' defined thus:
+ -- class Foo a where
+ -- op :: (?x :: String) => a -> a
+ -- (tcInstClassOp op T) should return an Inst with type
+ -- (?x :: String) => T -> T
+ -- That is, the class-op's context is still there.
+ -- This is really important in the use of tcInstClassOp in TcClassDcls.mkMethodBind
+tcInstClassOp inst_loc sel_id tys
+ = let
+ (tyvars,rho) = tcSplitForAllTys (idType sel_id)
+ rho_ty = substTyWith tyvars tys rho
+ (pred,tau) = tcSplitMethodTy rho_ty
+ -- Split off exactly one predicate (see the example above)
+ in
+ ASSERT( isClassPred pred )
+ newMethod inst_loc sel_id tys [pred] tau