- (class_tyvars, sc_theta, _, op_items) = classBigSig cls
- cls_tycon = classTyCon cls
- sc_theta' = substTheta (zipOpenTvSubst class_tyvars cls_inst_tys) sc_theta
-
- Just (initial_cls_inst_tys, last_ty) = snocView cls_inst_tys
- (nt_tycon, tc_args) = tcSplitTyConApp last_ty -- Can't fail
- rep_ty = newTyConInstRhs nt_tycon tc_args
-
- rep_pred = mkClassPred cls (initial_cls_inst_tys ++ [rep_ty])
- -- In our example, rep_pred is (Foo Int (Tree [a]))
- the_coercion = make_coercion cls_tycon initial_cls_inst_tys nt_tycon tc_args
- -- Coercion of kind (Foo Int (Tree [a]) ~ Foo Int (N a)
-
- ; inst_loc <- getInstLoc origin
- ; sc_loc <- getInstLoc InstScOrigin
- ; dfun_dicts <- newDictBndrs inst_loc theta
- ; sc_dicts <- newDictBndrs sc_loc sc_theta'
- ; this_dict <- newDictBndr inst_loc (mkClassPred cls cls_inst_tys)
- ; rep_dict <- newDictBndr inst_loc rep_pred
-
- -- Figure out bindings for the superclass context from dfun_dicts
- -- 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_dicts (rep_dict:sc_dicts)
-
- ; let coerced_rep_dict = mkHsWrap the_coercion (HsVar (instToId rep_dict))
-
- ; body <- make_body cls_tycon cls_inst_tys sc_dicts coerced_rep_dict
- ; let dict_bind = noLoc $ VarBind (instToId this_dict) (noLoc body)
-
- ; return (unitBag $ noLoc $
- AbsBinds tvs (map instToVar dfun_dicts)
- [(tvs, dfun_id, instToId this_dict, [])]
- (dict_bind `consBag` sc_binds)) }
+ (class_tyvars, sc_theta, _, _) = classBigSig cls
+ cls_tycon = classTyCon cls
+ sc_theta' = substTheta (zipOpenTvSubst class_tyvars cls_inst_tys) sc_theta
+
+ Just (initial_cls_inst_tys, last_ty) = snocView cls_inst_tys
+ (nt_tycon, tc_args) = tcSplitTyConApp last_ty -- Can't fail
+ rep_ty = newTyConInstRhs nt_tycon tc_args
+
+ rep_pred = mkClassPred cls (initial_cls_inst_tys ++ [rep_ty])
+ -- In our example, rep_pred is (Foo Int (Tree [a]))
+ the_coercion = make_coercion cls_tycon initial_cls_inst_tys nt_tycon tc_args
+ -- Coercion of kind (Foo Int (Tree [a]) ~ Foo Int (N a)
+
+ ; inst_loc <- getInstLoc origin
+ ; sc_loc <- getInstLoc InstScOrigin
+ ; dfun_dicts <- newDictBndrs inst_loc theta
+ ; sc_dicts <- newDictBndrs sc_loc sc_theta'
+ ; this_dict <- newDictBndr inst_loc (mkClassPred cls cls_inst_tys)
+ ; rep_dict <- newDictBndr inst_loc rep_pred
+
+ -- Figure out bindings for the superclass context from dfun_dicts
+ -- 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_dicts (rep_dict:sc_dicts)
+
+ ; let coerced_rep_dict = mkHsWrap the_coercion (HsVar (instToId rep_dict))
+
+ ; body <- make_body cls_tycon cls_inst_tys sc_dicts coerced_rep_dict
+ ; let dict_bind = noLoc $ VarBind (instToId this_dict) (noLoc body)
+
+ ; return (unitBag $ noLoc $
+ AbsBinds tvs (map instToVar dfun_dicts)
+ [(tvs, dfun_id, instToId this_dict, [])]
+ (dict_bind `consBag` sc_binds)) }