Generalizing `unsafeInterleaveIO` to Functions

1

Using unsafeInterleaveIO, you can create data structures that with nondeterminstic side effects. For example, you can use traverse unsafeInterleaveIO :: [IO a] -> IO [a] to create a list where side effects are performed when the list’s elements are evaluated.

However, this has the problem of requiring your data structure to be Traversable and in particular this means you can’t have functions with nondeterministic side effects.

Here’s a generalization of unsafeInterleaveIO, that I discovered, which remedies this issue.

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}

module Interleave where

import GHC.IO (IO (..))

unsafeInterleaveIOF :: (a -> IO b) -> IO (a -> b)
unsafeInterleaveIOF f = IO $ \s ->
  let f' a | IO g <- f a, (# _, x #) <- g s = x
   in (# s, f' #)

unsafeWeakPerformIO :: IO (IO a -> a)
unsafeWeakPerformIO = unsafeInterleaveIOF id

unsafeDupableInterleaveIO :: IO a -> IO a
unsafeDupableInterleaveIO io = (\f -> f ()) <$> unsafeInterleaveIOF (\_ -> io)

Some notes (following from discussion on the Functional Programming Discord) :

  • unsafeInterleaveIOF is as memory safe as unsafeInterleaveIO, as you could implement it by traversing using unsafeInterleaveIO on a memo trie.
  • unsafeWeakPerformIO is a weaker version of unsafePerformIO that doesn’t allow memory corruption. It prevents polymorphic references by being monomorphic.
  • unsafeInterleaveIOF and unsafeWeakPerformIO are equivalent and can be implemented with each other.
2 Likes
2

You could also define unsafeInterleaveIOF in terms of unsafeWeakPerformIO:

{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}

module Interleaving where

import GHC.IO (IO (..))

unsafeWeakPerformIO :: IO (IO a -> a)
unsafeWeakPerformIO =
  IO $ \ s -> let pfm (IO g) = let !(# _, x #) = g s in x
              in (# s, pfm #)

unsafeInterleaveIOF :: (a -> IO b) -> IO (a -> b)
unsafeInterleaveIOF k = fmap (. k) unsafeWeakPerformIO

Furthermore:

unit :: a -> IO a
unit x = fmap (const x) unsafeWeakPerformIO

bind :: IO a -> (a -> IO b) -> IO b
bind m k = fmap bnd unsafeWeakPerformIO
             where
               bnd pfm = let !(Left x)  = pfm (fmap Left m)
                             !(Right y) = pfm (fmap Right (k x))
                         in y

…could something like unsafeWeakPerformIO be that replacement? (albeit with a different name, to avoid confusion e.g. with weak pointers.)

3

So it would seem like can use this to define swap from Composing Monads. This allows you to define a nondetermistic IOT monad transformer:

swap :: (Functor f) => f (IO a) -> IO (f a)
swap functor = do
  run <- unsafeWeakPerformIO
  pure (fmap run functor)

prod :: (Monad m) => m (IO (m a)) -> IO (m a)
prod = fmap join . swap

dorp :: (Functor f) => IO (f (IO a)) -> IO (f a)
dorp = join . fmap swap

newtype IOT m a = IOT {runIOT :: IO (m a)}

instance (Monad m) => Functor (IOT m) where
  fmap = liftM

instance (Monad m) => Applicative (IOT m) where
  pure = IOT . pure . pure
  (<*>) = ap

instance (Monad m) => Monad (IOT m) where
  m >>= f = join' $ fmap f m
    where
      join' :: IOT m (IOT m b) -> IOT m b
      join' m = IOT $ join'' (fmap runIOT <$> runIOT m)
      join'' :: IO (m (IO (m a))) -> IO (m a)
      join'' = fmap join . join . fmap swap

instance MonadTrans IOT where
  lift a = IOT (pure a)

instance (Monad m) => MonadIO (IOT m) where
  liftIO = IOT . fmap pure

At least I hope this a valid monad transformer. I haven’t actually bothered to check the laws.