Commit 26acb498 authored by Joachim Breitner's avatar Joachim Breitner

More demand analyser test cases

catching mistakes that I had during my refactoring, and which I do not
want to do again.
parent cabf0b4e
module BottomFromInnerLambda where
expensive :: Int -> Int
expensive 0 = 0
expensive n = expensive n
{-# NOINLINE expensive #-}
-- We could be saying "<S(S),1*(U(U))><L,A>b"
-- but we are saying "<S(S),1*(U(U))>"
-- We should not be saying "<S(S),1*(U(U))>b"
f :: Int -> Int -> Int
f x = expensive x `seq` (\y -> error (show y))
==================== Strictness signatures ====================
BottomFromInnerLambda.expensive: <S(S),1*U(U)>m
BottomFromInnerLambda.f: <S(S),1*U(U)>
{-# LANGUAGE GADTs #-}
module DmdAnalGADTs where
-- This tests the effect of different types in branches of a case
data D a where
A :: D Int
B :: D (Int -> Int)
hasCPR :: Int
hasCPR = 1
hasStrSig :: Int -> Int
hasStrSig x = x
diverges :: Int
diverges = diverges
-- The result should not have a CPR property
-- Becuase we are lub’ing "m" and "<S,U>m" in the case expression.
f :: D x -> x
f x = case x of
A -> hasCPR
B -> hasStrSig
-- This should have the CPR property
f' :: D Int -> Int
f' x = case x of
A -> hasCPR
-- The result should not be diverging, because one branch is terminating.
-- It should also put a strict, but not hyperstrict demand on x
g :: D x -> x
g x = case x of
A -> diverges
B -> \_ -> diverges
==================== Strictness signatures ====================
DmdAnalGADTs.diverges: b
DmdAnalGADTs.f: <S,1*U>
DmdAnalGADTs.f': <S,1*U>m
DmdAnalGADTs.g: <S,1*U>
DmdAnalGADTs.hasCPR: m
DmdAnalGADTs.hasStrSig: <S,1*U(U)>m
......@@ -24,6 +24,17 @@ g :: Int -> Int
g x = let f' = f x
in h f'
g2 :: Int -> Int
g2 x = let f' = f x
-- Should not get a bottom result
g' :: Int -> Int
g' x = let f' = f x
in h2 True f'
h3 :: (Int -> Int -> Int) -> Int
h3 f = f 2 `seq` 3
{-# NOINLINE h3 #-}
-- And here we check that the depth of the strictness
-- of h is applied correctly.
g3 :: Int -> Int
g3 x = h3 (\_ _ -> error (show x))
......@@ -2,8 +2,10 @@
==================== Strictness signatures ====================
UnsatFun.f: <B,1*U(U)><B,A>b
UnsatFun.g: <B,1*U(U)>b
UnsatFun.g2: <L,1*U(U)>
UnsatFun.g': <L,1*U(U)>
UnsatFun.g3: <L,U(U)>m
UnsatFun.h: <C(S),1*C1(U(U))>
UnsatFun.h2: <S,1*U><L,1*C1(U(U))>
UnsatFun.h3: <C(S),1*C1(U)>m
......@@ -13,3 +13,5 @@ test('HyperStrUse', normal, compile, [''])
test('T8598', normal, compile, [''])
test('FacState', expect_broken(1600), compile, [''])
test('UnsatFun', normal, compile, [''])
test('BottomFromInnerLambda', normal, compile, [''])
test('DmdAnalGADTs', 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