Consider how stateful computations could be expressed in a pure functional language like Haskell. We will use a mutable stack as an example, but we'll see later that the same ideas generalize to any sort of mutable state.
A stack is a simple data structure used extensively to model imperative computation.
It is an ordered collection of values where all modifications happen at one end of the collection.
In Java, for example, a Stack<E> is accessed/manipulated with the following two methods:
E pop(): Removes the object at the top of this stack and returns that objectvoid push(E item): Pushes an item onto the top of this stack. (I lied a little; this method actually returnsitem, but that isn't necessary.)
We will model a stack in Haskell as a list.
The first element in the list will be the top of the stack, since a list grows by cons-ing elements onto its front.
For simplicity, let's assume we are dealing with stacks of Ints.
type Stack = [Int]If we literally translated the signatures of the methods from Stack<Integer>, they would look something like:
pop :: Stack -> Int
push :: Int -> Stack -> () -- "()" is the equivalent of "void" in a functional languageIf we try implementing functions that match these types we will immediately notice a problem:
pop (x : xs) = x -- how do we indicate that the stack was modified?
push x xs =
let newStack = x : xs
in () -- again, this signature doesn't allow us to modify the stackThe problem we encounter with both functions is that an imperative language like Java allows push() and pop() to have the side effect of modifying the stack, but this is not allowed in a pure functional language like Haskell.
If we want to modify the stack, it must explicitly be returned from the function:
pop :: Stack -> Maybe (Int, Stack)
pop [] = Nothing -- we could throw an error instead of using Maybe, but this is safer
pop (x : xs) = Just (x, xs)
-- More consisely,
pop = uncons
push :: Int -> Stack -> Stack
push x xs = x : xs
-- More concisely,
push = (:)It turns out that stacks are very useful for modeling many sorts of imperative computations. (Intuitively, imperative programs often compute intermediate values and then combine them together. A stack allows us to perform computations on values at the top of the stack, while saving earlier results underneath for later use.) All modern imperative languages use a stack to model function calls. In some imperative languages, like Java Bytecode and WebAssembly, all instructions interact with the stack. For example, consider the following Java code:
int a = 1, b = 2, c;
c = a + b;This is translated into the following bytecode instructions:
0: iconst_1 // load the constant 1 onto the stack
1: istore_1 // pop from the stack and store into a
2: iconst_2 // load the constant 2 onto the stack
3: istore_2 // pop from the stack and store into b
4: iload_1 // push the value of a onto the stack
5: iload_2 // push the value of b onto the stack
6: iadd // pop two elements from the stack, add them, and push the result
7: istore_3 // pop from the stack and store into c
We will implement a simple stack-machine language. Here are the instructions:
data Instruction
-- Add the top two ints on the stack
= Add
-- Subtract the top two ints on the stack (in the order they were pushed)
| Sub
-- Multiply the top two ints on the stack
| Mul
-- Divide the top two ints on the stack (in the order they were pushed)
| Div
-- Pop the top two ints from the stack; push 1 if they are equal, 0 if not
| Eq
-- Pop the top two ints from the stack.
-- Push 1 if the one on the bottom is less than the one on top, 0 if not.
| Lt
-- Push a constant int value to the stack
| Const Int
-- Run a list of instructions in sequence
| Block [Instruction]
-- Pop an int from the stack.
-- Run the first instruction if it is nonzero, or the second if it is 0.
-- Note that an if body can have 0 or multiple instructions if it is a Block.
| If Instruction Instruction
-- Run the first instruction and pop an int from the stack.
-- If it is 0, finish.
-- Otherwise, run the second instruction and evaluate the While instruction again.
-- Note that the condition or body can have 0 or multiple instructions if it is a Block.
| While Instruction InstructionLet's write an evaluator for the Add instruction.
It takes a stack and returns a new stack with the top two ints added together.
If the stack has fewer than two ints, it fails.
addOp :: Stack -> Maybe Stack
addOp s =
case pop s of
Nothing -> Nothing
Just (a, s') ->
case pop s' of
Nothing -> Nothing
Just (b, s'') -> Just $ push (a + b) s''Hopefully, this seems unnecessarily complicated to you.
After each pop, we need to check whether it succeeded and avoid running the rest of the operations if it failed.
Each operation also creates a new stack that we need to pass to the next operation.
It is easy to accidentally pass the wrong stack, since they all have the same type.
One thing to notice is that pop, push x, and addOp can be generalized to a StackOp type.
A StackOp a evaluates to an a in the context of a stack and may update the stack.
It can also fail, e.g. when trying to pop from an empty stack.
newtype StackOp a = StackOp (Stack -> Maybe (a, Stack))
pop :: StackOp Int
pop = StackOp uncons
push :: Int -> StackOp () -- we use () as a placeholder since push doesn't compute a value
push x = StackOp $ \stack -> Just ((), x : stack)This StackOp type is an instance of the more general Monad typeclass.
A Monad type is defined by two functions:
class Monad m where
(>>=) :: m a -> (a -> m b) -> m b
return :: a -> m aMonads can be used to model many things besides stateful computations, but in this context, you can think of the functions like this:
(>>=), called "bind," chains two stateful operations together.m a(in our case,StackOp a) evaluates to anain the context of some state and possibly updates the state. Thea -> m bfunction decides what stateful operation to do next. Them bis evaluated in the new state, producing aband a final state. Here is a picture:
+---+
a -----> | f | . . .
| +---+ . b ->
| v |
+-----+ +-----+
state -> | m a | -> state' -> | m b | -> state''
+-----+ +-----+
returnwraps anainto anm a(in our case, aStackOp a) that evaluates to theavalue without changing the state.
Let's implement the Monad functions for StackOp:
-- Helper function to execute a StackOp on a stack
run :: StackOp a -> Stack -> Maybe (a, Stack)
run (StackOp op) stack = op stack
-- More concisely,
run (StackOp op) = op
instance Monad StackOp where
-- (>>=) :: StackOp a -> (a -> StackOp b) -> StackOp b
ma >>= f = StackOp $ \stack ->
case run ma stack of
Nothing -> Nothing
Just (a, stack') -> run (f a) stack'
-- return :: a -> StackOp a
return x = StackOp $ \stack -> Just (x, stack)
-- We also need some boilerplate code since all Monads must also be Applicatives and Functors:
instance Applicative StackOp where
mab <*> ma = mab >>= \f -> fmap f ma -- can also use "ap"
pure = return
instance Functor StackOp where
fmap f ma = ma >>= return . f -- can also use "liftM"(>>=) is just implementing the picture above.
Hopefully, you can see that it closely mirrors the code that was repeated in definition of addOp.
The return function is easier to write since the type signature mostly dictates what the function has to do.
Having defined StackOp as a Monad, addOp becomes very straightforward.
Note that there are no explicit references to stacks or Maybe values!
addOp :: StackOp ()
addOp =
pop >>= \a -> -- pop, then with the popped value a...
pop >>= \b -> -- pop, then with the popped value b...
push $ a + b -- compute a + b and push itIn fact, Monads are so useful in Haskell that there is special syntactic sugar for them, called do notation.
Here is how addOp would be written in do notation:
addOp = do
a <- pop
b <- pop
push $ a + bThis is completely equivalent to the version above, just more readable. It is also intentionally designed to look like code from an imperative language. Let's run it:
-- addOp fails if there are fewer than 2 ints on the stack
run addOp [] == Nothing
run addOp [1] == Nothing
-- 1 + 2 == 3
run addOp [1, 2] == Just ((), [3])
-- 1 + 2 == 3; the rest of the stack is unchanged
run addOp [1, 2, 4, 5] == Just ((), [3, 4, 5])Stacks are a useful but limited model of imperative computation. Stack-machine languages (including Java Bytecode and WebAssembly) usually also have instructions for getting and setting local variables. So let's add two new instructions:
data Instruction
= ...
-- Pushes the value of the local variable with the given name onto the stack
| GetLocal String
-- Pops an int off the stack and stores it in the given local variable
| SetLocal StringCurrently, our Stack state doesn't include local variables.
This is fine; we can define a new Environment that includes both stack state and local variables:
type Environment = (Map String Int, Stack)Note that StackOp's Monad definition doesn't use the fact that stack is a Stack at all.
The same definition would work regardless of the type of the state:
-- e is the type of state in which operations are run.
-- From now on, it will be Environment.
newtype ImpOp e a = ImpOp (e -> Maybe (a, e))
run :: ImpOp e a -> e -> Maybe (a, e)
run (ImpOp op) = op
-- Stateful operations with any state type "e" form a Monad
instance Monad (ImpOp e) where
ma >>= f = ImpOp $ \s ->
case run ma s of
Nothing -> Nothing
Just (a, s') -> run (f a) s'
return a = ImpOp $ \s -> Just (a, s)
-- "fail msg" represents throwing an error with the given message.
-- Note that our ImpOp definition doesn't let us explain *why* an operation failed.
-- To do that, we could use "Either String (a, e)" instead of "Maybe (a, e)".
fail _ = ImpOp $ \_ -> Nothing
instance Applicative (ImpOp e) where
(<*>) = ap
pure = return
instance Functor (ImpOp e) where
fmap = liftMpop and push need slight modifications to work with Environment (they leave the locals unmodified):
pop :: ImpOp Environment Int
pop = ImpOp $ \(locals, stack) ->
case stack of
[] -> Nothing
x : xs -> Just (x, (locals, xs))
push :: Int -> ImpOp Environment ()
push x = ImpOp $ \(locals, stack) ->
Just ((), (locals, x : stack))Here are the operations to evaluate the arithmetic instructions:
-- Computes a binary function f on arguments at the top of the stack
binOp :: (Int -> Int -> Int) -> ImpOp Environment ()
binOp f = do
b <- pop -- the top of the stack is the argument pushed second
a <- pop
push $ f a b
addOp :: ImpOp Environment ()
addOp = binOp (+)
subOp :: ImpOp Environment ()
subOp = binOp (-)
mulOp :: ImpOp Environment ()
mulOp = binOp (*)
-- Division needs special handling so we avoid dividing by 0
divOp :: ImpOp Environment ()
divOp = do
b <- pop
a <- pop
case b of
0 -> fail "Division by 0"
_ -> push $ div a bAnd comparison instructions:
boolToInt :: Bool -> Int
boolToInt False = 0
boolToInt True = 1
-- More concisely,
boolToInt = fromEnum
cmpOp :: (Int -> Int -> Bool) -> ImpOp Environment ()
cmpOp cmp = binOp $ \a b -> boolToInt $ cmp a b
-- More concisely,
cmpOp cmp = binOp $ \a -> boolToInt . cmp a
eqOp :: ImpOp Environment ()
eqOp = cmpOp (==)
ltOp :: ImpOp Environment ()
ltOp = cmpOp (<)For GetLocal and SetLocal, we need to access locals in the Environment, so we need to write some ImpOps directly:
getOp :: String -> ImpOp Environment ()
getOp local =
let
getLocal = ImpOp $ \(locals, stack) ->
case locals !? local of
Nothing -> Nothing -- local variable has not been set
Just val -> Just (val, (locals, stack))
in getLocal >>= push -- get the value of the local and push it
setOp :: String -> ImpOp Environment ()
setOp local = do
val <- pop
ImpOp $ \(locals, stack) ->
Just ((), (insert local val locals, stack))For Block, If, and While, we need to be able to recursively evaluate sub-instructions, so we create an eval function:
eval :: Instruction -> ImpOp Environment ()
eval Add = addOp
eval Sub = subOp
eval Mul = mulOp
eval Div = divOp
eval Eq = eqOp
eval Lt = ltOp
eval (Const x) = push x
eval (GetLocal local) = getOp local
eval (SetLocal local) = setOp local
eval (Block block) = blockOp block
eval (If ifTrue ifFalse) = ifOp ifTrue ifFalse
eval (While cond body) = whileOp cond bodyblockOp can be written explicitly by evaluating each instruction in order:
blockOp :: [Instruction] -> ImpOp Environment ()
blockOp [] = return () -- don't do anything
blockOp (x : xs) = do
eval x -- run the first instruction
blockOp xs -- run the rest of the blockHowever, one of the benefits of writing ImpOp Environment as a Monad is that we automatically get many useful functions.
One of these is mapM_ :: Monad m => (a -> m b) -> [a] -> m (), which maps each item in a list to a value of the Monad type and runs them in order.
This allows us to simplify blockOp:
blockOp = mapM_ evalEvaluating If and While is straightforward, but again we can use a handy Monad function: when :: Monad m => Bool -> m () -> m ()
ifOp :: Instruction -> Instruction -> ImpOp Environment ()
ifOp ifTrue ifFalse = do
-- Pop the condition value off the stack
cond <- pop
-- Pick the branch to evaluate based off the condition
eval $ if cond /= 0 then ifTrue else ifFalse
whileOp :: Instruction -> Instruction -> ImpOp Environment ()
whileOp cond body = do
-- Compute the condition value
eval cond
continue <- pop
-- If the condition value is nonzero, run the loop body and restart
when (continue /= 0) $ do
eval body
whileOp cond bodyPutting it all together, here are some example programs:
-- Computes the nth Fibonacci number.
-- Takes n as input on the stack and pushes result onto the stack.
fib :: Instruction
fib = Block
[ SetLocal "n" -- pop n off the stack
, Const 1
, SetLocal "prev" -- prev = 1
, Const 0
, SetLocal "result" -- result = 0
, While (GetLocal "n") $ Block -- while (n > 0)
[ GetLocal "prev"
, GetLocal "result"
, Add -- compute prev + result before prev gets overwritten
, GetLocal "result"
, SetLocal "prev" -- prev = result
, SetLocal "result" -- result = (old prev + result)
, GetLocal "n"
, Const 1
, Sub
, SetLocal "n" -- n--
]
, GetLocal "result" -- return result
]
-- Raises one int to the power of another.
-- Takes a and b as input on the stack and pushes a ^ b onto the stack.
pow :: Instruction
pow = Block
[ SetLocal "b" -- pop b off the stack (it is on the top since it was pushed second)
, SetLocal "a" -- pop a off the stack
, Const 1
, SetLocal "pow" -- pow = 1
, While (GetLocal "b") $ Block -- while (b > 0)
[ GetLocal "b"
, Const 2
, Div
, SetLocal "next_b" -- next_b = b >> 1
, GetLocal "next_b"
, GetLocal "next_b"
, Add
, GetLocal "b"
, Lt
, If -- if (next_b + next_b < b) pow *= a
(Block [GetLocal "pow", GetLocal "a", Mul, SetLocal "pow"])
(Block [])
, GetLocal "a"
, GetLocal "a"
, Mul
, SetLocal "a" -- a *= a
, GetLocal "next_b"
, SetLocal "b" -- b = next_b
]
, GetLocal "pow" -- return pow
]Here's a simple function to run the programs, and some sample outputs:
runFunc :: Instruction -> [Int] -> Maybe Int
runFunc func args =
let
funcOp = do
mapM_ push args -- push arguments in order
eval func -- run the computation
pop -- pop the result
in
case run funcOp (empty, []) of
Nothing -> Nothing
Just (result, _) -> Just result
-- runFunc fib [] == Nothing
-- runFunc fib [10] == Just 55
-- runFunc fib [40] == Just 102334155
-- runFunc pow [1] == Nothing
-- runFunc pow [12345, 0] == Just 1
-- runFunc pow [12345, 1] == Just 12345
-- runFunc pow [2, 13] == 8192
-- runFunc pow [10, 10] == Just 10000000000While the notions of state we used above (Stack and Environment) were all for evaluating imperative programs, "state" is a much more general concept.
For example, Haskell models I/O operations using the IO monad.
An IO a can be thought of as a stateful operation that computes an a.
A simple representation of the state would be a list of input lines and a list of output lines, which are modified by read and print functions:
-- Lines of stdin to read and lines of stdout to print (in reverse order)
type StdStreams = ([String], [String])
newtype InOut a = InOut (StdStreams -> (a, StdStreams))
instance Monad InOut where
(InOut ma) >>= f = InOut $ \streams ->
let (a, streams') = ma streams
in
let (InOut mb) = f a
in mb streams'
return a = InOut $ \streams -> (a, streams)
instance Applicative InOut where
(<*>) = ap
pure = return
instance Functor InOut where
fmap = liftM
println :: String -> InOut ()
println x = InOut $ \(stdin, stdout) ->
((), (stdin, x : stdout))
readln :: InOut (Maybe String)
readln = InOut $ \(stdin, stdout) ->
case stdin of
[] -> (Nothing, ([], stdout))
x : xs -> (Just x, (xs, stdout))(Note that this is not really how Haskell represents an IO object. Among other issues, the InOut representation assumes the entire input has been read at the start of the program and the output isn't printed until the end of the program.)
Another neat application of stateful monads is in writing parsers.
A parser can be thought of a function that takes a string, tries to parse some type of value from the start of the string, and if it succeeds, returns the value and the rest of the string.
Here is how it would be implemented as a monad (note that the state type is now String):
newtype Parser a = Parser (String -> Maybe (a, String))
parse :: Parser a -> String -> Maybe (a, String)
parse (Parser f) = f
instance Monad Parser where
pa >>= f = Parser $ \s ->
case parse pa s of
Nothing -> Nothing
Just (a, s') -> parse (f a) s'
return a = Parser $ \s -> Just (a, s)
fail _ = Parser $ \_ -> Nothing
instance Applicative Parser where
(<*>) = ap
pure = return
instance Functor Parser where
fmap = liftMIt turns out that this monadic representation is well-suited to composing parsers into more complicated parsers.
As an example, here is a simple S-expression parser.
I have used the Monad function void :: Monad m => m a -> m () to execute some parsers solely for their side effects.
data SExpr
= IntConst Int -- e.g. 123
| StringConst String -- e.g. "abc"
| Id String -- e.g. +
| List [SExpr] -- e.g. (+ 1 2)
deriving Show
-- Parses a single character that satisfies a predicate
parseChar :: (Char -> Bool) -> Parser Char
parseChar p = Parser $ \s ->
case s of
[] -> Nothing
x : xs ->
if p x then Just (x, xs)
else Nothing
-- Parses with the first parser in a list of parsers that succeeds
parseChoice :: [Parser a] -> Parser a
parseChoice [] = fail "No choice matched"
parseChoice (pa : pas) = Parser $ \s ->
case parse pa s of
Nothing -> parse (parseChoice pas) s
success -> success
-- Parses 1 or more times
parseDoWhile :: Parser a -> Parser [a]
parseDoWhile pa = do
x <- pa
xs <- parseWhile pa
return $ x : xs
-- Parses 0 or more times
parseWhile :: Parser a -> Parser [a]
parseWhile pa =
parseChoice [parseDoWhile pa, return []]
-- Parses an IntConst
parseIntConst :: Parser SExpr
parseIntConst = do
digits <- parseDoWhile $ parseChar isDigit
return $ IntConst $ read digits
-- Parses a StringConst
parseStringConst :: Parser SExpr
parseStringConst = do
void $ parseChar ('"' ==)
str <- parseWhile $ parseChoice
[ do -- allow quotes to be escaped
void $ parseChar ('\\' ==)
parseChar $ const True
, parseChar ('"' /=)
]
void $ parseChar ('"' ==)
return $ StringConst str
-- Parses an Id
parseId :: Parser SExpr
parseId =
let isIdChar c = not $ c == ';' || c == ')' || isSpace c
in do
name <- parseDoWhile $ parseChar isIdChar
return $ Id name
-- Parses whitespace (or a comment)
parseRequiredSpace :: Parser ()
parseRequiredSpace =
void $ parseDoWhile $ parseChoice
[ void $ parseChar isSpace -- parse a whitespace character
, do -- parse a comment
void $ parseChar (';' ==)
parseWhile $ parseChar ('\n' /=)
void $ parseChar ('\n' ==)
]
-- Parses whitespace if there is any
parseOptionalSpace :: Parser ()
parseOptionalSpace =
parseChoice [parseRequiredSpace, return ()]
-- Parses a List
parseList :: Parser SExpr
parseList = do
void $ parseChar ('(' ==)
parseOptionalSpace
elems <- parseChoice
[ do
x <- parseExpr
xs <- parseWhile $ do
parseRequiredSpace
parseExpr
parseOptionalSpace
return $ x : xs
, return []
]
void $ parseChar (')' ==)
return $ List elems
-- Parses any SExpr
parseExpr :: Parser SExpr
parseExpr =
parseChoice
[ parseIntConst
, parseStringConst
, parseList
, parseId -- parse identifier only if other cases fail
]Here is an example S-expression that parseExpr can parse:
fst $ fromJust $ parse parseExpr
"(defun factorial (x) \
\ (if (zerop x) \
\ 1 \
\ (* x (factorial (- x 1)))))"
{-
List
[ Id "defun"
, Id "factorial"
, List [Id "x"]
, List
[ Id "if"
, List [Id "zerop", Id "x"]
, IntConst 1
, List
[ Id "*"
, Id "x"
, List
[ Id "factorial"
, List [Id "-", Id "x", IntConst 1]
]
]
]
]
-}In Haskell, Maybe has a built-in implementation of Monad.
The bind function has signature (>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b.
It works just like applying a function to a value if the Maybe a is a Just, but if it is a Nothing, it skips applying the function and returns Nothing.
This is useful for modeling a series of function applications where each can fail—if any fails, the computation stops and Nothing is returned.
Here is the (slightly modified) implementation from Haskell's source:
instance Monad Maybe where
Just x >>= k = k x
Nothing >>= _ = Nothing
return = Just
fail _ = NothingYou may have noticed that there are several places in the previous monad examples where we propagate failures, represented as Nothing.
We could have written this instead by using Maybe as a Monad.
For example:
-- Our previous implementation:
instance Monad (ImpOp e) where
ma >>= f = ImpOp $ \s ->
case run ma s of
Nothing -> Nothing
Just (a, s') -> run (f a) s'
return a = ImpOp $ \s -> Just (a, s)
-- Rewriting (>>=) using do notation for Maybe handling:
ma >>= f = ImpOp $ \s -> do
(a, s') <- run ma s
run (f a) s'Like Maybe, the list type (written []) has a built-in implementation of Monad.
For lists, (>>=) :: [a] -> (a -> [b]) -> [b] returns all possible values that result from picking an element of the list, applying the function to it, and picking one of the function's outputs.
Here is a modified version of Haskell's implementation:
instance Monad [] where
xs >>= f = concatMap f xs
return x = [x]
fail _ = []Viewing lists as monads neatly models nondeterminism.
For example, suppose we want to find all assignments of Boolean values to n variables that satisfy the XOR function:
xor :: [Bool] -> Bool
xor [] = False
xor (False : xs) = xor xs
xor (True : xs) = not $ xor xs
assignments :: Int -> [[Bool]]
assignments 0 = return []
assignments n = do
x <- [False, True] -- try both possible assignments for the first variable
xs <- assignments $ n - 1 -- try all assignments for the other variables
return $ x : xs
satisfyingAssignments :: Int -> [[Bool]]
satisfyingAssignments n = do
xs <- assignments n -- for each assignment of xs, ...
if xor xs then return xs -- if satisfied, return the assignment
else fail "Unsatisfied" -- if unsatisfied, return no assignments
satisfyingAssignments 3 ==
[ [False, False, True]
, [False, True, False]
, [True, False, False]
, [True, True, True]
]This is also useful for combinatorics. For example, suppose we want to find all the ways to partition a set into nonempty subsets:
-- Finds all ways to partition a list into 2 sublists
subsets :: [a] -> [([a], [a])]
subsets [] = [([], [])]
subsets (x : xs) = do
-- Either x is in the subset or not
(inSet, outOfSet) <- [([], [x]), ([x], [])]
-- Either way, we can choose any subset of the remaining elements
(inSet', outOfSet') <- subsets xs
return $ (inSet ++ inSet', outOfSet ++ outOfSet')
-- Finds all ways to partition a set into nonempty subsets
partition :: [a] -> [[[a]]]
partition [] = [[]]
partition (x : xs) = do
-- To avoid double-counting, x must be in the first partition
(subset, rest) <- subsets xs
subsets <- partition rest
return $ (x : subset) : subsets
partition [1, 2, 3] ==
[ [[1], [2], [3]]
, [[1], [2, 3]]
, [[1, 3], [2]]
, [[1, 2], [3]]
, [[1, 2, 3]]
]
(length $ partition [1, 2, 3, 4, 5]) == 52