Haskell——使用奇怪的递归类型强制严格求值

Question

我之前问了一个关于如何强制严格求值来创建超时的问题。大多数时候使用seq/$!就足够了，deepseq适用于NFData的任何成员，但是如果我们使用奇怪的递归类型呢?假设我们有以下内容:

import Control.DeepSeq
import Control.Monad.Random
import Data.Maybe
import System.Timeout
newtype A = A { runA :: A -> Int -> Rand StdGen Bool }
-- a call to runA with this as the first input will always terminate
example1 :: A
example1 = A (_ i -> (if i > 0 then getRandomR (True, False) else return False))
-- a call to runA with this as the first input will never terminate
example2 :: A
example2 = A (_ _ -> runA example2 example2 0)
-- here it depends on the other input 
-- will terminate with example1, not with example2 or 3
example3 :: A
example3 = A (a _ -> runA a a 0)

我们是否可以编写一个超时函数来确定当我们调用runA x x 0时，A类型的某个值x是否会在给定的时间内终止?我们可以尝试像这样使用seq:

testTimeout :: A -> IO (Maybe Bool)
testTimeout x = timeout 1000 . evalRandIO $! runA x x 0

然而，这对example2和example3不起作用，因为对runA的调用被计算为WHNF，但随后挂起，因为计算永远不会完成。用deepseq(即$!!)尝试同样的事情甚至不会编译，因为我们需要Rand StdGen Bool的NFData实例。那么，我们如何实现这个实例，使严格的求值/超时按预期工作呢?还是有别的办法?

Answer 1

看来timeout只是在一定的时间内执行动作而没有评估结果。它不计算结果的内部值。没关系。如果我们使用

(>>= (return $!)) :: Monad m => m a -> m a

如您所知，return创建了一个m a类型的值。通过执行return $!，我们说我们不会执行m a，因此完成操作，直到评估结果。下面是一个更详细的函数。

evalM m = do
    result <- m
    result `seq` return result

您也可以使用NFData(这对于Bool来说不是必需的，但如果您使用[a]，则可以这样做)，您可以这样做:

(>>= (return $!!)) :: (Monad m, NFData a) => m a -> m a

更啰嗦地:

forceM m = do
    result <- m
    result `deepseq` return result

Answer 2

嗯。这是一个奇怪的小类型。也许这吗?

instance NFData A where
    rnf (A !runA) = ()
strictify :: A -> A
strictify (A !runA) = A $ a i -> strictify a `deepSeq` i `deepSeq` runA a i
testTimeout x = timeout 1000 . evalRandIO $! runA x' x' 0
 where x' = strictify x

这甚至可能"过于严格"和冗余严格，不确定