Interrupting lengthy pure computation in MonadState

Question

I can't grasp the correct way of interrupting lengthy pure computation on SIGINT signal.

In the simple example below, I have slowFib function that simulates lengthy computation. When it is run just in IO monad I can terminate it with C-c (using async to spawn worker).

However, when I put computation inside MonadState, MonadIO stack it no longer work... On the other hand, simple threadDelay in the same stack still can be terminated.

The code is following:

{-# 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

I suspected that it has something to do with lazy evaluation. I already figured out that in the first example (with just the IO monad) I have to force the result. Otherwise async computation just returns a thunk.

However all my attempts to do something analogous in MonadState failed. Anyway, it seems to be more complicated, since async thread does not return immediately. It waits until the result is computed. For some reason I just cannot terminate it when the pure computation is "blocking".

Any clues?

PS. My use case is too add ability to abort computation in custom Jupyter kernel made using jupyter package. Functions evaluating user input are exactly in MonadState and MonadIO.

score 2 · Accepted Answer · answered Oct 14 '17 at 15:33

2

The computation seems to be blocked on putStrLn $ show r, i.e. outside the interruptable function. Note that stateFib doesn't force the result, so the async exits almost immediately. The whole work is delayed until putStrLn tries to print the result. Try to force the computation earlier:

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

answered Oct 14 '17 at 15:33

Yuras

13,856
1
45
58

Indeed, that do the trick. I just realized that the simple example does not illustrate exact problem I have. In real code, `waitCatch` does not return. I try to reproduce it in simpler example and update the question. – ttylec Oct 14 '17 at 18:50
Ok, it solves my original question, not the original problem. But the latter seems to be related to [jupyter library](https://github.com/gibiansky/jupyter-haskell). For interested, I leave a reference to [issue](https://github.com/gibiansky/jupyter-haskell/issues/2) I submitted there. – ttylec Oct 14 '17 at 19:52
1

Then it means that someone masked async exceptions. Check masking state: https://hackage.haskell.org/package/base-4.10.0.0/docs/Control-Exception.html#v:getMaskingState – Yuras Oct 14 '17 at 20:33

Interrupting lengthy pure computation in MonadState

1 Answers1