FoldrFromFoldl.hs

{-# language ScopedTypeVariables, RankNTypes, BlockArguments, TypeApplications,
    LambdaCase #-}

module Lib
    ( foldr
    ) where

import           Data.Foldable (foldl')
import           Prelude       hiding (foldr)

import Control.Concurrent.MVar
import Control.Concurrent
import System.IO.Unsafe

forEach :: Foldable t => t a -> (a -> IO ()) -> IO ()
forEach ta f =
  foldl' (\b a -> seq (unsafeDupablePerformIO (f a)) b) (pure ()) ta

foldr :: forall t a b. Foldable t => (a -> b -> b) -> b -> t a -> b
foldr f b ta = unsafeDupablePerformIO do
  elems  <- newEmptyMVar @(Maybe a)
  next   <- newEmptyMVar @()

  forkIO do
    forEach ta \a -> putMVar elems (Just a) >> takeMVar next
    putMVar elems Nothing

  let loop f b = takeMVar elems >>= \case
        Nothing -> pure b
        Just a  -> do
          b' <- unsafeInterleaveIO (putMVar next () >> loop f b)
          pure (f a b')

  loop f b

The outermost unsafeDupablePerformIO looks fine, as does the one in the producer thread. But the one in loop looks shady. f could fork multiple threads, each of which force b'.

So I think you should NOINLINE b' and use unsafePerformIO to calculate it.

Or just use unsafeInterleaveIO there, actually...

I agree it wasn't thread-safe. Didn't need impure f for that though, it would've been enough to share a toList result between threads.