Continuations
Joseph Haugh
University of New Mexico
Motivation
Remember this problem?
data Term = PrimApp PrimOp [Term]
data PrimOp = Zero | Succ | Sub
hcc :: Term -> (Term -> Term) -> Term
hcc t kappa = case t of
PrimApp p [] ->
kappa (PrimApp p [])
PrimApp p [t1] ->
hcc t1 (\v1 -> kappa (PrimApp p [v1]))
PrimApp p [t1, t2] ->
hcc t1 (\v1 -> hcc t2 (\v2 -> kappa (PrimApp p [v1, v2])))
This week we are going to tackle this problem and by the end we will have a 1 line solution!
What We Will Learn
- We will learn about continuations
- This will naturally lead us to continuation passing style (CPS)
- CPS is a way of structuring programs to make many things more explicit
- With this explicitness comes verbosity
- CPS gives us:
- Explicit return address
- Guaranteed tail calls
- Explicit intermediate results
- Explicit evaluation order
- Among other things
Thought Experiment
- In 357 I tell students to imagine a programming language with no loops and no assignment.
- Now I would like you to imagine a programming language where you cannot directly return to your caller.
Return To Caller
What do I mean by “return to your caller”?
id :: a -> a
id x = x
id is written in direct style, because it returns x directly back to the caller of the function.
How could I get around that?
I need to be given an explicit function to return to:
idCPS :: a -> (a -> a) -> a
idCPS x _return = _return x
idCPS is written in continuation passing style(CPS), because it returns or continues with the provided function.
Continuing
id :: a -> a
id x = x
Ask yourself, how does the program continue after id returns x?
The answer is completely up to the caller.
ghci> length (id [1,2,3])
3
ghci> putStrLn (id "hello world")
hello world
Continuing
idCPS :: a -> (a -> a) -> a
idCPS x _return = _return x
Ask yourself again, how does the program continue after idCPS calls _return?
The answer of how to continue is completely up to the function passed in, _return, not the caller. This function is called a continuation.
ghci> idCPS [1,2,3] length
Type Error!
ghci> idCPS "hello world" putStrLn
Type Error!
Why do these not work??
Our type is too specific!
Generalizing idCPS
idCPS :: a -> (a -> a) -> a
idCPS x _return = _return x
How can we generalize this?
Notice that the return type is entirely determined by whatever _return’s return type is. Thus, we could change the type of idCPS to be as follows:
idCPS :: a -> (a -> r) -> r
idCPS x _return = _return x
ghci> idCPS [1,2,3] length
3
ghci> idCPS "hello world" putStrLn
hello world
Side By Side
Direct:
id :: a -> a
id x = x
CPS:
idCPS :: a -> (a -> r) -> r
idCPS x _return = _return x
Direct Triangle
Lets try to calculate the triangle number of a given Int.
The triangle number is given by the following formula:
$$ t_n = \begin{cases} 1, & \text{if } n = 1 \\ n+ t_{n - 1}, & \text{if } n > 1 \end{cases} $$
triangle :: Int -> Int
triangle 1 = 1
triangle x = x + triangle (x - 1)
Can we write this in CPS style?
CPS Triangle
You might try to follow the pattern so far and write this:
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = x + _return (x - 1)
Will this work? Only one way to find out!
ghci> :r
Type Error!
Why do we get a type error?!
x :: Int
_return (x - 1) :: r.
CPS Triangle
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = x + _return (x - 1)
This code is also breaking our cardinal rule: No direct returning allowed
We are also not recursing!
CPS Triangle
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = x + _return (x - 1)
Lets try to fix the recursion problem first by just putting in a recursive call.
CPS Triangle
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = triangleCPS ???1 ???2
What do we need to put for ???1?
Well we need to recurse with a smaller value, in this case x - 1.
CPS Triangle
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = triangleCPS (x - 1) ???2
What about for ???2?
Well we know it needs to be a function of 1 argument…
CPS Triangle
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = triangleCPS (x - 1) (\result -> ???)
Why do I call the argument result?
What does ??? need to be?
Well it needs to be our actual algorithm, we add the current value of x to the result of recursing with x - 1.
We then give this to _return because we are still not allowed to directly return.
CPS Triangle V2
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = triangleCPS (x - 1) (\result -> _return (x + result))
At each recursive call we need to provide a continuation for that recursive call to continue with.
We then call our continuation, _return, on the x + result.
CPS Triangle V2
Lets test it:
ghci> triangleCPS 5 id
15
Why is it that I am passing id to this function?
I am telling triangleCPS how to continue after it produces its final result.
CPS Triangle V2 Intuition
triangle :: Int -> Int
triangle 1 = 1
triangle x = x + triangle (x - 1)
This probably confused you at first too.
Then you became comfortable with a recursion simply representing the answer to the question posed by its arguments.
triangle (x - 1) can be thought of as the triangular number of x - 1.
CPS Triangle V2 Intuition
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = triangleCPS (x - 1) (\result -> _return (x + result))
Now you have a new mountain to climb, understanding CPS!
However, it is not as hard as it seems.
The biggest difference is that the recursive call doesn’t directly return to us a result.
Instead it returns to the continuation function we provide!
That is why I call the parameter result, it is the result of the recursive call!
Direct Step-By-Step
Lets see if we can gain some clarity by expanding it out.
triangle :: Int -> Int
triangle 1 = 1
triangle x = x + triangle (x - 1)
triangle 3
| { applying triangle }
3 + triangle (2)
| { applying triangle }
3 + 2 + triangle 1
| { applying triangle }
3 + 2 + 1
| { applying (+) }
6
CPS Step-By-Step
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = triangleCPS (x - 1) (\res -> _return (x + res))
triangleCPS 3 id
| { applying triangleCPS }
triangleCPS (3 - 1) (\res1 -> id (3 + res1))
| { applying (-) and triangleCPS }
triangleCPS (2 - 1) (\res2 -> (\res1 -> id (3 + res1)) (2 + res2))
| { applying (-) and triangleCPS }
(\res2 -> (\res1 -> id (3 + res1)) (2 + res2)) 1
| { applying outer lambda }
(\res1 -> id (3 + res1)) (2 + 1)
| { applying lambda }
id (3 + 2 + 1)
| { applying (+) and id }
6
Tail Calls
A function is tail recursive when all of its recursive calls are in /tail position.
An expression is in tail position if before the function returns nothing else needs to be evaluated.
For example the following places marked, (tp), are tail positions:
f x = (tp)
if b then (tp) else (tp)
let e in (tp)
case e of
p1 -> (tp)
p2 -> (tp)
Tail Calls
Our direct definition of triangle is not tail recursive:
triangle :: Int -> Int
triangle 1 = 1
triangle x = x + triangle (x - 1)
Tail Calls
Whereas, our CPS version is:
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return = triangleCPS (x - 1) (\res -> _return (x + res))
In fact all functions written in CPS are tail recursive!
Okay, so what?
Tail Calls
Tail recursive functions, if optimized by the compiler, can be run in constant stack space.
No stack overflow errors!
A function in tail position has complete control over what happens next.
Side By Side
Direct:
id :: a -> a
id x = x
triangle :: Int -> Int
triangle 1 = 1
triangle x =
x + triangle (x - 1)
CPS:
idCPS :: a -> (a -> r) -> r
idCPS x _return = _return x
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return =
triangleCPS (x - 1) (\res -> _return (x + res))
Exercise: Using TriangleCPS
Lets write a program which takes in a triple of Ints and computes the triangular number of each and then returns the sum of these numbers.
Direct Implementation:
triangle3 :: (Int, Int, Int) -> Int
triangle3 (x, y, z) =
let xt = triangle x
yt = triangle y
zt = triangle z
in xt + yt + zt
Exercise: Using TriangleCPS
Now I would like you to write this same function but using triangleCPS instead.
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return =
triangleCPS (x - 1) (\res -> _return (x + res))
triangle3CPS :: (Int, Int, Int) -> (Int -> r) -> r
Exercise: Using TriangleCPS
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return =
triangleCPS (x - 1) (\res -> _return (x + res))
triangle3CPS :: (Int, Int, Int) -> (Int -> r) -> r
triangle3CPS (x, y, z) _return =
triangleCPS x (\xt ->
triangleCPS y (\yt ->
triangleCPS z (\zt ->
_return (xt + yt + zt))))
Fibonacci Sequence
The Fibonacci sequence is defined as follows:
$$ f_n = \begin{cases} 1, & \text{if } n = 0 \\ 1, & \text{if } n = 1 \\ f_{n-1} + f_{n-2}, & \text{if } n > 1 \end{cases} $$
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n = fib (n - 1) + fib (n - 2)
Exercise: fibCPS
Try to define fibCPS.
fibCPS :: Int -> (Int -> r) -> r
Exercise: fibCPS
Try to define fibCPS.
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Explicit Intermediate Results
Notice that in this code the intermediate results are made explicit, result1 and result2.
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Explicit Intermediate Results
We can of course also do this in the direct version as well:
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n =
let result1 = fib (n - 1)
result2 = fib (n - 2)
in result1 + result2
Explicit Order Of Evaluation
However, something we cannot as easily do in the direct version is make the order of evaluation explicit.
Notice in the CPS version we know exactly how the code will be evaluated:
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Step-By-Step fibCPS
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
fibCPS 2 id
| { applying fibCPS }
fibCPS (2 - 1) (\result1 ->
fibCPS (2 - 2) (\result2 ->
id (result1 + result2)))
| { applying (-) and outer fibCPS }
(\result1 -> fibCPS (2 - 2) (\result2 ->
id (result1 + result2))) 1
| { applying lambda }
fibCPS (2 - 2) (\result2 ->
id (1 + result2))
| { applying (-) and fibCPS }
(\result2 ->
id (1 + result2)) 1
| { applying lambda }
id (1 + 1)
| { applying (+) and id }
2
Explicit Order Of Evaluation
We never had a choice about what to evaluate first.
Whereas, with fib we do. To illustrate this lets walk through the evaluation of fib 2:
Explicit Order Of Evaluation
Two choices, same result
fib 2
| { applying fib }
fib (2 - 1) + fib (2 - 2)
| { applying (-) and first fib }
1 + fib (2 - 2)
| { applying (-) and second fib }
1 + 1
| { applying (+) }
2
fib 2
| { applying fib }
fib (2 - 1) + fib (2 - 2)
| { applying (-) and second fib }
fib (2 - 1) + 1
| { applying (-) and first fib }
1 + 1
| { applying (+) }
2
This doesn’t happen with CPS, there is single way to evaluate a CPS program.
Side By Side
Direct:
id :: a -> a
id x = x
triangle :: Int -> Int
triangle 1 = 1
triangle x =
x + triangle (x - 1)
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n =
let result1 = fib (n - 1)
result2 = fib (n - 2)
in result1 + result2
CPS:
idCPS :: a -> (a -> r) -> r
idCPS x _return = _return x
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return =
triangleCPS (x - 1) (\res -> _return (x + res))
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Generalizing Further
So far it seems like the general shape of CPS function is:
a -> (a -> r) -> r
Is this sufficiently general though?
What if we wanted to define the length function in CPS?
Length CPS
length :: [a] -> Int
length [] = 0
length (x:xs) = 1 + length xs
lengthCPS :: [a] -> (??? -> r) -> r
What type should the ??? be?
If we follow the pattern it should be [a], lets try to define it with that.
Length CPS
lengthCPS :: [a] -> ([a] -> r) -> r
lengthCPS [] _return = _return 0
We already have a problem, 0 is not of type [a]!
This further reinforces what the argument to the continuation means, it is the result of the current computation.
The result of length is an Int, thus we need to further generalize our notion of a CPS function to:
a -> (b -> r) -> r
Length CPS
We can now finish writing lengthCPS:
lengthCPS :: [a] -> (Int -> r) -> r
lengthCPS [] _return = _return 0
lengthCPS (x:xs) _return = lengthCPS xs (\result -> _return (1 + result))
Side By Side
Direct:
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n =
let result1 = fib (n - 1)
result2 = fib (n - 2)
in result1 + result2
length :: [a] -> Int
length [] = 0
length (x:xs) =
let result = length xs
in 1 + result
CPS:
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
lengthCPS :: [a] -> (Int -> r) -> r
lengthCPS [] _return = _return 0
lengthCPS (x:xs) _return =
lengthCPS xs (\result ->
_return (1 + result))
Recap
- CPS makes the return address explicit
id :: a -> a
id x = x
idCPS :: a -> (a -> r) -> r
idCPS x _return = _return x
Recap
- CPS guarantees tail recursion
triangle :: Int -> Int
triangle 1 = 1
triangle x =
x + triangle (x - 1)
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return =
triangleCPS (x - 1) (\result -> _return (x + result))
Recap
- CPS makes intermediate results explicit
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n =
let result1 = fib (n - 1)
result2 = fib (n - 2)
in result1 + result2
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Recap
- CPS makes evaluation order explicit
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n =
let result1 = fib (n - 1)
result2 = fib (n - 2)
in result1 + result2
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Part 2
Returning To The Original Problem
data Term = PrimApp PrimOp [Term]
data PrimOp = Zero | Succ | Sub
hcc :: Term -> (Term -> Term) -> Term
hcc t _return = case t of
PrimApp p [] ->
_return (PrimApp p [])
PrimApp p [t1] ->
hcc t1 (\v1 -> _return (PrimApp p [v1]))
PrimApp p [t1, t2] ->
hcc t1 (\v1 -> hcc t2 (\v2 -> _return (PrimApp p [v1, v2])))
Perhaps this function, hcc, might make more sense now.
Examining hcc
data Term = PrimApp PrimOp [Term]
data PrimOp = Zero | Succ | Sub
hcc :: Term -> (Term -> Term) -> Term
hcc t _return = case t of
PrimApp p [] ->
_return (PrimApp p [])
PrimApp p [t1] ->
hcc t1 (\v1 -> _return (PrimApp p [v1]))
PrimApp p [t1, t2] ->
hcc t1 (\v1 -> hcc t2 (\v2 -> _return (PrimApp p [v1, v2])))
hcc compiles a Term t and continues with _return when it is done.
hcc is of course written in CPS.
What would it look like when written in direct style?
Exercise: Direct Version
data Term = PrimApp PrimOp [Term]
data PrimOp = Zero | Succ | Sub
-- Here is an example term, 1 - (1 - 0)
example1 :: Term
example1 =
PrimApp Sub [PrimApp Succ [PrimApp Zero []],
PrimApp Sub [
PrimApp Succ [PrimApp Zero []],
PrimApp Zero []]]
dd :: Term -> Term
dd t = case t of
PrimApp p [] -> PrimApp p []
PrimApp p [t1] -> (\v1 -> PrimApp p [v1]) (dd t1)
PrimApp p [t1, t2] -> (\v1 v2 -> PrimApp p [v1, v2]) (dd t1) (dd t2)
PrimApp p [t1, t2, t3] ->
(\v1 v2 v3 -> PrimApp p [v1, v2, v3]) (dd t1) (dd t2) (dd t3)
Exercise: Direct Version
data Term = PrimApp PrimOp [Term]
data PrimOp = Zero | Succ | Sub
-- 1 - (1 - 0)
example1 :: Term
example1 =
PrimApp Sub [PrimApp Succ [PrimApp Zero []],
PrimApp Sub [
PrimApp Succ [PrimApp Zero []],
PrimApp Zero []]]
dd :: Term -> Term
dd (PrimApp p ts) = PrimApp p (map dd ts)
Its just map! Aside: where is the base case!?
This begs the question, can we solve this with CPS map?
Exercise: CPS Map
What does the type of mapCPS need to be?
We need to make sure that the function we are given is also in CPS!
mapCPS :: (a - > (b -> r) -> r) -> [a] -> ([b] -> r) -> r
Exercise: CPS Map
mapCPS :: (a -> (b -> r) -> r) -> [a] -> ([b] -> r) -> r
mapCPS f [] _return = _return []
mapCPS f (x:xs) _return =
f x (\x' ->
mapCPS f xs (\xs' ->
_return (x':xs')))
Not too bad!
Now can we use this to solve the original problem??
A First Solution
hccMapCPS :: Term -> (Term -> Term) -> Term
hccMapCPS (PrimApp p ts) _return =
mapCPS hccMapCPS ts (\ts' ->
_return (PrimApp p ts'))
Short and sweet.
Welp Thats All Folks
A First Solution
No but really that is basically a 1 line solution which naturally arises when you abide by the fact that CPS is supposed to be a global transformation.
I credit Darko for showing me this solution.
Another Solution
When I was working on this problem I of course didn’t think of this, instead I struggled against the types mightily but I think the payoff was worth it.
To start lets talk about my first approximation of a solution which likely most if not all of you also came up with.
Another Solution
hcc :: Term -> (Term -> Term) -> Term
hcc (PrimApp p ts) _return = go [] ts
where
go :: [Term] -> [Term] -> Term
go vals [] = _return (PrimApp p (reverse vals))
go vals (t:ts) =
hcc t (\v -> go (v:vals) ts)
Interestingly, go itself is not a CPS function, instead it builds a CPS expression using hcc.
I knew deep down that go must be able to written as fold.
Revisiting Foldr
Lets revisit an old favorite function, the lowly foldr:
foldr :: (a -> b -> b) -> b -> [a] -> b
Aside: do you have any new appreciation for foldr?
As I always say in 357, when writing with folds, always know what your b is!
What is our b here?
Well ultimately we want to return Term, but how then do we buildup the [Term]?
Misfires With Foldr
Your first thought might be to use a tuple to buildup the [Term] while also building up the Term.
Lets try that:
hccFold :: Term -> (Term -> Term) -> Term
hccFold (PrimApp p ts) _return = fst $ foldr go (???1, []) ts
where
go t (???2, vs) = (hcc t (\v -> ???3), ???4:vs)
We can’t make it work it this way since we need to build the [Term] and the Term together not separately.
Another Perspective
The trick we used without foldr was to add an extra parameter to our function. Can we do the same with foldr?
What if we try to make our b, [Term] -> Term, effectively adding an extra parameter!
Lets see what the type of foldr would look like with that as the b:
foldr :: (a -> b -> b) -> b -> [a] -> b
Another Perspective
The trick we used without foldr was to add an extra parameter to our function. Can we do the same with foldr?
What if we try to make our b, [Term] -> Term, effectively adding an extra parameter!
Lets see what the type of foldr would look like with that as the b:
foldr :: (a -> ([Term] - > Term) -> ([Term] -> Term)) ->
([Term] -> Term) ->
[a] ->
([Term] -> Term)
Exercise: Try Again
foldr :: (a -> ([Term] - > Term) -> ([Term] -> Term)) ->
([Term] -> Term) ->
[a] ->
([Term] -> Term)
hccFold :: Term -> (Term -> Term) -> Term
hccFold (PrimApp p ts) _return =
foldr go ??? ts
where
-- ( a) -> ( b ) -> ( b )
go :: Term -> ([Term] -> Term) -> ([Term] -> Term)
go = ???
Exercise: Try Again
foldr :: (a -> ([Term] - > Term) -> ([Term] -> Term)) ->
([Term] -> Term) ->
[a] ->
([Term] -> Term)
hccFold :: Term -> (Term -> Term) -> Term
hccFold (PrimApp p ts) _return =
foldr go (\vs -> _return (PrimApp p (reverse vs))) ts []
where
-- ( a) -> ( b ) -> ( b )
go :: Term -> ([Term] -> Term) -> ([Term] -> Term)
go t _rest = \vs -> hccFold t (\v -> _rest (v:vs))
Exercise: Try Again
foldr :: (a -> ([Term] - > Term) -> ([Term] -> Term)) ->
([Term] -> Term) ->
[a] ->
([Term] -> Term)
hccFold :: Term -> (Term -> Term) -> Term
hccFold (PrimApp p ts) _return =
foldr go (_return . PrimApp p . reverse) ts []
where
-- ( a) -> ( b ) -> ( b )
go :: Term -> ([Term] -> Term) -> ([Term] -> Term)
go t _rest = \vs -> hccFold t (\v -> _rest (v:vs))
Awesome!!
Is foldr really what we want though?
Order Of Evaluation
Remember that CPS makes the order of evaluation explicit what is the order of evaluation when using foldr?
Right to left, we don’t necessarily want that, with map it is applying the functions left to right.
We could instead just use foldl!
This also means no reverse!
Using Foldl
hccFold :: Term -> (Term -> Term) -> Term
hccFold (PrimApp p ts) _return = foldl go (_return . PrimApp p) ts []
where
-- ( b ) -> ( a) -> ( b )
go :: ([Term] -> Term) -> Term -> ([Term] -> Term)
go _acc t = \vs -> hccFold t (\v -> _acc (v:vs))
Clean.
But we can do better!
Another Look
Recall our definition of fibCPS:
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Does this remind you of anything?
What about our generalized type of a CPS function?
a -> (b -> r) -> r
The Road To Monads
What does it mean for a function to be partial?
What is the name of a function which is not partial?
Total!
Now lets imagine that you want to stamp out partial functions from your standard library entirely!
You would probably start with head and tail
ghci> head []
Runtime Error!
ghci> tail []
Runtime Error!
SafeHead and SafeTail
How can we make these functions total?
One way is to add additional structure to the input type.
Instead of accepting a plain list they could take in a NonEmpty list, this is a topic for another day.
Another way is by adding additional structure to the output type:
safeHead :: [a] -> Maybe a
safeHead [] = Nothing
safeHead (x:xs) = Just x
safeTail :: [a] -> Maybe [a]
safeTail [] = Nothing
safeTail (x:xs) = Just xs
Using SafeHead and SafeTail
Then, because we want to write Lisp style programs, we want to define functions to get the second and third elements of a list.
Writing these using the unsafe head and tail is trivial:
second = head . tail
third = head . tail . tail
Using SafeHead and SafeTail
Writing these with safeHead and safeTail is… ugly:
safeSecond :: [a] -> Maybe a
safeSecond xs =
case safeTail xs of
Nothing -> Nothing
Just xs' -> safeHead xs'
safeThird :: [a] -> Maybe a
safeThird xs =
case safeTail xs of
Nothing -> Nothing
Just xs' ->
case safeTail xs' of
Nothing -> Nothing
Just xs'' -> safeHead xs''
Spotting The Pattern
Lets take another look at safeSecond:
safeSecond :: [a] -> Maybe a
safeSecond xs =
case safeTail xs of
Nothing -> Nothing
Just xs' -> safeHead xs'
Can you spot the pattern?
- We case match over something of type Maybe a
- We then pass through Nothing if the original Maybe a is Nothing
- Otherwise, we call a function which takes the a inside of the Maybe a and produces a new Maybe b
Bind
Of course the function we are looking for is bind (>>=):
(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b
Aside: Does that type signature look familiar?
We can then rewrite safeSecond and safeThird as follows:
safeSecond xs = safeTail xs >>= safeHead
safeThird xs = safeTail xs >>= safeTail >>= safeHead
Do you spot the similarity yet?
Bind Is CPS
What if I expand out the definition of safeSecond and safeThird a bit:
safeSecond xs =
safeTail xs >>= (\xs' ->
safeHead xs')
safeThird xs =
safeTail xs >>= (\xs' ->
safeTail xs' >>= (\xs'' ->
safeHead xs''))
Bind Is CPS
What if I expand out the definition of safeSecond and safeThird a bit:
safeSecond xs =
safeTail xs >>= (\xs' ->
safeHead xs')
safeThird xs =
safeTail xs >>= (\xs' ->
safeTail xs' >>= (\xs'' ->
safeHead xs''))
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
Bind Is CPS
What if I expand out the definition of safeSecond and safeThird a bit:
safeSecond xs =
safeTail xs >>= (\xs' ->
safeHead xs')
safeThird xs =
safeTail xs >>= (\xs' ->
safeTail xs' >>= (\xs'' ->
safeHead xs''))
(>>=) :: m a -> (a -> m b) -> m b
fibCPS :: Int -> (Int -> r) -> r
fibCPS 0 _return = _return 1
fibCPS 1 _return = _return 1
fibCPS n _return =
fibCPS (n - 1) (\result1 ->
fibCPS (n - 2) (\result2 ->
_return (result1 + result2)))
cpsFunc :: a -> (b -> r) -> r
(>>=) is a restricted CPS function!
Bind In A New Light
triangleCPS :: Int -> (Int -> r) -> r
triangleCPS 1 _return = _return 1
triangleCPS x _return =
triangleCPS (x - 1) (\result -> _return (x + result))
The result of triangleCPS (x - 1) will be given to the continuation and bound to result
safeSecond :: [a] -> Maybe a
safeSecond xs =
safeTail xs >>= (\xs' ->
safeHead xs')
The result of safeTail xs, if it is not Nothing, will be given to the continuation and bound to xs', otherwise, Nothing will be passed through.
Aside: Early Exit
In fact the Maybe monad embodies one of the CPS powers I didn’t explicitly discuss previously, the ability to escape the computation at any time.
This is how safeSecond and safeThird behave but in reality the computation still continues but effectively nothing more will be done once a function in the bind chain returns Nothing
If we have time at the end we will rewrite these functions using CPS directly!
Continuation Monad
All this begs the question, is there a monad here?
Of course!
But… what does it look like?
Continuation Monad
Remind yourself of the general form of a CPS function:
a -> (b -> r) -> r
Hmm lets remind ourselves of how we might have discovered the State monad.
We find ourselves writing a lot of function which have to explicitly thread the state such as:
a -> s -> (b, s)
So we say the State monad is the effect being returned, the s -> (a, s)
What is it for continuations then?
Continuation Monad
(b -> r) -> r
Continuation Monad
(a -> r) -> r
There it is!
Now we can wrap it in a newtype and start building up to a Monad instance!
Continuation Newtype
newtype Cont r a = Cont { runCont :: (a -> r) -> r }
This is how you will find it defined most places.
Ponder for a moment the type of runCont:
ghci> :t runCont
Cont r a -> (a -> r) -> r
What does that remind you of?
It looks like (>>=) :: m a -> (a -> m b) -> m b!
So instead I will write it like this:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
Exercise: Continuation Functor
Try to write the Functor instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Functor (Cont r) where
fmap f cnta = ???
Exercise: Continuation Functor
Try to write the Functor instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Functor (Cont r) where
fmap f cnta =
Cont $ \_return ->
cnta >>- \a ->
_return (f a)
Exercise: Continuation Applicative
Try to write the Applicative instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Applicative (Cont r) where
pure x = ???1
cntf <*> cnta = ???2
Exercise: Continuation Applicative
Try to write the Applicative instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Applicative (Cont r) where
pure x =
Cont $ \_return ->
_return x
cntf <*> cnta = ???2
Exercise: Continuation Applicative
Try to write the Applicative instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Applicative (Cont r) where
pure x =
Cont $ \_return ->
_return x
cntf <*> cnta =
Cont $ \_return ->
cntf >>- \f ->
cnta >>- \a ->
_return (f a)
Exercise: Continuation Monad
Try to write the Monad instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Monad (Cont r) where
return x = ???1
cnta >>= f = ???2
Exercise: Continuation Monad
Try to write the Monad instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Monad (Cont r) where
return x =
Cont $ \_return ->
_return x
cnta >>= f = ???2
Exercise: Continuation Monad
Try to write the Monad instance for Cont:
newtype Cont r a = Cont { (>>-) :: (a -> r) -> r }
instance Monad (Cont r) where
return x =
Cont $ \_return ->
_return x
cnta >>= f =
Cont $ \_return ->
cnta >>- \a ->
f a >>- \b ->
_return b
Aside: Apparent Complexity
- Compare to writing these instance for Identity
- Talk about how this relates the isomorphism between
aand(a -> r) -> r
Continuing
Now that we know that there exists a Cont monad, we only need one more thing for our ultimate 1 line solution…
Traversable!
Have you used much of the function traverse, or its less general cousin mapM?
If not, hopefully you will more after today!
After I learned about map I start to see it everywhere and found that it underlied most abstractions.
After I learned about traverse I also started to see it everywhere and found that it underlied most monadic abstractions.
Traversable
Lets take a look at what Traversable offers us:
ghci> :i Traversable
type Traversable :: (* -> *) -> Constraint
class (Functor t, Foldable t) => Traversable t where
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
sequenceA :: Applicative f => t (f a) -> f (t a)
mapM :: Monad m => (a -> m b) -> t a -> m (t b)
sequence :: Monad m => t (m a) -> m (t a)
{-# MINIMAL traverse | sequenceA #-}
Intuitive Understanding
To start to get an intuitive understand of traverse tell me what type the following expression will have:
fmap :: Functor f => (a -> b) -> [a] -> [b]
foo :: Applicative f => a -> f b
xs :: [a]
fmap foo xs :: ???
Intuitive Understanding
To start to get an intuitive understand of traverse tell me what type the following expression will have:
fmap :: Functor f => (a -> b) -> [a] -> [b]
foo :: Applicative f => a -> f b
xs :: [a]
fmap foo xs :: [f b]
Intuitive Understanding
Imagine you are trying to read in a list of files, [String], using readFile :: String -> IO String.
files :: [String]
readFile :: String -> IO String
fmap readFile files :: ???
Intuitive Understanding
Imagine you are trying to read in a list of files, [String], using readFile :: String -> IO String.
files :: [String]
readFile :: String -> IO String
fmap readFile files :: [IO String]
[IO String] is probably not what you want because then you can’t use <- to get out the list of file contents in the function you are writing.
Instead you really want IO [String].
You effectively want to swap the list and the IO.
Sequence
This is where sequence comes in!
sequence :: Monad m => t (m a) -> m (t a)
traverse f ls === sequenceA (fmap f ls)
mapM f ls === sequence (fmap f ls)
The only difference between traverse and mapM is the Applicative vs Monad constraint.
Exercise: SequenceList
Write the following function:
sequenceList :: Monad m => [m a] -> m [a]
sequenceList = ???
Exercise: SequenceList
Write the following function:
sequenceList :: Monad m => [m a] -> m [a]
sequenceList [] = return []
sequenceList (ma:mas) = do
a <- ma
as <- sequenceList mas
return (a:as)
Exercise: TraverseList
Write the following function:
mapMList :: Monad m => (a -> m b) -> [a] -> m [b]
mapMList = ???
Exercise: TraverseList
Write the following function:
mapMList :: Monad m => (a -> m b) -> [a] -> m [b]
mapMList f [] = return []
mapMList f (x:xs) = do
x' <- f x
xs' <- mapMList f xs
return (x:xs)
Basically the same as sequenceList, except we apply f to get a Monad instead of it just already being one.
Connecting It All Together
hcc :: Term -> (Term -> Term) -> Term
hcc t _return = case t of
PrimApp p [] ->
_return (PrimApp p [])
PrimApp p [t1] ->
hcc t1 (\v1 -> _return (PrimApp p [v1]))
PrimApp p [t1, t2] ->
hcc t1 (\v1 -> hcc t2 (\v2 -> _return (PrimApp p [v1, v2])))
Now what if I rewrote it a bit…
Connecting It All Together
hcc :: Term -> (Term -> Term) -> Term
hcc t _return = case t of
PrimApp p [] ->
_return (PrimApp p [])
PrimApp p [t1] ->
hcc t1 (\v1 ->
_return (PrimApp p [v1]))
PrimApp p [t1, t2] ->
hcc t1 (\v1 ->
hcc t2 (\v2 ->
_return (PrimApp p [v1, v2])))
Now what if I factored out the PrimApp p part since it is always the same…
Connecting It All Together
Recall our original problem:
hcc :: Term -> (Term -> Term) -> Term
hcc t _return = case t of
PrimApp p [] ->
_return []
PrimApp p [t1] ->
hcc t1 (\v1 ->
_return [v1])
PrimApp p [t1, t2] ->
hcc t1 (\v1 ->
hcc t2 (\v2 ->
_return [v1, v2]))
Can you see it yet!!??
Rewriting MapMList
What if I wasn’t too sure how to write mapMList, I might start to write it like this:
mapMList :: Monad m => (a -> m b) -> [a] -> m [b]
mapMList f xs = case xs of
[] ->
return []
[x1] -> do
x1' <- f x1
return [x1']
[x1, x2] -> do
x1' <- f x1
x2' <- f x2
return [x1', x2']
Rewriting MapMList
hcc t _return = case t of
PrimApp p [] ->
_return []
PrimApp p [t1] ->
hcc t1 (\v1 ->
_return [v1])
PrimApp p [t1, t2] ->
hcc t1 (\v1 ->
hcc t2 (\v2 ->
_return [v1, v2]))
mapMList f xs = case xs of
[] ->
return []
[x1] -> do
x1' <- f x1
return [x1']
[x1, x2] -> do
x1' <- f x1
x2' <- f x2
return [x1', x2']
Rewriting MapMList
hcc t _return = case t of
PrimApp p [] ->
_return []
PrimApp p [t1] ->
hcc t1 (\v1 ->
_return [v1])
PrimApp p [t1, t2] ->
hcc t1 (\v1 ->
hcc t2 (\v2 ->
_return [v1, v2]))
mapMList f xs = case xs of
[] ->
return []
[x1] ->
f x1 >>= \x1' ->
return [x1']
[x1, x2] ->
f x1 >>= \x1' ->
f x2 >>= \x2' ->
return [x1', x2']
Its just mapM!!!! (with a fmap (PrimApp p))
The Payoff!
Are you ready for it!?
-- :: Term -> (Term -> Term) -> Term
hcc :: Term -> Cont Term Term
hcc (PrimApp p ts) = fmap (PrimApp p) (mapM hcc ts)