statemonad.sml

datatype ('s, 'r) state = S of 's -> ('s * 'r)

infixr $
fun f $ x = f x

fun return v = S (fn s => (s, v))

infix >>=
fun (S sf) >>= f = S (fn s =>
  let
    val (s', r') = sf s
    val S sf'    = f  s
  in
    sf' s'
  end)

val getState = S (fn s => (s, s))
val _ = getState : ('s, 's) state
fun putState v = S (fn s => (v, ()))
val _ = putState : 'b -> ('b, unit) state

fun runState (S sf) = sf
fun evalState s = #2 o runState

local
  fun sum' []      = getState
    | sum' (x::xs) =
        getState >>= (fn a =>
        putState (a+x) >>= (fn _ => sum' xs)
        )
in
  fun sum xs = evalState (sum' xs) 0
end