Instantly share code, notes, and snippets.

Embed
What would you like to do?
State Monad
--
-- 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment