gistfile1.hs

{-# LANGUAGE MagicHash, RankNTypes, UnboxedTuples #-}

import GHC.Base

newtype Counter s a = Counter (STRep s a)
type STRep s a = Int# -> (# Int#, a #)

instance Functor (Counter s) where
    fmap f (Counter m) = Counter $ \ s ->
      case (m s) of { (# new_s, r #) ->
      (# new_s, f r #) }

instance Monad (Counter s) where
    {-# INLINE return #-}
    {-# INLINE (>>)   #-}
    {-# INLINE (>>=)  #-}
    return x = Counter (\ s -> (# s, x #))
    m >> k   = m >>= \ _ -> k

    (Counter m) >>= k
      = Counter (\ s ->
        case (m s) of { (# new_s, r #) ->
        case (k r) of { Counter k2 ->
        (k2 new_s) }})

runCounter :: (forall s. Counter s a) -> Int
runCounter st = runSTRep (case st of { Counter st_rep -> st_rep })

runSTRep :: (forall s. STRep s a) -> Int
runSTRep st_rep = case st_rep 0# of
                        (# s#, _ #) -> I# s#

one :: Counter s ()
one = Counter $ \state# ->
    case state# +# 1# of var -> (# var, () #)

ten :: Counter s ()
ten = Counter $ \state# ->
    case state# +# 10# of var -> (# var, () #)

main :: IO ()
main = do
    let value = runCounter $ do
        one
        ten
        one
    putStrLn "run"
    putStrLn $ show value
    putStrLn "stop"