Search code examples
haskellfunctional-programmingmonadslazy-evaluationstate-monad

Retrocausality in Haskell: From Tardis to RevState


The following program uses a backwards-traveling state as provided by the Tardis monad.

{-# LANGUAGE RecursiveDo #-}

import Control.Monad.Tardis

lastOccurrence :: Int -> Tardis [Int] () Bool
lastOccurrence x = mdo
  sendPast (x : xs)
  xs <- getFuture
  return (not (elem x xs))

lastOccurrences :: [Int] -> Tardis [Int] () [Bool]
lastOccurrences xs = mapM lastOccurrence xs

main :: IO ()
main =
  print $ flip evalTardis ([], ()) $ lastOccurrences [3,4,6,7,4,3,5,7]

How can I replace the Tardis monad with the reverse State monad? With my following proposal, main loops forever instead of printing [False,False,True,False,True,True,True,True] as with the above program.

{-# LANGUAGE RecursiveDo #-}

import Control.Monad.RevState

lastOccurrence :: Int -> State [Int] Bool
lastOccurrence x = mdo
  put (x : xs)
  xs <- get
  return (not (elem x xs))

lastOccurrences :: [Int] -> State [Int] [Bool]
lastOccurrences xs = mapM lastOccurrence xs

main :: IO ()
main =
  print $ flip evalState [] $ lastOccurrences [3,4,6,7,4,3,5,7]

Solution

  • I have now downloaded the source of both Tardis and RevState, and I started hacking on them until they are almost the same:

    • I ignored everything outside the Trans.{Tarids,RevState} modules, so that I don't have to bother with the typeclasses
    • I removed the forward-propagating state of Tardis
    • I renamed Tardis to State

    After a bit of reordering of code, I ended up in a situation where your Tardis-using example still works and your RevState-using example still doesn't work, and their difference is minimal.

    What is that minimal difference, you ask? Unsurprisingly, the MonadFix instance. Tardis has this:

    instance MonadFix m => MonadFix (TardisT bw fw m) where
      mfix f = TardisT $ \s -> do
        rec (x, s') <- runTardisT (f x) s
        return (x, s')
    

    whereas RevState has this:

    instance MonadFix m => MonadFix (StateT s m) where
      mfix f = StateT $ \s ->
        mfix (\(x, _) -> runStateT (f x) s)
    

    While they seem similar, the big difference is that the RevState one is strict in the tuple constructor, whereas the Tardis one is lazy. (see e.g. the GHC documentation on RecursiveDo to see that the Tardis one desugars into an irrefutable pattern match in the lambda passed to mfix).

    Indeed, changing the implementation of RevState so that

    instance MonadFix m => MonadFix (StateT s m) where
      mfix f = StateT $ \s -> do
        mfix (\ ~(x, _) -> runStateT (f x) s)
    

    fixes your original RevState-using program.