diff options
| author | simonpj@microsoft.com <unknown> | 2010-05-31 14:53:32 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2010-05-31 14:53:32 +0000 |
| commit | a90dc3907a491bfb478262441534b24fb0eb22f4 (patch) | |
| tree | f9039d34eb246f0d51a2e04475806a25188408bf /compiler/iface | |
| parent | 470ff37b766d27ed4c62cf31e37c576105a19bc4 (diff) | |
| download | haskell-a90dc3907a491bfb478262441534b24fb0eb22f4.tar.gz | |
Robustify the treatement of DFunUnfolding
See Note [DFun unfoldings] in CoreSyn. The issue here is that
you can't tell how many dictionary arguments a DFun needs just
from looking at the Arity of the DFun Id: if the dictionary is
represented by a newtype the arity might include the dictionary
and value arguments of the (single) method.
So we need to record the number of arguments need by the DFun
in the DFunUnfolding itself. Details in
Note [DFun unfoldings] in CoreSyn
Diffstat (limited to 'compiler/iface')
| -rw-r--r-- | compiler/iface/MkIface.lhs | 2 | ||||
| -rw-r--r-- | compiler/iface/TcIface.lhs | 4 |
2 files changed, 2 insertions, 4 deletions
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 07b1268164..5c236b306f 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1545,7 +1545,7 @@ toIfUnfolding lb unf@(CoreUnfolding { uf_tmpl = rhs, uf_arity = arity -- have stuck in NoUnfolding. For supercompilation we want -- to see that unfolding! -toIfUnfolding lb (DFunUnfolding _con ops) +toIfUnfolding lb (DFunUnfolding _ar _con ops) = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops))) -- No need to serialise the data constructor; -- we can recover it from the type of the dfun diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index d8bd414edd..1f846d37fb 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -1053,11 +1053,9 @@ tcUnfolding name dfun_ty _ (IfDFunUnfold ops) = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops ; return (case mb_ops1 of Nothing -> noUnfolding - Just ops1 -> DFunUnfolding data_con ops1) } + Just ops1 -> mkDFunUnfolding dfun_ty ops1) } where doc = text "Class ops for dfun" <+> ppr name - (_, cls, _) = tcSplitDFunTy dfun_ty - data_con = classDataCon cls \end{code} For unfoldings we try to do the job lazily, so that we never type check |