Lecture 15: Concrete Monads: State, I

The State type enables us to build computations that manipulate (hidden) state. I think of this as “elephant in the room” programming, wherein we have a central, ubiquitous data structure that is so important that we can actually clarify our code by hiding it. We will follow our on-going strategy of building a work-alike version of State, as a stepping stone to StateT.

Haskell programmers will often describe Reader and Writer as complementary halves of State, it is a correspondence that's worth keeping in mind.

We define the State type as:

newtype State s a = State { runState :: s -> (a,s) }

The intuition here is that s is the type of the “state” of the computation, a value of which may be used and altered over the course of a sub-computation that produces a value of type a. This is realized through a function that takes a state value as an argument, and which returns a pair consisting of a value of the advertised binding type a, together with the updated state. I find it helpful to think of this diagrammatically:

Our first order of business is to make State s an instance of Functor:

instance Functor (State s) where fmap f ma = State $ \s -> let (a,t) = runState ma s in (f a,t)

Here, the effect of the fmap f is to wrap up the old state transforming function in a new state transforming function that calls the old state transforming function, capturing and adjusting its binding value.

Exercise 15.1 Show that the functor instance above can be re-written as

fmap f ma = State $ (\(a,s) -> (f a,s)) . runState ma

via a sequence of principled transformations. Hint: Think about how the expression let x = e1 in e2 can be written using more basic expressions such as lambdas and function application.

For an extra challenge, it can be further reduced to

instance Functor (State s) where fmap f ma = State $ uncurry ((,) . f) . runState ma

Next up in the type class hierarchy, we make State s an instance of Applicative:

instance Applicative (State s) where pure a = State $ \s -> (a,s) af <*> aa = State $ \s -> let (f,t) = runState af s (a,u) = runState aa t in (f a, u)

This is worth understanding. The pure instance produces a State function that doesn't use or change the state s, just passes it through, while making a available for binding through the first coordinate of the pair. The (<*>) action takes the input state, and obtains the function f and an updated state t, then passes the updated state t to aa, obtaining the argument a and an updated state u, and finally we package up the application f a and the final state u into a pair. It is important to understand that (<*>) specifies an order in which the state is used: left-hand (function) argument first, then the right-hand argument.

We can envision this process diagrammatically as follows:

Exercise 15.2 Show that we can implement pure as pure a = State $ (,) a.

A difficult challenge is to try to simplify the definition of <*> to first eliminate the let construct, and then to eliminate any lambdas. It can be done!

Finally (at least, finally in the first-pass sense), we make State s an instance of Monad:

instance Monad (State s) where ma >>= f = State $ \s -> let (a,t) = runState ma s mb = f a (b,u) = runState mb t in (b,u)

The definition of (>>=) is quite similar in spirit to (<*>). As with (<*>), the state will flow through the expression in left-to-right order. In the case of (>>=), the argument ma is performed first, obtaining a result a and an updated state t, then the function f is applied to a, obtaining another monadic action mb, which is performed passing it the state t, obtaining a result b and a final state u, which are packaged into the result pair (b,u) as before.

*Exercise 15.3 Produce a diagram, analogous to the diagram for (<*>) above, that illustrates how (>>=) works.

*Exercise 15.4 Show that the monad instance above can be re-written as

instance Monad (State s) where ma >>= f = State $ (\(a,s) -> runState (f a) s) . runState ma

via a sequence of principled transformations.

For extra-credit, reduce it to

instance Monad (State s) where ma >>= f = State $ uncurry (runState . f ) . runState ma

To use State effectively, we provide monadic functions that extract, inject, and modify the state, hence,

get :: State s s get = State $ \s -> (s,s) put :: s -> State s () put t = State $ \s -> ((),t) modify :: (s -> s) -> State s () modify f = State $ \s -> ((),f s)

Note that the later two are essentially pure and fmap for the state component of a State s a value, while get simply exposes the state to where is can be extracted via (>>=).

Exercise 15.5 Unsurprisingly, the code transformation fairy isn't entirely satisfied with the definition of put and modify, and proposes

put t = State $ const ((),t) modify f = State $ (,) () . f

Verify the code fairy's work.

