Desugaring the State (Transformer) Monad Part III

In this part we will expand the example code.

Expanding countOccurrence (x:xs)

countOccurrence (x:xs) = do
    counter <- get
    if 's' == x then
      put $ counter + 1
    else
      put counter
    countOccurrence xs

-- rewrite of if and else to a case expr as core does also
countOccurrence (x:xs) = do
    counter <- get
    case ('s' == x) of
      True -> put $ counter + 1
      False -> put counter
    countOccurrence xs

-- get rid of the do notation
countOccurrence (x:xs) =
    get >>= \counter -> 
       (case ('s' == x) of
         True -> put $ counter + 1
         False -> put counter) 
             >> countOccurrence xs

-- make dictionaries explicit
countOccurrence (x:xs) =
    >>=
    dMonad
    get $dMonadState
    (\ counter ->
       >>
       $dMonad
       (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)
       countOccurrence xs

-- choose the right implementation dictionary
countOccurrence (x:xs) =
    >>=
    $fMonadStateT
    get $fMonadStateStateT
    (\ counter ->
       >>
       $fMonadStateT
       (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)
       countOccurrence xs

Expanding the >> part

We will expanding this part

>>
  $fMonadStateT
  (case ('s' == x) of
     True -> put $ counter + 1
     False -> put counter)
  countOccurrence xs
-- >> is defined as 
-- m >> k = m >>= (\_ -> k)

    >>=
       $fMonadStateT
       (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)
       (\_ -> countOccurrence xs)

-- inserting of the typeclass implementation
    m = (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)
    k =   (\_ -> countOccurrence xs)

    in 
    StateT $ \ s ->
        (\(a, s') -> runStateT (k a) s') $ runIdentity $ runStateT m s 

-- insert k
    StateT $ \ s ->
        (\(a, s') -> runStateT ((\_ -> countOccurrence xs) a) s') $ runIdentity $ runStateT m s 

-- applying a to (\_ -> countOccurrence xs) results in countOccurrence xs because the _ says that it does not matter what we apply
-- the return will be countOccurrence xs
    StateT $ \ s ->
        (\(a, s') -> runStateT (countOccurrence xs) s') $ runIdentity $ runStateT m s


-- if we are now inserting m then we cant reduce anything so first we inline the put defintions
    m = (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)

    m = (case ('s' == x) of
          True -> StateT $ \_ -> Identity ((), counter+1)
          False -> StateT $ \_ -> Identity ((), counter)
         )



Result of the expanding = R2

     >>
       $fMonadStateT
       (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)
       (\_ -> countOccurrence xs)

-- was rewritten to
    m = (case ('s' == x) of
          True -> StateT (Identity . (\_ -> ((), counter + 1)))
          False -> StateT (Identity . (\_ -> ((), counter)))
         )

    k =   (\_ -> countOccurrence xs)

    in 
    StateT $ \ s ->
        (\(a, s') -> runStateT (k a) s') $ runIdentity $ runStateT m s 



Expanding of >>=

countOccurrence (x:xs) =
    >>=
    $fMonadStateT
    get $fMonadStateStateT
    (\ counter ->
       >>
       $fMonadStateT
       (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)
       countOccurrence xs

m = (get $fMonadStateStateT)

-- insert implementation of get
m = StateT $ \ s -> Identity (s, s)

k = (\ counter ->
       >>
       $fMonadStateT
       (case ('s' == x) of
          True -> put $ counter + 1
          False -> put counter)
       countOccurrence xs


-- from $fMonadStateT we have this bind implementation
m >> k =
  StateT $ \ s ->
           (\(a, s') ->
              runStateT (k a) s') $ runIdentity $ runStateT m s

-- Insert m into definition
 StateT $ \ s ->
    (\(a, s') -> runStateT (k a) s') $ runIdentity $
         runStateT (StateT $ \ s -> Identity (s, s)) s 

-- apply runStateT
 StateT $ \ s ->
    (\(a, s') -> runStateT (k a) s') $ runIdentity $
         (\ s -> Identity (s, s)) s 

-- apply s
 StateT $ \ s ->
    (\(a, s') -> runStateT (k a) s') $ runIdentity $
         (Identity (s, s))

-- apply runIdentity
 StateT $ \ s ->
    (\(a, s') -> runStateT (k a) s') $ (s, s)


-- apply (s, s)

 StateT $ \ s ->
    runStateT (k s) s

Final result of the expanding of countOccurrence (x:xs), here k is the result from R2

 StateT $ \ s ->
    runStateT (k s) s

 where k = 
    let m1 = (case ('s' == x) of
          True -> StateT $ \_ -> Identity ((), counter+1)
          False -> StateT $ \_ -> Identity ((), counter)
         )

    let k1 = \_ -> countOccurrence xs

    in 
    StateT $ \ s ->
        (\(a, s') -> runStateT (k1 a) s') $ runIdentity $ runStateT m1 s 

-- insert k1 and apply a then
 StateT $ \ s ->
    runStateT (k s) s

 where k = 
    let m1 = (case ('s' == x) of
          True -> StateT $ \_ -> Identity ((), counter+1)
          False -> StateT $ \_ -> Identity ((), counter)
         )

    in 
    StateT $ \ s ->
        (\(a, s') -> runStateT (countOccurrence xs) s') $ runIdentity $ runStateT m1 s 

-- to make it more readable we make k and m1 top level functions, so there
-- is a need to pass the counter and x and to k also xs also in their function parameters
m1 :: Char -> OccurrenceState -> StateT OccurrenceState Identity ()
m1 x counter = case ('s' == x) of
          True -> StateT $ \_ -> Identity ((), counter+1)
          False -> StateT $ \_ -> Identity ((), counter)

k :: Char -> String -> OccurrenceState -> StateT OccurrenceState Identity OccurenceValue
k x xs counter = StateT $ \s->
    (\(a, s') -> runStateT (countOccurrence xs) s') $
                    runIdentity $ runStateT (m1 x counter) s  


Expanding countOccurrence []

countOccurrence [] =
  get

-- make dictionary explicit
countOccurrence [] =
  $fMonadStatesStateT get

-- inline get defintion from dict
countOccurrence [] =
  StateT (\s -> Identity (s, s)) 


Final Version of CountOccurrence

countOccurrence :: String -> StateT OccurrenceState Identity OccurenceValue
countOccurrence [] = StateT $ \s -> Identity (s, s)
countOccurrence (x:xs) = StateT $ \s -> runStateT (k x xs s) s

m1 :: Char -> OccurrenceState -> StateT a Identity ()
m1 x counter = case ('s' == x) of
          True -> StateT (Identity . (\_ -> ((), counter + 1)))
          False -> StateT (Identity . (\_ -> ((), counter)))

k :: Char -> String -> OccurrenceState -> StateT OccurrenceState Identity OccurenceValue
k x xs counter = StateT $ \s->
    (\(a, s') -> runStateT (countOccurrence xs) s') $
                    runIdentity $ runStateT (m1 x counter) s  



Expanding main

main = print $ evalState (countOccurrence "s") 0

-- insert the definiton of evalState m s = fst (runState m s)
main = print $ fst (runState (countOccurrence "s") 0)

-- insert the definition of runState m = runIdentity . runStateT m
main = print $ fst ((runIdentity . runStateT (countOccurrence "s")) 0)

Final expanded version

module Main where

import Control.Monad.State.Strict (StateT(..))
import Data.Functor.Identity (Identity(..))

type OccurrenceValue = Int
type OccurrenceState = Int


countOccurrence :: String -> StateT OccurrenceState Identity OccurenceValue
countOccurrence [] = StateT $ \s -> Identity (s, s)
countOccurrence (x:xs) = StateT $ \s -> runStateT (k x xs s) s

m1 :: Char -> OccurrenceState -> StateT a Identity ()
m1 x counter = case ('s' == x) of
          True -> StateT $ \_ -> Identity ((), counter+1)
          False -> StateT $ \_ -> Identity ((), counter)

k :: Char -> String -> OccurrenceState -> StateT OccurrenceState Identity OccurenceValue
k x xs counter = StateT $ \s->
    (\(a, s') -> runStateT (countOccurrence xs) s') $
                    runIdentity $ runStateT (m1 x counter) s  


main = print $ fst ((runIdentity . runStateT (countOccurrence "s")) 0)

Leave a Reply

Your email address will not be published. Required fields are marked *