summaryrefslogtreecommitdiff
path: root/testsuite/tests/stranal/sigs/T18957.hs
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests/stranal/sigs/T18957.hs')
-rw-r--r--testsuite/tests/stranal/sigs/T18957.hs31
1 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/stranal/sigs/T18957.hs b/testsuite/tests/stranal/sigs/T18957.hs
new file mode 100644
index 0000000000..9781b7cd58
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T18957.hs
@@ -0,0 +1,31 @@
+{-# OPTIONS_GHC -O2 -fforce-recomp #-}
+{-# LANGUAGE BangPatterns #-}
+
+-- | This ticket is about demand `seq` puts its first argument under and
+-- how that affects call demands.
+module T18957 where
+
+-- | Should put its first argument under head demand
+seq' :: a -> b -> b
+seq' a b = seq a b
+{-# NOINLINE seq' #-}
+
+-- | The first argument is evaluated at once, but called every time it's
+-- evaluated
+g :: (Int -> Int) -> Int -> Int
+g f x = if x < 100 then f x else 200
+
+-- | The first argument is evaluated multiple times, but called at most once
+-- every time it's evaluated
+h1 :: (Int -> Int) -> Int -> Int
+-- Note that seq' is like seq, but NOINLINE. See h2 below why
+h1 f x = f `seq'` if x < 100 then f x else 200
+
+-- | Like h1, but using `seq` directly, which will rewrite the call site
+-- of @f@ to use the case binder instead, which means we won't evaluate it an
+-- additional time. So evaluated once and called once.
+h2 :: (Int -> Int) -> Int -> Int
+h2 f x = f `seq` if x < 100 then f x else 200
+
+h3 :: (Int -> Int) -> Int -> Int
+h3 f x = if x < 100 then f x + f (x+1) else 200