Commit ac38ece1 authored by's avatar
Browse files

Make -fdicts-cheap cope with implication constraints

See the Note [Dictionary-like types] in TcType for the full story here
Should only affect programs that use -fdicts-cheap, for
which you'll get better arities
parent d7b56eff
......@@ -24,6 +24,7 @@ import Var
import VarEnv
import Id
import Type
import TcType ( isDictLikeTy )
import Coercion
import BasicTypes
import Unique
......@@ -293,7 +294,7 @@ arityType dflags (Let b e)
cheap_bind (NonRec b e) = is_cheap (b,e)
cheap_bind (Rec prs) = all is_cheap prs
is_cheap (b,e) = (dopt Opt_DictsCheap dflags && isDictId b)
is_cheap (b,e) = (dopt Opt_DictsCheap dflags && isDictLikeTy (idType b))
|| exprIsCheap e
-- If the experimental -fdicts-cheap flag is on, we eta-expand through
-- dictionary bindings. This improves arities. Thereby, it also
......@@ -311,6 +312,9 @@ arityType dflags (Let b e)
-- One could go further and make exprIsCheap reply True to any
-- dictionary-typed expression, but that's more work.
-- See Note [Dictionary-like types] in TcType.lhs for why we use
-- isDictLikeTy here rather than isDictTy
arityType _ _ = ATop
......@@ -71,7 +71,8 @@ module TcType (
getClassPredTys_maybe, getClassPredTys,
isClassPred, isTyVarClassPred, isEqPred,
mkDictTy, tcSplitPredTy_maybe,
isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
isPredTy, isDictTy, isDictLikeTy,
tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
mkClassPred, isInheritablePred, isIPPred,
dataConsStupidTheta, isRefineableTy, isRefineablePred,
......@@ -894,8 +895,45 @@ isDictTy :: Type -> Bool
isDictTy ty | Just ty' <- tcView ty = isDictTy ty'
isDictTy (PredTy p) = isClassPred p
isDictTy _ = False
isDictLikeTy :: Type -> Bool
-- Note [Dictionary-like types]
isDictLikeTy ty | Just ty' <- tcView ty = isDictTy ty'
isDictLikeTy (PredTy p) = isClassPred p
isDictLikeTy (TyConApp tc tys)
| isTupleTyCon tc = all isDictLikeTy tys
isDictLikeTy _ = False
Note [Dictionary-like types]
Being "dictionary-like" means either a dictionary type or a tuple thereof.
In GHC 6.10 we build implication constraints which construct such tuples,
and if we land up with a binding
t :: (C [a], Eq [a])
t = blah
then we want to treat t as cheap under "-fdicts-cheap" for example.
(Implication constraints are normally inlined, but sadly not if the
occurrence is itself inside an INLINE function! Until we revise the
handling of implication constraints, that is.) This turned out to
be important in getting good arities in DPH code. Example:
class C a
class D a where { foo :: a -> a }
instance C a => D (Maybe a) where { foo x = x }
bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)
{-# INLINE bar #-}
bar x y = (foo (Just x), foo (Just y))
Then 'bar' should jolly well have arity 4 (two dicts, two args), but
we ended up with something like
bar = __inline_me__ (\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...
in \x,y. <blah>)
This is all a bit ad-hoc; eg it relies on knowing that implication
constraints build tuples.
--------------------- Implicit parameters ---------------------------------
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment