在MonadState中中断冗长的纯计算

时间:2017-10-14 14:54:53

标签: haskell concurrency signals monad-transformers state-monad

我无法掌握在SIGINT信号上中断冗长的纯计算的正确方法。

在下面的简单示例中,我有slowFib函数模拟冗长的计算。当它在IO monad中运行时,我可以用C-c终止它(使用异步生成工作者)。

但是,当我将计算放在MonadState, MonadIO堆栈中时,它不再起作用......另一方面,同一堆栈中的简单threadDelay仍然可以终止。

代码如下:

{-# LANGUAGE FlexibleContexts #-}
module Main where

import Data.Monoid

import Control.DeepSeq
import Control.Concurrent
import Control.Concurrent.Async

import Control.Monad.State
-- import Control.Monad.State.Strict

import System.Posix.Signals

slowFib :: Integer -> Integer
slowFib 0 = 0
slowFib 1 = 1
slowFib n = slowFib (n - 2 ) + slowFib (n - 1)

data St = St { x :: Integer } deriving (Show)

stateFib :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateFib n = do
  let f = slowFib n
  modify $ \st -> st{x=f}
  return f

stateWait :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateWait n = do
  liftIO $ threadDelay 5000000
  return 41

interruptable n act = do
  putStrLn $ "STARTING EVALUATION: " <> n
  e <- async act
  installHandler sigINT (Catch (cancel e)) Nothing
  putStrLn "WAITING FOR RESULT"
  waitCatch e

main = do
  let s0 = St 0

  r <- interruptable "slowFib" $ do
    let f = slowFib 41
    f `deepseq` return ()
    return f

  r <- interruptable "threadDelay in StateT" $ runStateT (stateWait 41) s0
  putStrLn $ show r

  r <- interruptable "slowFib in StateT" $ runStateT (stateFib 41) s0
  putStrLn $ show r

我怀疑它与懒惰评估有关。我已经发现在第一个例子中(只有IO monad)我必须强制结果。否则,异步计算只会返回一个thunk。

然而,我在MonadState中做类似事情的尝试都失败了。无论如何,它似乎更复杂,因为异步线程不会立即返回。它等待直到计算结果。出于某种原因,当纯计算“阻塞”时,我无法终止它。

任何线索?

PS。我的用例是添加使用jupyter包制作的自定义Jupyter内核中止计算的能力。评估用户输入的函数完全在MonadStateMonadIO

1 个答案:

答案 0 :(得分:2)

计算似乎在putStrLn $ show r上被阻止,即在interruptable函数之外。请注意,stateFib不会强制显示结果,因此async几乎立即退出。整个工作推迟到putStrLn尝试打印结果。尝试更早地强制计算:

stateFib :: (MonadState St m, MonadIO m) => Integer -> m Integer
stateFib n = do
  let f = slowFib n
  modify $ \st -> st{x=f}
  f `seq` return f