State Monad

gistfile1.hs

--
-- Excerpt from Monads for functional programming
-- http://homepages.inf.ed.ac.uk/wadler/papers/marktoberdorf/baastad.pdf
--

-- 2.1 Variation zero: The basic evaluator 
--
data Term = Con Int | Div Term Term

eval :: Term -> Int
eval (Con a) = a
eval (Div t v) = div (eval t) (eval v)

answer :: Term
answer = Div (Div (Con 1972) (Con 2)) (Con 23)

err :: Term
err = Div (Con 1) (Con 0)

-- 2.3 Variation two: State
--

type M a = State -> (a, State)
type State = Int

eval1 :: Term -> M Int
eval1 (Con a) x = (a, x)
eval1 (Div t v) x = let (a, y) = eval1 t x in
                    let (b, z) = eval1 v y in
                    (div a b, z+1)
-- eval1 :: Term -> M Int
--          Term -> State -> (a, State)  (by def.  M Int = State -> (a, State) )

-- 2.8 Variation two, revisited: State
--

unit :: a -> M a
unit a = λx -> (a, x)

bind :: M a -> (a -> M b) -> M b
bind m k = λx -> let (a, y) = m x in
                 let (b, z) = k a y in
                 (b, z)

tick :: M ()
tick = λx -> ((), x+1)

eval2 :: Term -> M Int
eval2 (Con a) = unit a
eval2 (Div t v) = (eval2 t) `bind` λa -> eval2 v `bind` λb -> unit (div a b)

eval2' :: Term -> M Int
eval2' (Con a) = unit a
eval2' (Div t v) = (eval2' t) `bind` λa -> eval2' v `bind` λb -> (tick `bind` λx -> unit (div a b))

-- ex)
-- eval2' Div (Con 10) (Con 5)
-- 
-- A `bind` B `bind` C `bind` D
--
-- ** C `bind` D PART ***********************************************
-- 
-- tick `bind \x -> unit (div a b)
-- \y -> ((), y+1) `bind` \x -> unit (div a b)
-- \z ->               = (\y -> ((), y+1)) z
--                     = (\z -> ((), y+1))  
--                     = (((), z+1))  
--       let ((), z+1) =
--                     = (\x -> unit (div a b)) () z+1 
--                     = (() -> unit (div a b)) z+1
--                     = (unit (div a b)) z+1
--                     = (\w -> ((div a b), w) z+1
--                     = ((div a b), z+1)
--       let (div a b,  z+1)
-- \z -> (div a b, z+1)
--
-- ** A `bind` B PART ***********************************************
--
-- eval2' (Con 10) `bind` \a -> eval2' (Con 5)
-- unit 10 `bind` \a -> eval2' (Con 5)
-- \x -> (10, x) `bind` \a -> (\y -> (5, y))
-- \z ->               = (\x -> (10, x)) z
--                     = (10, z)
--       let (10, z)
--                     = \a -> (\y -> (5, y)) 10 z
--                     = [a = 10] (\y -> (5, y) z
--                     = [a = 10] (5, z)
-- [a=10] \z -> (5, z)
-- 
-- ** [A `bind` B PART] `bind` [C `bind` D PART] *********************
--
-- [a=10] \z -> (5, z) `bind` \b -> (\z' -> (div a b, z'+1)) 
-- \z -> (5, z) `bind` \b -> (\z' -> (div 10 b, z'+1)) 
-- \z'' ->            = \z -> (5, z) z''
--                    = (5, z'')
--         let (5, z'')
--                    = \b -> (\z' -> (div 10 b , z'+1)) 5 z''
--                    = \z' -> (div 10 5, z'+1 ) z''
--                    = (div 10 5, z''+1)
-- \z'' -> (div a 5, z''+1)
--
-- (\z'' -> (2, z''+1) ) ZERO
-- (2,1)