[Haskell-cafe] Is it possible to make lazy combinators for IO? (Was: (no subject))

Bertram Felgenhauer bertram.felgenhauer at googlemail.com
Mon Apr 25 14:07:05 UTC 2016


David Feuer wrote:
> Spectacular! That looks like just what I wanted! Unless there are some
> hidden gotchas, it might be worth making a package of that.

I can think of one nasty surprise: if liftIO is implemented using
`unsafeIOToST` then it becomes dupable in the `unsafeDupablePerformIO`
sense. It's quite delicate but something along the lines of

    r <- newIORef ""
    replicateM 2 $ forkIO $ <some code polling r>
    runMyIO $ do
        ((), _) <- mfix $ \(x, y) -> do
            x <- liftIO $ writeIORef r y
            y <- getLine
            return (x,y)
        last [1..] `seq` return ()

could trigger the `getLine` operation from different threads
simultaneously. The upshot is that `liftIO` should employ `noDuplicate#`
to prevent this scenario.

Cheers,

Bertram

For reference:
>     newtype MyIO a = MyIO (LST.ST RealWorld a)
>         deriving (Functor, Applicative, Monad, MonadFix)
>
>     instance MonadIO MyIO where
>         liftIO = MyIO . LSTU.unsafeIOToST
>
>     runMyIO :: MyIO a -> IO a
>     runMyIO (MyIO f) = stToIO f
>
>     main = runMyIO $ do
>         l <- (2:) `fmap` liftIO readLn
>         m <- replicateM (head l) (liftIO readLn)
>         liftIO (print (l :: [Int],m :: [Int]))


More information about the Haskell-Cafe mailing list