(let (bind d   = case d of (Monad bind return -> bind))
     (return d = case d of (Monad bind return -> return))

     (get d = case d of (MonadState get put -> get))
     (put d = case d of (MonadState get put -> put))

      -- Id Monad definition
     (idMonad = Monad (\ m f -> case m of (Id a -> f a))
                      (\ a   -> Id a))

     (runId m = case m of (Id a -> a))

     (runStateT s m = case m of (StateT f -> f s))

      -- StateT MonadState instance
in
(let (liftM d f m = bind d m $ \ a -> return d $ f a)

     (mkStateTMonadState d = MonadState (StateT (\ s -> return d $ Tuple s s))
                                        (\ s -> StateT (\ t -> return d $ Tuple (Unit) s)))

     (mkStateTMonad d = Monad (\ m f -> StateT ( \ s ->
                                         bind d (runStateT s m) $ \ r ->
                                         case r of (Tuple a s1 -> runStateT s1 (f a))))
                              (\ a -> StateT ( \ s -> return d (Tuple a s))))
in
(let (stateTidMonad = mkStateTMonad idMonad)
     (stateTidMonadState = mkStateTMonadState idMonad)
in
  runId $ runStateT 4 $ liftM stateTidMonad (add 1) $
  bind stateTidMonad (get stateTidMonadState) $ \ s ->
  bind stateTidMonad (put stateTidMonadState 7) $ \ t ->
  return stateTidMonad s)))