Commit d6ee82b2 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Fix demand analyser for unboxed types

This is a tricky case exposed by Trac #9254.  I'm surprised it hasn't
shown up before, because it's happens when you use unsafePerformIO in
the right way.

Anyway, fixed now.  See Note [Analysing with absent demand]
in Demand.lhs
parent db641808
......@@ -66,7 +66,7 @@ import BasicTypes
import Binary
import Maybes ( orElse )
import Type ( Type )
import Type ( Type, isUnLiftedType )
import TyCon ( isNewTyCon, isClassTyCon )
import DataCon ( splitDataProductType_maybe )
import FastString
......@@ -1201,13 +1201,18 @@ type DeferAndUse -- Describes how to degrade a result type
type DeferAndUseM = Maybe DeferAndUse
-- Nothing <=> absent-ify the result type; it will never be used
toCleanDmd :: Demand -> (CleanDemand, DeferAndUseM)
-- See Note [Analyzing with lazy demand and lambdas]
toCleanDmd (JD { strd = s, absd = u })
toCleanDmd :: Demand -> Type -> (CleanDemand, DeferAndUseM)
toCleanDmd (JD { strd = s, absd = u }) expr_ty
= case (s,u) of
(Str s', Use c u') -> (CD { sd = s', ud = u' }, Just (False, c))
(Lazy, Use c u') -> (CD { sd = HeadStr, ud = u' }, Just (True, c))
(_, Abs) -> (CD { sd = HeadStr, ud = Used }, Nothing)
(Str s', Use c u') -> -- The normal case
(CD { sd = s', ud = u' }, Just (False, c))
(Lazy, Use c u') -> -- See Note [Analyzing with lazy demand and lambdas]
(CD { sd = HeadStr, ud = u' }, Just (True, c))
(_, Abs) -- See Note [Analysing with absent demand]
| isUnLiftedType expr_ty -> (CD { sd = HeadStr, ud = Used }, Just (False, One))
| otherwise -> (CD { sd = HeadStr, ud = Used }, Nothing)
-- This is used in dmdAnalStar when post-processing
-- a function's argument demand. So we only care about what
......@@ -1382,13 +1387,13 @@ cardinality analysis of the following example:
{-# NOINLINE build #-}
build g = (g (:) [], g (:) [])
h c z = build (\x ->
let z1 = z ++ z
h c z = build (\x ->
let z1 = z ++ z
in if c
then \y -> x (y ++ z1)
else \y -> x (z1 ++ y))
One can see that `build` assigns to `g` demand <L,C(C1(U))>.
One can see that `build` assigns to `g` demand <L,C(C1(U))>.
Therefore, when analyzing the lambda `(\x -> ...)`, we
expect each lambda \y -> ... to be annotated as "one-shot"
one. Therefore (\x -> \y -> x (y ++ z)) should be analyzed with a
......@@ -1397,6 +1402,46 @@ demand <C(C(..), C(C1(U))>.
This is achieved by, first, converting the lazy demand L into the
strict S by the second clause of the analysis.
Note [Analysing with absent demand]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we analyse an expression with demand <L,A>. The "A" means
"absent", so this expression will never be needed. What should happen?
There are several wrinkles:
* We *do* want to analyse the expression regardless.
Reason: Note [Always analyse in virgin pass]
But we can post-process the results to ignore all the usage
demands coming back. This is done by postProcessDmdTypeM.
* But in the case of an *unlifted type* we must be extra careful,
because unlifted values are evaluated even if they are not used.
Example (see Trac #9254):
f :: (() -> (# Int#, () #)) -> ()
-- Strictness signature is
-- <C(S(LS)), 1*C1(U(A,1*U()))>
-- I.e. calls k, but discards first component of result
f k = case k () of (# _, r #) -> r
g :: Int -> ()
g y = f (\n -> (# case y of I# y2 -> y2, n #))
Here f's strictness signature says (correctly) that it calls its
argument function and ignores the first component of its result.
This is correct in the sense that it'd be fine to (say) modify the
function so that always returned 0# in the first component.
But in function g, we *will* evaluate the 'case y of ...', because
it has type Int#. So 'y' will be evaluated. So we must record this
usage of 'y', else 'g' will say 'y' is absent, and will w/w so that
'y' is bound to an aBSENT_ERROR thunk.
An alternative would be to replace the 'case y of ...' with (say) 0#,
but I have not tried that. It's not a common situation, but it is
not theoretical: unsafePerformIO's implementation is very very like
'f' above.
%************************************************************************
%* *
Demand signatures
......
......@@ -115,7 +115,7 @@ dmdAnalStar :: AnalEnv
-> Demand -- This one takes a *Demand*
-> CoreExpr -> (BothDmdArg, CoreExpr)
dmdAnalStar env dmd e
| (cd, defer_and_use) <- toCleanDmd dmd
| (cd, defer_and_use) <- toCleanDmd dmd (exprType e)
, (dmd_ty, e') <- dmdAnal env cd e
= (postProcessDmdTypeM defer_and_use dmd_ty, e')
......
{-# LANGUAGE MagicHash, UnboxedTuples #-}
module Main where
import GHC.Exts
f :: (() -> (# Int#, () #)) -> ()
{-# NOINLINE f #-}
-- Strictness signature was (7.8.2)
-- <C(S(LS)), 1*C1(U(A,1*U()))>
-- I.e. calls k, but discards first component of result
f k = case k () of (# _, r #) -> r
g :: Int -> ()
g y = f (\n -> (# case y of I# y2 -> h (h (h (h (h (h (h y2)))))), n #))
-- RHS is big enough to force worker/wrapper
{-# NOINLINE h #-}
h :: Int# -> Int#
h n = n +# 1#
main = print (g 1)
......@@ -7,3 +7,4 @@ test('strun003', normal, compile_and_run, [''])
test('strun004', normal, compile_and_run, [''])
test('T2756b', normal, compile_and_run, [''])
test('T7649', normal, compile_and_run, [''])
test('T9254', normal, compile_and_run, [''])
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