Commit 182ce7e2 authored by simonpj@microsoft.com's avatar simonpj@microsoft.com

Arity and eta-expansion tuning

Roman found that 
    loop :: STRef s a -> Int -> ST s Int
    loop ref n = case n of
                   0 -> return n
                   n -> loop ref (n-1)
wasn't eta-expanding nicely, despite the 'state hack'
(see Id.isStateHackType).  The reason was two-fold:

  a) a bug in CoreUtils.arityType (the Var case)

  b) the arity of a recursive function was not being
	exposed in its RHS (see commments with
	SimplEnv.addLetIdInfo

The commit fixes both.  
parent d4f8ccee
......@@ -475,7 +475,7 @@ idLBVarInfo id = lbvarInfo (idInfo id)
isOneShotBndr :: Id -> Bool
-- This one is the "business end", called externally.
-- Its main purpose is to encapsulate the Horrible State Hack
isOneShotBndr id = isOneShotLambda id || (isStateHackType (idType id))
isOneShotBndr id = isOneShotLambda id || isStateHackType (idType id)
isStateHackType :: Type -> Bool
isStateHackType ty
......
......@@ -822,8 +822,9 @@ arityType (Var v)
-- False -> \(s:RealWorld) -> e
-- where foo has arity 1. Then we want the state hack to
-- apply to foo too, so we can eta expand the case.
mk 0 tys | isBottomingId v = ABot
| otherwise = ATop
mk 0 tys | isBottomingId v = ABot
| (ty:tys) <- tys, isStateHackType ty = AFun True ATop
| otherwise = ATop
mk n (ty:tys) = AFun (isStateHackType ty) (mk (n-1) tys)
mk n [] = AFun False (mk (n-1) [])
......@@ -851,14 +852,14 @@ arityType (App f a) = case arityType f of
-- f x y = case x of { (a,b) -> e }
-- The difference is observable using 'seq'
arityType (Case scrut _ _ alts) = case foldr1 andArityType [arityType rhs | (_,_,rhs) <- alts] of
xs@(AFun one_shot _) | one_shot -> xs
xs | exprIsCheap scrut -> xs
| otherwise -> ATop
xs | exprIsCheap scrut -> xs
xs@(AFun one_shot _) | one_shot -> AFun True ATop
other -> ATop
arityType (Let b e) = case arityType e of
xs@(AFun one_shot _) | one_shot -> xs
xs | all exprIsCheap (rhssOfBind b) -> xs
| otherwise -> ATop
xs@(AFun one_shot _) | one_shot -> AFun True ATop
other -> ATop
arityType other = ATop
......
......@@ -535,19 +535,34 @@ This is important. Manuel found cases where he really, really
wanted a RULE for a recursive function to apply in that function's
own right-hand side.
NB 2: We do not transfer the arity (see Subst.substIdInfo)
The arity of an Id should not be visible
in its own RHS, else we eta-reduce
NB 2: ARITY. We *do* transfer the arity. This is important, so that
the arity of an Id is visible in its own RHS. For example:
f = \x. ....g (\y. f y)....
We can eta-reduce the arg to g, becuase f is a value. But that
needs to be visible.
This interacts with the 'state hack' too:
f :: Bool -> IO Int
f = \x. case x of
True -> f y
False -> \s -> ...
Can we eta-expand f? Only if we see that f has arity 1, and then we
take advantage of the 'state hack' on the result of
(f y) :: State# -> (State#, Int) to expand the arity one more.
There is a disadvantage though. Making the arity visible in the RHA
allows us to eta-reduce
f = \x -> f x
to
f = f
which isn't sound. And it makes the arity in f's IdInfo greater than
the manifest arity, which isn't good.
The arity will get added later.
which technically is not sound. This is very much a corner case, so
I'm not worried about it. Another idea is to ensure that f's arity
never decreases; its arity started as 1, and we should never eta-reduce
below that.
NB 3: It's important that we *do* transer the loop-breaker OccInfo,
because that's what stops the Id getting inlined infinitely, in the body
of the letrec.
NB 3: OccInfo. It's important that we *do* transer the loop-breaker
OccInfo, because that's what stops the Id getting inlined infinitely,
in the body of the letrec.
NB 4: does no harm for non-recursive bindings
......@@ -577,7 +592,7 @@ substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo
-- worker info
-- Zap the unfolding
-- Keep only 'robust' OccInfo
-- Zap Arity
-- arity
--
-- Seq'ing on the returned IdInfo is enough to cause all the
-- substitutions to happen completely
......@@ -585,20 +600,18 @@ substIdInfo :: CoreSubst.Subst -> IdInfo -> Maybe IdInfo
substIdInfo subst info
| nothing_to_do = Nothing
| otherwise = Just (info `setOccInfo` (if keep_occ then old_occ else NoOccInfo)
`setArityInfo` (if keep_arity then old_arity else unknownArity)
`setSpecInfo` CoreSubst.substSpec subst old_rules
`setWorkerInfo` CoreSubst.substWorker subst old_wrkr
`setUnfoldingInfo` noUnfolding)
-- setSpecInfo does a seq
-- setWorkerInfo does a seq
where
nothing_to_do = keep_occ && keep_arity &&
nothing_to_do = keep_occ &&
isEmptySpecInfo old_rules &&
not (workerExists old_wrkr) &&
not (hasUnfolding (unfoldingInfo info))
keep_occ = not (isFragileOcc old_occ)
keep_arity = old_arity == unknownArity
old_arity = arityInfo info
old_occ = occInfo info
old_rules = specInfo info
......
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