Curious demand in a function parameter
Ömer Sinan Ağacan
omeragacan at gmail.com
Sun Mar 25 07:14:24 UTC 2018
Hi,
In this program
{-# LANGUAGE MagicHash #-}
module Lib where
import Control.Exception
import GHC.Exts
import GHC.IO
data Err = Err
deriving (Show)
instance Exception Err
f :: Int -> Int -> IO Int
f x y | x > 0 = IO (raiseIO# (toException Err))
| y > 0 = return 1
| otherwise = return 2
when I compile this with 8.4 -O2 I get a strict demand on `y`:
f :: Int -> Int -> IO Int
[GblId,
Arity=3,
Str=<S(S),1*U(U)><S(S),1*U(U)><S,U>,
...]
but clearly `y` is not used on all code paths, so I don't understand why we
have a strict demand here.
I found this example in the comments around `raiseIO#`:
-- raiseIO# needs to be a primop, because exceptions in the IO monad
-- must be *precise* - we don't want the strictness analyser turning
-- one kind of bottom into another, as it is allowed to do in pure code.
--
-- But we *do* want to know that it returns bottom after
-- being applied to two arguments, so that this function is strict in y
-- f x y | x>0 = raiseIO blah
-- | y>0 = return 1
-- | otherwise = return 2
However it doesn't explain why we want be strict on `y`.
Interestingly, when I try to make GHC generate a worker and a wrapper for this
function to make the program fail by evaluating `y` eagerly I somehow got a
lazy demand on `y`:
{-# LANGUAGE MagicHash #-}
module Main where
import Control.Exception
import GHC.Exts
import GHC.IO
data Err = Err
deriving (Show)
instance Exception Err
f :: Int -> Int -> IO Int
f x y | x > 0 = IO (raiseIO# (toException Err))
| y > 0 = f x (y - 1)
| otherwise = f (x - 1) y
main = f 1 undefined
I was thinking that this program should fail with "undefined" instead of "Err",
but the demand I got for `f` became:
f :: Int -> Int -> IO Int
[GblId,
Arity=2,
Str=<S(S),1*U(U)><L,1*U(U)>,
...]
which makes sense to me. But I don't understand how my changes can change `y`s
demand, and why the original demand is strict rather than lazy. Could anyone
give me some pointers?
Thanks
Ömer
More information about the ghc-devs
mailing list