diff options
Diffstat (limited to 'compiler/typecheck/TcDeriv.hs')
| -rw-r--r-- | compiler/typecheck/TcDeriv.hs | 20 |
1 files changed, 11 insertions, 9 deletions
diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index fde558100b..da3fee6b3d 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -833,16 +833,18 @@ deriveTyData tvs tc tc_args mb_deriv_strat deriv_pred ; final_inst_ty_kind <- tcTypeKindM (mkTyConApp tc final_tc_args') ; let via_match = tcUnifyTy final_inst_ty_kind final_via_kind - ; checkTc (isJust via_match) $ - derivingViaKindErr cls final_inst_ty_kind - via_ty final_via_kind - - ; let Just via_subst = via_match - (final_tkvs, final_cls_tys, final_tc_args) - = propagate_subst via_subst tkvs' + ; case via_match of + Nothing -> derivingViaKindErr cls final_inst_ty_kind + via_ty final_via_kind + + Just via_subst + -> pure ( final_tkvs, final_cls_tys, final_tc_args + , Just $ ViaStrategy $ substTy via_subst via_ty ) } + where + let (final_tkvs, final_cls_tys, final_tc_args) + = propagate_subst via_subst tkvs' final_cls_tys' final_tc_args' - ; pure ( final_tkvs, final_cls_tys, final_tc_args - , Just $ ViaStrategy $ substTy via_subst via_ty ) } + _ -> pure ( tkvs', final_cls_tys', final_tc_args' , mb_deriv_strat' ) |