But now that we have this toy, what do we do with it? In a typical application, we'll consider State s for some application-specific type s, and we'll use get and put to write application-specific state accessors and mutators.

Example: Turning Haskell into a 1980s era calculator

The Hewlett-Packard corporation made a name for itself by producing high-quality electronic scientific (and later, financial) calculators which thoroughly disrupted the pre-existing economy of scientific calculation built on slide rules. A novel feature of the HP calculators was their use of reverse polish notation (RPN), which involved the use of an operand stack, together with operations that acted on that stack. This had the considerable virtue of simplifying input handling, thereby allowing silicon to be devoted to other tasks, and HP calculators were justly famous for their numerical precision and speed. With an RPN calculator, to add 1 to 2, you'd hit, 1, Enter, 2, and then, finally, +. The more advanced models that started to appear in the 1980's were programmable, in the sense that certain keys could be programmed to execute a sequence of key strokes (possibly involving other programmable keys). With these calculators, the operand stack was arguably the most important abstraction, but paradoxically, it was hidden from view. Our goal is to write code that provides much of the feel of working with these early calculators, and doing so requires that we hide the operand stack.

You can find a javascript simulator of an HP-35 calculator—the very calculator Professor Kurtz purchased used for $100.00 in 1976 when he was an undergraduate.

This particular example will give us the opportunity to focus on the notion of abstraction barriers. These are a software engineering technique whereby we decompose the problem into subproblems, with each sub-solution specifying a well-defined interface that completely determines the ways that other subproblems can interact with it. Haskell's module system provides excellent support for abstraction barriers, as we'll see. Let's start by taking the work that we've just done building the State monad, and encapsulate it in a module called State (in State.hs).

Our next module will be the Calc module (in Calc.hs), in which we'll define (and export) the basic functionality of our calculator. A particular convention of our calculator will be that all of the calculator operations we export will have the form kOperation for some operation.

We'll start by defining the type associated with a simple calculation:

type CalcState = State [Double]

CalcState is intended for internal use, whereas the more restricted

type Calculation = CalcState ()

is intended for exported values.

Next, we define a couple of monadic functions that enable us to push and pop values off of the stack. We can think of these as primitives, built on top of the still more primitive get and put functions:

pop :: CalcState Double pop = do stk <- get case stk of [] -> pure 0.0 x:xs -> do put xs pure x push :: Double -> CalcState () push d = do stk <- get put (d:stk)

Note how our result is pure 0.0 when we have an empty stack. Intuitively, this is equivalent to viewing the stack as being infinitely deep, and filled to the bottom with 0.0's. Standard code transformations can result in surprising concision:

push = modify . (:)

If we think in a somewhat more concrete way about how the State monad works, we can come up with the following much more succinct definition:

pop = state $ \s -> case s of [] -> (0.0,[]) x:xs -> (x,xs)

At first, this feels a bit like both a typographical error and an abstraction barrier violation, but it's neither, because state is a standard part of the State interface:

state :: (s -> (a,s)) -> State s a state = State

The push operation, which we think of as a stack primitive, is actually something we want to export, albeit under a different name:

kEnter :: Double -> Calculation kEnter = push

Next, we provide the basic arithmetic functions:

binOp :: (Double -> Double -> Double) -> CalcState () binOp op = do y <- pop x <- pop push $ op x y kAdd, kSub, kMul, kDiv :: Calculation kAdd = binOp (+) kSub = binOp (-) kMul = binOp (*) kDiv = binOp (/)

Notice how in binOp that if we've pushed the first operand first, that must mean that we'll pop the second operand first. Notice also the preference within a module for using the private push over the exported kEnter. This is not required, but it does reflect differences in how with think about the problem: outside of the abstraction barrier, we use the exported functionality, inside the abstraction barrier, we have unrestricted access to the functions defined at that level (or exported from a lower level still).

Next, we need a little bit of code to allow us to actually run a Calculation.

perform :: Calculation -> Double perform ma = fst $ runState (ma >> pop) []

This is just a bit obscure. It might seem simpler conceptually to do this:

perform ma = head . snd $ runState ms []

