module Acme.Peirce (falseVoid, peirce, lem, doubleNeg) where
import System.IO.Unsafe
import Data.Void
import Data.Typeable
import Control.Concurrent.MVar
import Control.Exception
import Prelude hiding (catch)
data ContinueException = ContinueException deriving (Show, Typeable)
instance Exception ContinueException
falseVoid :: Void -> a
falseVoid x = x `seq` undefined
peirce f = unsafePerformIO $ do
mvar <- newEmptyMVar
catch
(return $! f $ \x -> unsafePerformIO $ do
putMVar mvar $! x
throwIO ContinueException)
$ \ContinueException -> tryTakeMVar mvar
>>= maybe (throwIO ContinueException) return
lem :: (a -> b) -> ((a -> Void) -> b) -> b
lem f g = peirce $ \h -> g $ h . f
doubleNeg f = lem id (falseVoid . f)