D924Test.hs

module Main where

import Control.Monad hiding (mapM_)
import Prelude hiding (mapM_)

-- | Testcase derived from Assembler monad in ByteCodeAsm
data Assembler a
  = Thing Int (Int -> Assembler a)
  | Pure a

instance Functor Assembler where
    fmap = liftM

instance Applicative Assembler where
    pure = return
    (<*>) = ap

instance Monad Assembler where
  return = Pure
  Pure x >>= f = f x
  Thing i k >>= f = Thing i (k >=> f)

mapA_ :: (Foldable t, Monad f) => (a -> f b) -> t a -> f ()
mapA_ f = foldr ((*>) . f) (pure ())

mapM_ :: (Foldable t, Monad f) => (a -> f b) -> t a -> f ()
mapM_ f = foldr ((>>) . f) (pure ())

test = map (\i->Thing i (const $ return 2)) [0..10000]

doTestM = mapM_ id test
doTestA = mapA_ id test

run :: Assembler a -> a
run (Thing i f) = run (f i)
run (Pure r) = r
{-# NOINLINE run #-}

main :: IO ()
main = print $ run doTestM