The problem we solve with a final pop is that running ma might result in an empty stack, in which case the call to head would raise an exception. A final pop action takes advantage of the error handling we've built into pop, albeit while delivering the intended result as the value bound by performing the action, rather than as the top of the resulting state. We can simplify this a bit further through use of a couple of convenience functions that are a standard part of the State interface:

evalState :: State s a -> s -> a evalState ma s = fst (runState ma s) execState :: State s a -> s -> s execState ma s = snd (runState ma s)

where evalState throws away the final state, evaluating to the final bound value, whereas execState throws away the final bound value (often ()), evaluating to the final stack. With this, we write:

perform :: Calculation -> Double perform ma = evalState (ma >> pop) []

With these, we can begin to write little programs that resemble old-school RPN calculations, e.g., here's how we'd compute (1+2)*3:

test :: Double test = perform $ do kEnter 1 kEnter 2 kAdd kEnter 3 kMul

Now, part of the game in trying to simulate an RPN calculator is to avoid the use of explicit bindings except in the definition of primitives in the Calc module. This is an issue if we want, e.g., to define a hypotenuse macro. The idea here is that hypotenuse should expect two arguments on the stack, and it should pop them off, leaving the hypotenuse of the corresponding right triangle pushed on the stack. To handle this, we introduce a couple of new primitives to Calc:

kSwap :: Calculation kSwap = do y <- pop x <- pop push y push x kDup :: Calculation kDup = do x <- pop push x push x

together with the corresponding updates to Calc's export list. At this point, purists might note that while the HP-35 had a swap key, it didn't have a dup key. That's because the Enter key did the work of both kEnter and kDup, depending on the input state, i.e., it had the effect of kEnter if we'd just typed a number in, and kDup if the last key-stroke was an operation or an Enter.

We're also going to need a square root function. To facilitate this, we'll add a private unOp function:

unOp :: (Double -> Double) -> CalcState () unOp op = do x <- pop push $ op x

and the keystroke function for square root:

kSqrt :: Calculation kSqrt = unOp sqrt

We'll also take this opportunity to add the basic trigonometric functions,

kSin,kCos,kTan :: Calculation kSin = unOp sin kCos = unOp cos kTan = unOp tan

This enables us to define (in the CalcExample module in CalcExample.hs)

square :: Calculation square = do kDup kMul hypotenuse :: Calculation hypotenuse = do square kSwap square kAdd kSqrt

With this in hand, we can compute the hypotenuse of a 3-4-? triangle:

> perform $ kEnter 3 >> kEnter 4 >> hypotenuse 5.0

This is all pretty straightforward, if a bit nerdy, and in Professor Kurtz's case, maybe even a bit maudlin. That HP-35 died decades ago, but oddly enough I still have the slide rule it replaced. There's probably a lesson in that. Life, and computing, go on.

But let's push this a bit further. HP calculators, in addition to the stack, also contained a memory location as a part of their state. Let's suppose we wanted to implement the store and recall functionality. This presents us with a conundrum. How? The answer is going to take us back to Calc, and a more complicated model of the state that's being manipulated:

data InternalState = InternalState { stack :: [Double] , memory :: Double } type CalcState = State InternalState

This is obviously going to break things, but because of the abstraction barriers we've implemented, the breakage is limited to the Calc module, and indeed, because of an internal abstraction barrier within Calc to just the push, pop and perform functions, as they're the only functions that accessed the state directly:

pop :: CalcState Double pop = state $ \st -> case stack st of [] -> (0.0,st) (x:xs) -> (x,st {stack = xs}) push :: Double -> CalcState () push d = modify $ \st -> st { stack = d : stack st } perform :: Calculation -> Double perform ma = evalState (ma >> pop) startState where startState = InternalState { stack = [], memory = 0.0 }

With this, our existing code works, leaving us only to implement access to the memory part of the internal state.

Exercise 15.6 Add implementations of store and recall to the Calc module, along with exported definitions. The store action should copy the top of the stack into memory, while the recall action should push the memory onto the top of the stack.

kSto :: Calculation kSto = store kRcl :: Calculation kRcl = recall

and write an example program that illustrates their use.

Use the modules: