Commit 70f93c99 authored by Sebastian Graf's avatar Sebastian Graf

Compute demand signatures assuming idArity

This does four things:

1. Look at `idArity` instead of manifest lambdas to decide whether to use LetUp
2. Compute the strictness signature in LetDown assuming at least `idArity`
   incoming arguments
3. Remove the special case for trivial RHSs, which is subsumed by 2
4. Don't perform the W/W split when doing so would eta expand a binding.
   Otherwise we would eta expand PAPs, causing unnecessary churn in the
   Simplifier.

NoFib Results

--------------------------------------------------------------------------------
        Program         Allocs    Instrs
--------------------------------------------------------------------------------
 fannkuch-redux          +0.3%      0.0%
             gg          -0.0%     -0.1%
       maillist          +0.2%     +0.2%
        minimax           0.0%     +0.8%
        reptile          -0.0%     -1.2%
            scc           0.0%     -0.1%
--------------------------------------------------------------------------------
            Min          -0.0%     -1.2%
            Max          +0.3%     +0.8%
 Geometric Mean          +0.0%     -0.0%
parent 3423664b
......@@ -22,7 +22,7 @@ module Demand (
DmdType(..), dmdTypeDepth, lubDmdType, bothDmdType,
nopDmdType, botDmdType, mkDmdType,
addDemand, removeDmdTyArgs,
addDemand, ensureArgs,
BothDmdArg, mkBothDmdArg, toBothDmdArg,
DmdEnv, emptyDmdEnv,
......@@ -34,7 +34,7 @@ module Demand (
vanillaCprProdRes, cprSumRes,
appIsBottom, isBottomingSig, pprIfaceStrictSig,
trimCPRInfo, returnsCPR_maybe,
StrictSig(..), mkStrictSig, mkClosedStrictSig,
StrictSig(..), mkStrictSigForArity, mkClosedStrictSig,
nopSig, botSig, cprProdSig,
isTopSig, hasDemandEnvSig,
splitStrictSig, strictSigDmdEnv,
......@@ -47,7 +47,7 @@ module Demand (
deferAfterIO,
postProcessUnsat, postProcessDmdType,
splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd,
splitProdDmd_maybe, peelCallDmd, peelManyCalls, mkCallDmd, mkCallDmds,
mkWorkerDemand, dmdTransformSig, dmdTransformDataConSig,
dmdTransformDictSelSig, argOneShots, argsOneShots, saturatedByOneShots,
trimToType, TypeShape(..),
......@@ -675,10 +675,15 @@ mkProdDmd dx
= JD { sd = mkSProd $ map getStrDmd dx
, ud = mkUProd $ map getUseDmd dx }
-- | Wraps the 'CleanDemand' with a one-shot call demand: @d@ -> @C1(d)@.
mkCallDmd :: CleanDemand -> CleanDemand
mkCallDmd (JD {sd = d, ud = u})
= JD { sd = mkSCall d, ud = mkUCall One u }
-- | @mkCallDmds n d@ returns @C1(C1...(C1 d))@ where there are @n@ @C1@'s.
mkCallDmds :: Arity -> CleanDemand -> CleanDemand
mkCallDmds arity cd = iterate mkCallDmd cd !! arity
-- See Note [Demand on the worker] in WorkWrap
mkWorkerDemand :: Int -> Demand
mkWorkerDemand n = JD { sd = Lazy, ud = Use One (go n) }
......@@ -1207,12 +1212,8 @@ mkDmdType fv ds res = DmdType fv ds res
dmdTypeDepth :: DmdType -> Arity
dmdTypeDepth (DmdType _ ds _) = length ds
-- Remove any demand on arguments. This is used in dmdAnalRhs on the body
removeDmdTyArgs :: DmdType -> DmdType
removeDmdTyArgs = ensureArgs 0
-- This makes sure we can use the demand type with n arguments,
-- It extends the argument list with the correct resTypeArgDmd
-- | This makes sure we can use the demand type with n arguments.
-- It extends the argument list with the correct resTypeArgDmd.
-- It also adjusts the DmdResult: Divergence survives additional arguments,
-- CPR information does not (and definite converge also would not).
ensureArgs :: Arity -> DmdType -> DmdType
......@@ -1567,8 +1568,34 @@ and <L,U(U,U)> on the second, then returning a constructor.
If this same function is applied to one arg, all we can say is that it
uses x with <L,U>, and its arg with demand <L,U>.
Note [Understanding DmdType and StrictSig]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Demand types are sound approximations of an expression's semantics relative to
the incoming demand we put the expression under. Its depth may be lower or
higher than the arity of the call demand that elicited that DmdType. This
happens for anonymous lambdas and in dmdTransform, for example.
In contrast, a demand signature summarises a function's semantics. Despite it
(StrSig) being a newtype wrapper around DmdType, it actually encodes two things:
* The threshold (i.e., minimum arity) to unleash the signature
* A demand type that is sound to unleash when the minimum arity requirement is
met.
Here comes the subtle part: The threshold is encoded in the wrapped demand
type's depth! So in mkStrictSigForArity we make sure to trim the list of
argument demands to the given threshold arity. Call sites will make sure that
this corresponds to the arity of the call demand that elicited the wrapped
demand type. See also Note [What are demand signatures?] in DmdAnal.
Besides trimming argument demands, mkStrictSigForArity will also trim CPR
information if necessary.
-}
-- | The depth of the wrapped 'DmdType' encodes the arity at which it is safe
-- to unleash. Better construct this through 'mkStrictSigForArity'.
-- See Note [Understanding DmdType and StrictSig]
newtype StrictSig = StrictSig DmdType
deriving( Eq )
......@@ -1580,34 +1607,43 @@ pprIfaceStrictSig :: StrictSig -> SDoc
pprIfaceStrictSig (StrictSig (DmdType _ dmds res))
= hcat (map ppr dmds) <> ppr res
mkStrictSig :: DmdType -> StrictSig
mkStrictSig dmd_ty = StrictSig dmd_ty
-- | Turns a 'DmdType' computed for the particular 'Arity' into a 'StrictSig'
-- unleashable at that arity. See Note [Understanding DmdType and StrictSig]
mkStrictSigForArity :: Arity -> DmdType -> StrictSig
mkStrictSigForArity arity dmd_ty = StrictSig (ensureArgs arity dmd_ty)
mkClosedStrictSig :: [Demand] -> DmdResult -> StrictSig
mkClosedStrictSig ds res = mkStrictSig (DmdType emptyDmdEnv ds res)
mkClosedStrictSig ds res = mkStrictSigForArity (length ds) (DmdType emptyDmdEnv ds res)
splitStrictSig :: StrictSig -> ([Demand], DmdResult)
splitStrictSig (StrictSig (DmdType _ dmds res)) = (dmds, res)
increaseStrictSigArity :: Int -> StrictSig -> StrictSig
-- Add extra arguments to a strictness signature
-- ^ Add extra arguments to a strictness signature.
-- In contrast to 'etaExpandStrictSig', this /prepends/ additional argument
-- demands and leaves CPR info intact.
increaseStrictSigArity arity_increase sig@(StrictSig dmd_ty@(DmdType env dmds res))
| isTopDmdType dmd_ty = sig
| arity_increase <= 0 = sig
| arity_increase == 0 = sig
| arity_increase < 0 = WARN( True, text "increaseStrictSigArity:"
<+> text "negative arity increase"
<+> ppr arity_increase )
nopSig
| otherwise = StrictSig (DmdType env dmds' res)
where
dmds' = replicate arity_increase topDmd ++ dmds
etaExpandStrictSig :: Arity -> StrictSig -> StrictSig
-- We are expanding (\x y. e) to (\x y z. e z)
-- Add exta demands to the /end/ of the arg demands if necessary
etaExpandStrictSig arity sig@(StrictSig dmd_ty@(DmdType env dmds res))
| isTopDmdType dmd_ty = sig
| arity_increase <= 0 = sig
| otherwise = StrictSig (DmdType env dmds' res)
where
arity_increase = arity - length dmds
dmds' = dmds ++ replicate arity_increase topDmd
-- ^ We are expanding (\x y. e) to (\x y z. e z).
-- In contrast to 'increaseStrictSigArity', this /appends/ extra arg demands if
-- necessary, potentially destroying the signature's CPR property.
etaExpandStrictSig arity (StrictSig dmd_ty)
| arity < dmdTypeDepth dmd_ty
-- an arity decrease must zap the whole signature, because it was possibly
-- computed for a higher incoming call demand.
= nopSig
| otherwise
= StrictSig $ ensureArgs arity dmd_ty
isTopSig :: StrictSig -> Bool
isTopSig (StrictSig ty) = isTopDmdType ty
......
......@@ -668,6 +668,7 @@ isBottomingId v
| isId v = isBottomingSig (idStrictness v)
| otherwise = False
-- | Accesses the 'Id''s 'strictnessInfo'.
idStrictness :: Id -> StrictSig
idStrictness id = strictnessInfo (idInfo id)
......
......@@ -237,22 +237,34 @@ pprIdDetails other = brackets (pp other)
-- too big.
data IdInfo
= IdInfo {
arityInfo :: !ArityInfo, -- ^ 'Id' arity
ruleInfo :: RuleInfo, -- ^ Specialisations of the 'Id's function which exist
-- See Note [Specialisations and RULES in IdInfo]
unfoldingInfo :: Unfolding, -- ^ The 'Id's unfolding
cafInfo :: CafInfo, -- ^ 'Id' CAF info
oneShotInfo :: OneShotInfo, -- ^ Info about a lambda-bound variable, if the 'Id' is one
inlinePragInfo :: InlinePragma, -- ^ Any inline pragma atached to the 'Id'
occInfo :: OccInfo, -- ^ How the 'Id' occurs in the program
strictnessInfo :: StrictSig, -- ^ A strictness signature
demandInfo :: Demand, -- ^ ID demand information
callArityInfo :: !ArityInfo, -- ^ How this is called.
-- n <=> all calls have at least n arguments
levityInfo :: LevityInfo -- ^ when applied, will this Id ever have a levity-polymorphic type?
arityInfo :: !ArityInfo,
-- ^ 'Id' arity, as computed by 'CoreArity'. Specifies how many
-- arguments this 'Id' has to be applied to before it doesn any
-- meaningful work.
ruleInfo :: RuleInfo,
-- ^ Specialisations of the 'Id's function which exist.
-- See Note [Specialisations and RULES in IdInfo]
unfoldingInfo :: Unfolding,
-- ^ The 'Id's unfolding
cafInfo :: CafInfo,
-- ^ 'Id' CAF info
oneShotInfo :: OneShotInfo,
-- ^ Info about a lambda-bound variable, if the 'Id' is one
inlinePragInfo :: InlinePragma,
-- ^ Any inline pragma atached to the 'Id'
occInfo :: OccInfo,
-- ^ How the 'Id' occurs in the program
strictnessInfo :: StrictSig,
-- ^ A strictness signature. Digests how a function uses its arguments
-- if applied to at least 'arityInfo' arguments.
demandInfo :: Demand,
-- ^ ID demand information
callArityInfo :: !ArityInfo,
-- ^ How this is called. This is the number of arguments to which a
-- binding can be eta-expanded without losing any sharing.
-- n <=> all calls have at least n arguments
levityInfo :: LevityInfo
-- ^ when applied, will this Id ever have a levity-polymorphic type?
}
-- Setters
......
......@@ -700,6 +700,8 @@ setIdNotExported id = ASSERT( isLocalId id )
************************************************************************
-}
-- | Is this a type-level (i.e., computationally irrelevant, thus erasable)
-- variable? Satisfies @isTyVar = not . isId@.
isTyVar :: Var -> Bool -- True of both TyVar and TcTyVar
isTyVar (TyVar {}) = True
isTyVar (TcTyVar {}) = True
......@@ -712,17 +714,21 @@ isTcTyVar _ = False
isTyCoVar :: Var -> Bool
isTyCoVar v = isTyVar v || isCoVar v
-- | Is this a value-level (i.e., computationally relevant) 'Id'entifier?
-- Satisfies @isId = not . isTyVar@.
isId :: Var -> Bool
isId (Id {}) = True
isId _ = False
-- | Is this a coercion variable?
-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@.
isCoVar :: Var -> Bool
-- A coercion variable
isCoVar (Id { id_details = details }) = isCoVarDetails details
isCoVar _ = False
-- | Is this a term variable ('Id') that is /not/ a coercion variable?
-- Satisfies @'isId' v ==> 'isCoVar' v == not ('isNonCoVarId' v)@.
isNonCoVarId :: Var -> Bool
-- A term variable (Id) that is /not/ a coercion variable
isNonCoVarId (Id { id_details = details }) = not (isCoVarDetails details)
isNonCoVarId _ = False
......
......@@ -158,7 +158,7 @@ exprBotStrictness_maybe e
{-
Note [exprArity invariant]
~~~~~~~~~~~~~~~~~~~~~~~~~~
exprArity has the following invariant:
exprArity has the following invariants:
(1) If typeArity (exprType e) = n,
then manifestArity (etaExpand e n) = n
......
......@@ -570,15 +570,9 @@ lintSingleBinding top_lvl_flag rec_flag (binder,rhs)
(addWarnL (text "INLINE binder is (non-rule) loop breaker:" <+> ppr binder))
-- Only non-rule loop breakers inhibit inlining
-- Check whether arity and demand type are consistent (only if demand analysis
-- already happened)
--
-- Note (Apr 2014): this is actually ok. See Note [Demand analysis for trivial right-hand sides]
-- in DmdAnal. After eta-expansion in CorePrep the rhs is no longer trivial.
-- ; let dmdTy = idStrictness binder
-- ; checkL (case dmdTy of
-- StrictSig dmd_ty -> idArity binder >= dmdTypeDepth dmd_ty || exprIsTrivial rhs)
-- (mkArityMsg binder)
-- We used to check that the dmdTypeDepth of a demand signature never
-- exceeds idArity, but that is an unnecessary complication, see
-- Note [idArity varies independently of dmdTypeDepth] in DmdAnal
-- Check that the binder's arity is within the bounds imposed by
-- the type and the strictness signature. See Note [exprArity invariant]
......@@ -2562,20 +2556,6 @@ mkKindErrMsg tyvar arg_ty
hang (text "Arg type:")
4 (ppr arg_ty <+> dcolon <+> ppr (typeKind arg_ty))]
{- Not needed now
mkArityMsg :: Id -> MsgDoc
mkArityMsg binder
= vcat [hsep [text "Demand type has",
ppr (dmdTypeDepth dmd_ty),
text "arguments, rhs has",
ppr (idArity binder),
text "arguments,",
ppr binder],
hsep [text "Binder's strictness signature:", ppr dmd_ty]
]
where (StrictSig dmd_ty) = idStrictness binder
-}
mkCastErr :: CoreExpr -> Coercion -> Type -> Type -> MsgDoc
mkCastErr expr = mk_cast_err "expression" "type" (ppr expr)
......
......@@ -1149,15 +1149,15 @@ certainlyWillInline dflags fn_info
-- INLINABLE functions come via this path
-- See Note [certainlyWillInline: INLINABLE]
do_cunf expr (UnfIfGoodArgs { ug_size = size, ug_args = args })
| not (null args) -- See Note [certainlyWillInline: be careful of thunks]
| arityInfo fn_info > 0 -- See Note [certainlyWillInline: be careful of thunks]
, not (isBottomingSig (strictnessInfo fn_info))
-- Do not unconditionally inline a bottoming functions even if
-- it seems smallish. We've carefully lifted it out to top level,
-- so we don't want to re-inline it.
, let arity = length args
, size - (10 * (arity + 1)) <= ufUseThreshold dflags
, let unf_arity = length args
, size - (10 * (unf_arity + 1)) <= ufUseThreshold dflags
= Just (fn_unf { uf_src = InlineStable
, uf_guidance = UnfWhen { ug_arity = arity
, uf_guidance = UnfWhen { ug_arity = unf_arity
, ug_unsat_ok = unSaturatedOk
, ug_boring_ok = inlineBoringOk expr } })
-- Note the "unsaturatedOk". A function like f = \ab. a
......@@ -1175,6 +1175,17 @@ found that the WorkWrap phase thought that
y = case x of F# v -> F# (v +# v)
was certainlyWillInline, so the addition got duplicated.
Note that we check arityInfo instead of the arity of the unfolding to detect
this case. This is so that we don't accidentally fail to inline small partial
applications, like `f = g 42` (where `g` recurses into `f`) where g has arity 2
(say). Here there is no risk of work duplication, and the RHS is tiny, so
certainlyWillInline should return True. But `unf_arity` is zero! However f's
arity, gotten from `arityInfo fn_info`, is 1.
Failing to say that `f` will inline forces W/W to generate a potentially huge
worker for f that will immediately cancel with `g`'s wrapper anyway, causing
unnecessary churn in the Simplifier while arriving at the same result.
Note [certainlyWillInline: INLINABLE]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
certainlyWillInline /must/ return Nothing for a large INLINABLE thing,
......
......@@ -21,7 +21,7 @@ module SimplMonad (
import GhcPrelude
import Var ( Var, isTyVar, mkLocalVar )
import Var ( Var, isId, mkLocalVar )
import Name ( mkSystemVarName )
import Id ( Id, mkSysLocalOrCoVar )
import IdInfo ( IdDetails(..), vanillaIdInfo, setArityInfo )
......@@ -187,7 +187,8 @@ newJoinId bndrs body_ty
= do { uniq <- getUniqueM
; let name = mkSystemVarName uniq (fsLit "$j")
join_id_ty = mkLamTypes bndrs body_ty -- Note [Funky mkLamTypes]
arity = length (filter (not . isTyVar) bndrs)
-- Note [idArity for join points] in SimplUtils
arity = length (filter isId bndrs)
join_arity = length bndrs
details = JoinId join_arity
id_info = vanillaIdInfo `setArityInfo` arity
......
......@@ -1508,7 +1508,7 @@ tryEtaExpandRhs :: SimplMode -> OutId -> OutExpr
-> SimplM (Arity, Bool, OutExpr)
-- See Note [Eta-expanding at let bindings]
-- If tryEtaExpandRhs rhs = (n, is_bot, rhs') then
-- (a) rhs' has manifest arity
-- (a) rhs' has manifest arity n
-- (b) if is_bot is True then rhs' applied to n args is guaranteed bottom
tryEtaExpandRhs mode bndr rhs
| Just join_arity <- isJoinId_maybe bndr
......@@ -1517,6 +1517,7 @@ tryEtaExpandRhs mode bndr rhs
-- Note [Do not eta-expand join points]
-- But do return the correct arity and bottom-ness, because
-- these are used to set the bndr's IdInfo (#15517)
-- Note [idArity for join points]
| otherwise
= do { (new_arity, is_bot, new_rhs) <- try_expand
......@@ -1610,6 +1611,12 @@ CorePrep comes around, the code is very likely to look more like this:
$j2 = if n > 0 then $j1
else (...) eta
Note [idArity for join points]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Because of Note [Do not eta-expand join points] we have it that the idArity
of a join point is always (less than or) equal to the join arity.
Essentially, for join points we set `idArity $j = count isId join_lam_bndrs`.
Note [Do not eta-expand PAPs]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We used to have old_arity = manifestArity rhs, which meant that we
......
This diff is collapsed.
......@@ -9,6 +9,7 @@ module WorkWrap ( wwTopBinds ) where
import GhcPrelude
import CoreArity ( manifestArity )
import CoreSyn
import CoreUnfold ( certainlyWillInline, mkWwInlineRule, mkWorkerUnfolding )
import CoreUtils ( exprType, exprIsHNF )
......@@ -457,7 +458,7 @@ tryWW dflags fam_envs is_rec fn_id rhs
-- See Note [Don't w/w INLINE things]
-- See Note [Don't w/w inline small non-loop-breaker things]
| is_fun
| is_fun && is_eta_exp
= splitFun dflags fam_envs new_fn_id fn_info wrap_dmds res_info rhs
| is_thunk -- See Note [Thunk splitting]
......@@ -474,9 +475,11 @@ tryWW dflags fam_envs is_rec fn_id rhs
-- See Note [Zapping DmdEnv after Demand Analyzer] and
-- See Note [Zapping Used Once info in WorkWrap]
is_fun = notNull wrap_dmds || isJoinId fn_id
is_thunk = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id)
&& not (isUnliftedType (idType fn_id))
is_fun = notNull wrap_dmds || isJoinId fn_id
-- See Note [Don't eta expand in w/w]
is_eta_exp = length wrap_dmds == manifestArity rhs
is_thunk = not is_fun && not (exprIsHNF rhs) && not (isJoinId fn_id)
&& not (isUnliftedType (idType fn_id))
{-
Note [Zapping DmdEnv after Demand Analyzer]
......@@ -516,6 +519,30 @@ want to _keep_ the info for the code generator).
We do not do it in the demand analyser for the same reasons outlined in
Note [Zapping DmdEnv after Demand Analyzer] above.
Note [Don't eta expand in w/w]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A binding where the manifestArity of the RHS is less than idArity of the binder
means CoreArity didn't eta expand that binding. When this happens, it does so
for a reason (see Note [exprArity invariant] in CoreArity) and we probably have
a PAP, cast or trivial expression as RHS.
Performing the worker/wrapper split will implicitly eta-expand the binding to
idArity, overriding CoreArity's decision. Other than playing fast and loose with
divergence, it's also broken for newtypes:
f = (\xy.blah) |> co
where
co :: (Int -> Int -> Char) ~ T
Then idArity is 2 (despite the type T), and it can have a StrictSig based on a
threshold of 2. But we can't w/w it without a type error.
The situation is less grave for PAPs, but the implicit eta expansion caused a
compiler allocation regression in T15164, where huge recursive instance method
groups, mostly consisting of PAPs, got w/w'd. This caused great churn in the
simplifier, when simply waiting for the PAPs to inline arrived at the same
output program.
-}
......
......@@ -134,7 +134,7 @@ mkWwBodies :: DynFlags
-- wrap_fn_str E = case x of { (a,b) ->
-- case a of { (a1,a2) ->
-- E a1 a2 b y }}
-- work_fn_str E = \a2 a2 b y ->
-- work_fn_str E = \a1 a2 b y ->
-- let a = (a1,a2) in
-- let x = (a,b) in
-- E
......
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
module WWRec where
class Rule f a where
get :: Decorator f => f a
class Monad f => Decorator f where
foo :: Rule f a => f a
data A1 = MkA1 A2
data A2 = MkA2 A3
data A3 = MkA3 A4
data A4 = MkA4 A5
data A5 = MkA5 A6
data A6 = MkA6 A7
data A7 = MkA7 A8
data A8 = MkA8 A9
data A9 = MkA9 A10
data A10 = MkA10 A11
data A11 = MkA11 A12
data A12 = MkA12 A13
data A13 = MkA13 A14
data A14 = MkA14 A15
data A15 = MkA15 A16
data A16 = MkA16 A17
data A17 = MkA17 A18
data A18 = MkA18 A19
data A19 = MkA19 A20
data A20 = MkA20 A21
data A21 = MkA21 A22
data A22 = MkA22 A23
data A23 = MkA23 A24
data A24 = MkA24 A25
data A25 = MkA25 A26
data A26 = MkA26 A27
data A27 = MkA27 A28
data A28 = MkA28 A29
data A29 = MkA29 A30
data A30 = MkA30 A1
instance Rule f A2 => Rule f A1 where get = MkA1 <$> foo
instance Rule f A3 => Rule f A2 where get = MkA2 <$> foo
instance Rule f A4 => Rule f A3 where get = MkA3 <$> foo
instance Rule f A5 => Rule f A4 where get = MkA4 <$> foo
instance Rule f A6 => Rule f A5 where get = MkA5 <$> foo
instance Rule f A7 => Rule f A6 where get = MkA6 <$> foo
instance Rule f A8 => Rule f A7 where get = MkA7 <$> foo
instance Rule f A9 => Rule f A8 where get = MkA8 <$> foo
instance Rule f A10 => Rule f A9 where get = MkA9 <$> foo
instance Rule f A11 => Rule f A10 where get = MkA10 <$> foo
instance Rule f A12 => Rule f A11 where get = MkA11 <$> foo
instance Rule f A13 => Rule f A12 where get = MkA12 <$> foo
instance Rule f A14 => Rule f A13 where get = MkA13 <$> foo
instance Rule f A15 => Rule f A14 where get = MkA14 <$> foo
instance Rule f A16 => Rule f A15 where get = MkA15 <$> foo
instance Rule f A17 => Rule f A16 where get = MkA16 <$> foo
instance Rule f A18 => Rule f A17 where get = MkA17 <$> foo
instance Rule f A19 => Rule f A18 where get = MkA18 <$> foo
instance Rule f A20 => Rule f A19 where get = MkA19 <$> foo
instance Rule f A21 => Rule f A20 where get = MkA20 <$> foo
instance Rule f A22 => Rule f A21 where get = MkA21 <$> foo
instance Rule f A23 => Rule f A22 where get = MkA22 <$> foo
instance Rule f A24 => Rule f A23 where get = MkA23 <$> foo
instance Rule f A25 => Rule f A24 where get = MkA24 <$> foo
instance Rule f A26 => Rule f A25 where get = MkA25 <$> foo
instance Rule f A27 => Rule f A26 where get = MkA26 <$> foo
instance Rule f A28 => Rule f A27 where get = MkA27 <$> foo
instance Rule f A29 => Rule f A28 where get = MkA28 <$> foo
instance Rule f A30 => Rule f A29 where get = MkA29 <$> foo
instance Rule f A1 => Rule f A30 where get = MkA30 <$> foo
......@@ -393,6 +393,13 @@ test ('T15164',
compile,
['-v0 -O'])
# See https://gitlab.haskell.org/ghc/ghc/merge_requests/312#note_186960
test ('WWRec',
[ collect_compiler_stats('bytes allocated',10)
],
compile,
['-v0 -O'])
test('T16190',
[ collect_stats(),
when(opsys('mingw32'), expect_broken(16389))
......
-- | 't' and 't2' should have a strictness signature for arity 2 here.
module Test where
newtype T = MkT (Int -> Int -> Int)
t :: T
t = MkT (\a b -> a + b)
t2 :: T
t2 = MkT (+)
==================== Strictness signatures ====================
Test.$tc'MkT: m
Test.$tcT: m
Test.$trModule: m
Test.t: <S,1*U(U)><S,1*U(U)>m
Test.t2: <S,1*U(U)><S,1*U(U)>m
==================== Strictness signatures ====================
Test.$tc'MkT: m
Test.$tcT: m
Test.$trModule: m
Test.t: <S,1*U(U)><S,1*U(U)>m
Test.t2: <S,1*U(U)><S,1*U(U)>m
......@@ -17,3 +17,4 @@ test('BottomFromInnerLambda', normal, compile, [''])
test('DmdAnalGADTs', normal, compile, [''])
test('T12370', normal, compile, [''])
test('CaseBinderCPR', normal, compile, [''])
test('NewtypeArity', normal, compile, [''])
Markdown is supported
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