- sc_theta' = substTheta (zipOpenTvSubst class_tyvars inst_tys') sc_theta
- (eq_sc_theta',dict_sc_theta') = partition isEqPred sc_theta'
- origin = SigOrigin rigid_info
- (eq_dfun_theta',dict_dfun_theta') = partition isEqPred dfun_theta'
- in
- -- Create dictionary Ids from the specified instance contexts.
- getInstLoc InstScOrigin `thenM` \ sc_loc ->
- newDictBndrs sc_loc dict_sc_theta' `thenM` \ sc_dicts ->
- getInstLoc origin `thenM` \ inst_loc ->
- mkMetaCoVars eq_sc_theta' `thenM` \ sc_covars ->
- mkEqInsts eq_sc_theta' (map mkWantedCo sc_covars) `thenM` \ wanted_sc_eqs ->
- mkCoVars eq_dfun_theta' `thenM` \ dfun_covars ->
- mkEqInsts eq_dfun_theta' (map mkGivenCo $ mkTyVarTys dfun_covars) `thenM` \ dfun_eqs ->
- newDictBndrs inst_loc dict_dfun_theta' `thenM` \ dfun_dicts ->
- newDictBndr inst_loc (mkClassPred clas inst_tys') `thenM` \ this_dict ->
- -- Default-method Ids may be mentioned in synthesised RHSs,
- -- but they'll already be in the environment.
-
- -- Typecheck the methods
- let -- These insts are in scope; quite a few, eh?
- dfun_insts = dfun_eqs ++ dfun_dicts
- wanted_sc_insts = wanted_sc_eqs ++ sc_dicts
- given_sc_eqs = map (updateEqInstCoercion (mkGivenCo . TyVarTy . fromWantedCo "tcInstDecl2") ) wanted_sc_eqs
- given_sc_insts = given_sc_eqs ++ sc_dicts
- avail_insts = [this_dict] ++ dfun_insts ++ given_sc_insts
- in
- tcMethods origin clas inst_tyvars'
- dfun_theta' inst_tys' avail_insts
- op_items monobinds uprags `thenM` \ (meth_ids, meth_binds) ->
-
- -- Figure out bindings for the superclass context
- -- Don't include this_dict in the 'givens', else
- -- wanted_sc_insts get bound by just selecting from this_dict!!
- addErrCtxt superClassCtxt
- (tcSimplifySuperClasses inst_loc
- dfun_insts wanted_sc_insts) `thenM` \ sc_binds ->
-
- -- It's possible that the superclass stuff might unified one
- -- of the inst_tyavars' with something in the envt
- checkSigTyVars inst_tyvars' `thenM_`
-
- -- Deal with 'SPECIALISE instance' pragmas
- tcPrags dfun_id (filter isSpecInstLSig uprags) `thenM` \ prags ->
-
- -- Create the result bindings
+ sc_theta' = substTheta (zipOpenTvSubst class_tyvars inst_tys') sc_theta
+ (eq_sc_theta',dict_sc_theta') = partition isEqPred sc_theta'
+ origin = SigOrigin rigid_info
+ (eq_dfun_theta',dict_dfun_theta') = partition isEqPred dfun_theta'
+
+ -- Create dictionary Ids from the specified instance contexts.
+ sc_loc <- getInstLoc InstScOrigin
+ sc_dicts <- newDictBndrs sc_loc dict_sc_theta'
+ inst_loc <- getInstLoc origin
+ sc_covars <- mkMetaCoVars eq_sc_theta'
+ wanted_sc_eqs <- mkEqInsts eq_sc_theta' (map mkWantedCo sc_covars)
+ dfun_covars <- mkCoVars eq_dfun_theta'
+ dfun_eqs <- mkEqInsts eq_dfun_theta' (map mkGivenCo $ mkTyVarTys dfun_covars)
+ dfun_dicts <- newDictBndrs inst_loc dict_dfun_theta'
+ this_dict <- newDictBndr inst_loc (mkClassPred clas inst_tys')
+ -- Default-method Ids may be mentioned in synthesised RHSs,
+ -- but they'll already be in the environment.
+
+ -- Typecheck the methods
+ let -- These insts are in scope; quite a few, eh?
+ dfun_insts = dfun_eqs ++ dfun_dicts
+ wanted_sc_insts = wanted_sc_eqs ++ sc_dicts
+ given_sc_eqs = map (updateEqInstCoercion (mkGivenCo . TyVarTy . fromWantedCo "tcInstDecl2") ) wanted_sc_eqs
+ given_sc_insts = given_sc_eqs ++ sc_dicts
+ avail_insts = [this_dict] ++ dfun_insts ++ given_sc_insts
+
+ (meth_ids, meth_binds) <- tcMethods origin clas inst_tyvars'
+ dfun_theta' inst_tys' avail_insts
+ op_items monobinds uprags
+
+ -- Figure out bindings for the superclass context
+ -- Don't include this_dict in the 'givens', else
+ -- wanted_sc_insts get bound by just selecting from this_dict!!
+ sc_binds <- addErrCtxt superClassCtxt
+ (tcSimplifySuperClasses inst_loc dfun_insts wanted_sc_insts)
+
+ -- It's possible that the superclass stuff might unified one
+ -- of the inst_tyavars' with something in the envt
+ checkSigTyVars inst_tyvars'
+
+ -- Deal with 'SPECIALISE instance' pragmas
+ prags <- tcPrags dfun_id (filter isSpecInstLSig uprags)
+
+ -- Create the result bindings