StrictAndLazyMonadFix.hs

-- This code will run into an infinite loop when the strict state
-- monad is used while it terminates just fine for the lazy state
-- monad. In particular monadic binds in the strict state monad cannot
-- depend on values defined later while this is possible in the lazy
-- state monad.
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import Control.Monad.Fix
import Control.Monad.State.Class
import qualified Control.Monad.State.Lazy as Lazy
import qualified Control.Monad.State.Strict as Strict

data Instr
  = Call String
  | Dummy
  deriving Show

{- strict version -}
newtype Builder a = Builder { unBuilder :: Strict.State [(String, Instr)] a }
  deriving (Functor, Applicative, Monad, MonadFix, MonadState [(String, Instr)])

runBuilder :: Builder a -> [(String, Instr)]
runBuilder (Builder a) = Strict.execState a []
--}

{- lazy version -
newtype Builder a = Builder { unBuilder :: Lazy.State [(String, Instr)] a }
  deriving (Functor, Applicative, Monad, MonadFix, MonadState [(String, Instr)])

runBuilder :: Builder a -> [(String, Instr)]
runBuilder (Builder a) = Lazy.execState a []
--}

emitInstr :: (String, Instr) -> Builder String
emitInstr (n, i) = do
  modify (\instrs -> instrs ++ [(n, i)])
  pure n

call :: String -> String -> Builder String
call caller callee = do
  let instr = Call callee
  case callee of
    !a -> do
      modify (\instrs -> instrs ++ [(caller, instr)])
      pure caller

dummy :: String -> Builder String
dummy n = do
  modify (\instrs -> instrs ++ [(n, Dummy)])
  pure n

example :: Builder ()
example = mdo
  _ <- call "call" foo
  foo <- dummy "foo"
  pure ()

main :: IO ()
main = print (runBuilder example)