diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2022-01-09 14:04:23 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2022-05-21 22:22:07 +0100 |
| commit | 457c5117f723fd8cf7fe38e7303ee2f31839698f (patch) | |
| tree | 01a87b6465af5efa9b57ed216639e56eab42e781 | |
| parent | a5f049c842a77729e8cf6c29e719cef63c799560 (diff) | |
| download | haskell-wip/joachim/all-classes-lifted.tar.gz | |
matchHasField: HasField dicts are data types nowwip/joachim/all-classes-lifted
| -rw-r--r-- | compiler/GHC/Tc/Instance/Class.hs | 11 |
1 files changed, 4 insertions, 7 deletions
diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs index 5522ddaa38..828bd1fe8b 100644 --- a/compiler/GHC/Tc/Instance/Class.hs +++ b/compiler/GHC/Tc/Instance/Class.hs @@ -717,17 +717,14 @@ matchHasField dflags short_cut clas tys ; let theta = mkPrimEqPred sel_ty (mkVisFunTyMany r_ty a_ty) : preds -- Use the equality proof to cast the selector Id to - -- type (r -> a), then use the newtype coercion to cast - -- it to a HasField dictionary. - mk_ev (ev1:evs) = evSelector sel_id tvs evs `evCast` co + -- type (r -> a), then wrap it in a HasField dictionary. + mk_ev (ev1:evs) = + evDataConApp dc tys [evSelector sel_id tvs evs `Cast` co] where co = mkTcSubCo (evTermCoercion (EvExpr ev1)) - `mkTcTransCo` mkTcSymCo co2 + Just dc = tyConSingleDataCon_maybe (classTyCon clas) mk_ev [] = panic "matchHasField.mk_ev" - Just (_, co2) = tcInstNewTyCon_maybe (classTyCon clas) - tys - tvs = mkTyVarTys (map snd tv_prs) -- The selector must not be "naughty" (i.e. the field |