diff options
| author | Joachim Breitner <mail@joachim-breitner.de> | 2022-01-02 20:43:16 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simon.peytonjones@gmail.com> | 2022-05-21 22:22:06 +0100 |
| commit | 23e9a6748c8227ef18d2e12d6cb2b908b54cc397 (patch) | |
| tree | a3a54cc1f94bf11c1c3d58b77b83cd73891002b2 | |
| parent | 668dcbf4c4a10e653bb152fdd2246feee4f8f8db (diff) | |
| download | haskell-23e9a6748c8227ef18d2e12d6cb2b908b54cc397.tar.gz | |
Let withDict add a datatype
| -rw-r--r-- | compiler/GHC/HsToCore/Expr.hs | 8 |
1 files changed, 4 insertions, 4 deletions
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs index 6b8ced95ad..12d0b246f9 100644 --- a/compiler/GHC/HsToCore/Expr.hs +++ b/compiler/GHC/HsToCore/Expr.hs @@ -44,8 +44,8 @@ import GHC.Tc.Types.Evidence import GHC.Tc.Utils.Monad import GHC.Core.Type import GHC.Core.TyCo.Rep +import GHC.Core.TyCon import GHC.Core.Multiplicity -import GHC.Core.Coercion( instNewTyCon_maybe, mkSymCo ) import GHC.Core import GHC.Core.Utils import GHC.Core.Make @@ -1139,13 +1139,13 @@ ds_withDict wrapped_ty -- `class C a_1 ... a_n where op :: meth_ty`, where -- `meth_tvs = a_1 ... a_n` and `co` is a newtype coercion between -- `C` and `meth_ty`. - , Just (inst_meth_ty, co) <- instNewTyCon_maybe dict_tc dict_args - -- co :: C t1 ..tn ~R# st + , Just dc <- tyConSingleDataCon_maybe dict_tc + , ([], _, [inst_meth_ty]) <- dataConInstSig dc dict_args -- Check that `st` is equal to `meth_ty[t_i/a_i]`. , st `eqType` inst_meth_ty = do { sv <- newSysLocalDs mult1 st ; k <- newSysLocalDs mult2 dt_to_r - ; let wd_rhs = mkLams [sv, k] $ Var k `App` Cast (Var sv) (mkSymCo co) + ; let wd_rhs = mkLams [sv, k] $ Var k `App` (mkConApp2 dc dict_args [sv]) ; wd_id <- newSysLocalDs Many (exprType wd_rhs) ; let wd_id' = wd_id `setInlinePragma` inlineAfterSpecialiser ; pure $ Let (NonRec wd_id' wd_rhs) (Var wd_id') } |