日々の流転

λ. “Asynchronous Exceptions in Haskell” Simon Marlow, Simon Peyton Jones, Andrew Moran and John Reppy

• <URL:http://doi.acm.org/10.1145/378795.378858>
• 著者版

割り込み・メモリ不足・タイムアウトといった、プログラムそのものの意味とは直接関係せずに発生するような例外を非同期的例外という。 非同期的例外は A semantics for imprecise exceptions でも一応扱われていたが、この論文では、非同期的例外の一種として、あるスレッドから別スレッドへの例外の送出を、より積極的にスレッド間のシグナリング機構ととして活用できるようにする。

あるスレッドから別のスレッドを殺したり例外を送出したりというのは、予期しないところで実行が中断することによって不変条件が成り立たなくなってしまう可能性などがあり、手続き型言語では色々悩ましい問題があった。一方、関数型言語では、プログラムの大部分を占める純粋な計算に関してはこのような問題はなく、そのため別スレッドへの例外の送出を積極的に活用しやすい素地がある。

もちろん、IOアクションの実行、特にスレッドの同期に関わる部分では手続き型言語の場合と同じ問題がある。この論文では例外の受け取りを遅延する状態でアクションを実行する block :: IO a -> IO a, 例外を受け取れる状態でアクションを実行する unblock :: IO a -> IO a という関数を利用してそのあたりの問題を扱う。

アクション二つを並行に実行して、どちらか先に結果を返した方を全体の結果にするようなeitherアクション、それからeitherを利用して書かれたtimeoutの実装がかっこよかった。今GHCに合わせると以下のような感じ。

import Prelude hiding (either, catch)
import Control.Exception
import Control.Concurrent

data EitherRet a b = A a | B b | X SomeException

either :: IO a -> IO b -> IO (Either a b)
either a b = do
  m <- newEmptyMVar
  block $ do
    a_id <- forkIO $ catch (do r <- unblock a
                               putMVar m (A r))
                           (\e -> putMVar m (X e))
    b_id <- forkIO $ catch (do r <- unblock b
                               putMVar m (B r))
                           (\e -> putMVar m (X e))
    let loop = catch (takeMVar m)
                     (\e -> do
                        throwTo a_id (e :: SomeException)
                        throwTo b_id e
                        loop)
    r <- loop
    killThread a_id
    killThread b_id
    case r of
      A r -> return (Left r)
      B r -> return (Right r)
      X e -> throwIO e

timeout :: Int -> IO a -> IO (Maybe a)
timeout t a = do
  r <- either (threadDelay t) a
  case r of
    Left _ -> return Nothing
    Right a -> return (Just a)

λ. Project Euler レベル3

Project Euler で100問を解き、レベル3になった。正六面体から正八面体に進化した。 記念すべき100問目は Problem 108 。