# Continuation-Passing Style

```
-- Advanced Programming, CIS 552
-- your name, your partner's name
```

`{-# OPTIONS -Wall -fno-warn-orphans -fwarn-tabs -fno-warn-type-defaults #-}`

`module Main where`

```
import FunSyntax
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid
import Control.Monad
import Test.HUnit
```

## Preliminaries

To complete this homework, you will need to download and edit Main.hs. You will also need FunSyntax.lhs, as well as our old friends Parser.lhs, and ParserCombinators.lhs although you do not need to modify those files. Your code must typecheck against the given type signatures. Remember to add your own tests and quickcheck properties to exercise the functions you write. As always, submit your homework by uploading to the course website.

## The Cont(inuation) Monad

Consider this version of the continuation monad (slightly modified from the version that we discussed in class).

`data Cont r a = Cont { runCont :: (a -> r) -> r }`

```
instance Monad (Cont r) where
return x = Cont (\k -> k x)
m >>= f = Cont (\k -> runCont m (\a -> runCont (f a) k))
```

# Problem 1: Writing CPS programs

Rewrite the following Prelude functions in continuation-passing style, using the `Cont`

monad.

For example, we can rewrite the `even`

predicate thus:

```
even_cps :: Int -> Cont r Bool
even_cps x = return (x `mod` 2 == 0)
```

such that it has the same behavior (verifiable by quickcheck).

```
prop_even :: Int -> Bool
prop_even x = runCont (even_cps x) id == even x
```

Furthermore, the type signature that you add before each definition *must* refer to the `Cont`

monad (even if that is not the type that ghc would infer). For example, we could have also written the more general type

even_cps :: (Monad m) => Int -> m Bool

above. Instead, we specialized its type to the continuation monad.

```
-- a
add_cps = undefined
```

```
prop_add :: Int -> Int -> Bool
prop_add x y = runCont (add_cps x y) id == x + y
```

```
-- b
map_cps = undefined
```

```
prop_map :: [Int] -> Bool
prop_map x = runCont (map_cps even_cps x) id == map even x
```

```
-- c
filter_cps = undefined
```

```
prop_filter :: [Int] -> Bool
prop_filter x = runCont (filter_cps even_cps x) id == filter even x
```

```
-- d
foldr_cps = undefined
```

```
prop_foldr :: Int -> [Int] -> Bool
prop_foldr b l = runCont (foldr_cps add_cps b l) id == foldr (+) b l
```

# Problem 2: Nondeterministic programming

This problem asks you to complete some exercises from the Logic Puzzle section of SICP (as well as answer a few additional questions.) SICP is a classic intro programming book from MIT based on functional programming (using the Scheme language).

Recall from HW3 that the list monad can be made an instance of the `MonadPlus`

class. This class models searching---a general form of computation that may produce multiple results (including 0).

```
instance MonadPlus [] where
mzero = [] -- fail, produce no results
mplus c1 c2 = c1 ++ c2 -- search, combine results from c1 & c2
```

The continuation monad can also be made an instance of the `MonadPlus`

class as long as the result type `r`

is a `Monoid`

. The `Monoid`

type class is a generic structure that shows up *a lot* once you start looking for it. (Don't let the name put you off, this structure comes from abstract algebra but it's not complicated.)

Any type is a `Monoid`

if it has an associative binary operator (called `mappend`

) and an identity element for that operator (called `mempty`

). In other words, the class is defined by the following definition:

```
instance Monoid a where
mempty :: a
mappend :: a -> a -> a
```

and the following laws:

```
-- mempty is an identity element
a `mappend` mempty = a
mempty `mappend` a = a
-- mappend is associative
a `mappend` (b `mappend` c) = (a `mappend` b) `mappend` c
```

For example, lists form a monoid with `[]`

and `++`

and numbers form a monoid in several ways (with 0 and + or 1 and *).

Having the monoid operators available for the result type is exactly what we need to use the continuation monad for non-deterministic computation; failing with `mzero`

(as long as we have something to return in the case of failure) and searching with `mplus`

(as long as we have a way to combine the answers).

```
instance Monoid r => MonadPlus (Cont r) where
mzero = Cont (\_ -> mempty)
mplus c1 c2 = Cont (\k -> runCont c1 k `mappend` runCont c2 k)
```

Recall also that two useful functions for the `MonadPlus`

class are `msum`

and `guard`

, defined as follows:

```
msum :: MonadPlus m => [m a] -> m a
msum = foldr mplus mzero
guard :: MonadPlus m => Bool -> m ()
guard b = if b then return () else mzero
```

The basis of nondeterministic computation is McCarthy's `amb`

operator. This operator takes a list of values and makes an "ambiguous" choice among them. We can define this operator directly for any member of the `MonadPlus`

type class.

```
amb :: MonadPlus m => [a] -> m a
amb xs = msum (map return xs)
```

With `amb`

and `guard`

, we can write nondeterministic programs. For example, suppose we would like to find a list of all even numbers. We can do this by picking and ambiguous number from a list, failing if it is not even, and then returning it.

```
evens :: [Int]
evens = runCont cont (\x -> [x]) where
cont :: Cont [Int] Int
cont = do
x <- amb [1,2,3,4,5,6]
guard (even x)
return x
```

For a larger example, consider the *multiple-dwelling problem* from SICP.

*The following puzzle (taken from Dinesman 1968) is typical of a large class of simple logic puzzles:*

*Baker, Cooper, Fletcher, Miller, and Smith live on different floors of an apartment house that contains only five floors. Baker does not live on the top floor. Cooper does not live on the bottom floor. Fletcher does not live on either the top or the bottom floor. Miller lives on a higher floor than does Cooper. Smith does not live on a floor adjacent to Fletcher's. Fletcher does not live on a floor adjacent to Cooper's. Where does everyone live?*

SICP shows how to encode this problem as a nondeterministic program. The program tries all combinations of floors for each person, and then uses the requirements listed in the problem description to prune out invalid combinations until there is only one remaining possibility.

```
multipleDwelling :: Cont [r] (Int,Int,Int,Int,Int)
multipleDwelling = do
baker <- amb [1 .. 5]
cooper <- amb [1 .. 5]
fletcher <- amb [1 .. 5]
miller <- amb [1 .. 5]
smith <- amb [1 .. 5]
guard (distinct [baker, cooper, fletcher, miller, smith])
guard (baker /= 5)
guard (cooper /= 1)
guard (fletcher /= 5)
guard (fletcher /= 1)
guard (miller > cooper)
guard (not (adjacent smith fletcher))
guard (not (adjacent fletcher cooper))
return (baker, cooper, fletcher, miller, smith)
```

```
distinct :: Eq a => [a] -> Bool
distinct [] = True
distinct (x:xs) = all (x /=) xs && distinct xs
```

```
adjacent :: (Num a, Eq a) => a -> a -> Bool
adjacent x y = abs (x - y) == 1
```

`-- a )`

Modify the multiple-dwelling procedure to omit the requirement that Smith and Fletcher do not live on adjacent floors. How many solutions are there to this modified puzzle?

`-- b )`

In the multiple dwelling problem, how many sets of assignments are there of people to floors, both before and after the requirement that floor assignments be distinct? It is very inefficient to generate all possible assignments of people to floors and then leave it to backtracking to eliminate them. For example, most of the restrictions depend on only one or two of the person-floor variables, and can thus be imposed before floors have been selected for all the people. Write and demonstrate a much more efficient nondeterministic procedure that solves this problem based upon generating only those possibilities that are not already ruled out by previous restrictions.

`-- c )`

Now use `amb`

to solve the following puzzle:

*Mary Ann Moore's father has a yacht and so has each of his four friends: Colonel Downing, Mr. Hall, Sir Barnacle Hood, and Dr. Parker. Each of the five also has one daughter and each has named his yacht after a daughter of one of the others. Sir Barnacle's yacht is the Gabrielle, Mr. Moore owns the Lorna; Mr. Hall the Rosalind. The Melissa, owned by Colonel Downing, is named after Sir Barnacle's daughter. Gabrielle's father owns the yacht that is named after Dr. Parker's daughter. Who is Lorna's father?*

Try to write the program so that it runs efficiently (see part b above). Also determine how many solutions there are if we are not told that Mary Ann's last name is Moore.

```
data Father = MrMoore
| ColonelDowning
| MrHall
| SirBarnacleHood
| DrParker
deriving (Enum, Eq, Ord, Bounded, Show)
```

```
data Daughter = MaryAnn | Gabrielle | Lorna | Rosalind | Melissa
deriving (Enum, Eq, Ord, Bounded, Show)
```

`type Yacht = Daughter`

```
yachts :: Cont [r] (Map Father Daughter, Map Father Yacht)
yachts = undefined
```

# Problem 3: Regular Expressions

We can also use nondeterministic programming to implement a regular expression matcher. Recall the datatype for regular expressions from HW 3:

```
data RegExp = Char Char -- single literal character
| Alt RegExp RegExp -- r1 | r2 (alternation)
| Seq RegExp RegExp -- r1 r2 (concatenation)
| Star RegExp -- r* (Kleene star)
| Empty -- ε, accepts empty string
| Void -- ∅, always fails
deriving (Eq, Show)
```

Consider a function with this type.

`acc :: RegExp -> String -> Cont Any String`

`acc = undefined`

Note that the type `Any`

is isomorphic to `Bool`

and defined in the `Data.Monoid`

module. There are several valid instances of the `Monoid`

class for the Boolean type, the `newtype Any`

indicates which one is the appropriate one for this code.

Your job for this problem is to implement `acc`

. How might you do this?

Intuitively, `acc`

matches some initial segment of the given string against the given regular expression, and passes the corresponding final segment to the continuation (a function of type `String -> Bool`

), which determines the final outcome.

For example, for the regular expression that accepts the empty string, we know that the initial segment is empty. So in that case we can just pass the entire string to the continuation. For a regexp containing a single character, the initial segment must be exactly that character. If it is, we can pass the rest of the string to the continuation. If not, the matcher should fail. Likewise, the regexp that never accepts any strings can also immediately fail. For `Alt`

, the matcher can nondeterministically try both cases, first trying the left branch, and if that fails, switching to the right.

The real power of this approach comes with `Seq`

. We don't need to split up the string into all combinations up front and try them individually. Instead we can just call `acc`

recursively on the first regexp, and then have it continue to the second regexp when necessary.

With `acc`

, we can implement the `accept`

function from HW3 by providing a continuation that checks to see if the remaining string is empty.

```
accept :: RegExp -> String -> Bool
accept r s = getAny $ runCont (acc r s) (Any . null)
```

Optional challenge: In the case for `Star`

, it is tempting to define:

`acc (Star r) cs = acc (Alt Empty (Seq r (Star r))) cs`

But that definition is not *quite* right. It will work for most regular expressions, but there are some pathological cases where it fails. What is an example of a troublesome regexp? (If you are stumped, quickcheck can help.) As a challenge, modify this case of `acc`

so that it is successful for these troublesome regexps.

# Problem 4: The FUN CPS interpreter

The nice thing about writing programs in continuation-passing style is that you don't *always* have to use the continuation. The continuation is available, but it can be discarded. This has the effect of immediately terminating the computation.

For example, we can add an 'abort' operation, that immediately terminates any computation (with a given result) by discarding the continuation.

```
abort :: r -> Cont r a
abort r = Cont (\_ -> r)
```

In an interpreter written in continuation-passing style, we can use abort as a better treatment for run-time errors. Suppose we extend values with a new case for error messages:

```
data Value =
IntVal Int
| BoolVal Bool
| FunVal (Value -> Cont Value Value)
-- new! specialized values for signaling errors
| ErrorVal Error
```

```
data Error = BooleanOpMismatch Bop Value Value
| ParseError String
-- you will need to add other constructors to describe the various runtime
-- errors from the interpreter
deriving (Show, Eq)
```

```
instance Show Value where
show (IntVal i) = show i
show (BoolVal b) = show b
show (FunVal _) = "<function>"
show (ErrorVal e) = show e
```

```
instance Eq Value where
IntVal i == IntVal j = i == j
BoolVal i == BoolVal j = i == j
FunVal _ == FunVal _ = error "Functions cannot be compared"
ErrorVal e == ErrorVal f = e == f
_ == _ = False
```

Then, in a continuation-passing version of `evalB`

, we can immediately halt the computation with a runtime error, no matter what context we are in.

```
evalB :: Bop -> Value -> Value -> Cont Value Value
evalB Plus (IntVal i1) (IntVal i2) = return $ IntVal (i1 + i2)
evalB Minus (IntVal i1) (IntVal i2) = return $ IntVal (i1 - i2)
evalB Times (IntVal i1) (IntVal i2) = return $ IntVal (i1 * i2)
evalB Gt (IntVal i1) (IntVal i2) = return $ BoolVal (i1 > i2)
evalB Ge (IntVal i1) (IntVal i2) = return $ BoolVal (i1 >= i2)
evalB Lt (IntVal i1) (IntVal i2) = return $ BoolVal (i1 < i2)
evalB Le (IntVal i1) (IntVal i2) = return $ BoolVal (i1 <= i2)
evalB b v1 v2 = abort (ErrorVal (BooleanOpMismatch b v1 v2))
```

Another use we can make of continuations in a CPS interpreter is in the implementation of exception handling.

Suppose that the environment for the interpreter can store not just the values of variables, but also a stack of exception handlers:

```
data Environment = Environment
{ vars :: Map Variable Value, handlers :: [Handler] }
```

```
extend :: Variable -> Value -> Environment -> Environment
extend x v s = s { vars = Map.insert x v (vars s) }
```

```
pushHandler :: Handler -> Environment -> Environment
pushHandler h s = s { handlers = h : (handlers s) }
```

Where an exception handler is just a continuation:

`type Handler = Value -> Value`

In this case we can implement `Try`

by adding a new exception handler to the stack while evaluating the body of the `Try`

expression, and implement `Throw`

by selecting the top handler from the list and passing it the exception value.

Your job for this problem is to:

Convert the continuation passing style interpreter from lecture to use the

`Cont`

monad.Add calls to

`abort`

for*all*runtime errors, adding new variants to the`Error`

data structure. Your interpreter should never return`IntVal 0`

unless that is the actual value of the expression.Extend the interpreter with the implementation of

`Throw`

and`Try`

expressions using continuations.

```
evalK :: Expression -> Environment -> Cont Value Value
evalK = undefined
```

```
eval :: Expression -> Value
eval e = runCont (evalK e (Environment Map.empty [])) id
```

```
re :: String -> Value
re line =
case parse line of
Just e -> eval e
Nothing -> ErrorVal (ParseError line)
```

```
tests :: Test
tests = TestList [ re "throw 3" ~?= IntVal 3,
re "try throw 1 catch X with X + 2 endwith" ~?= IntVal 3,
re "try 1 + 2 catch X with X + 3 endwith" ~?= IntVal 3,
re "try (try throw 1 catch X with throw X + 1 endwith) catch Y with Y + 1 endwith" ~?= IntVal 3,
re "try (try throw 1 catch X with X + 2 endwith) catch Y with Y + 4 endwith" ~?= IntVal 3]
```

```
repl :: IO ()
repl = do
putStr "%> "
line <- getLine
putStrLn $ show (re line)
repl
```

## News :

Welcome to CIS 552!

See the home page for basic
information about the course, the schedule for the lecture notes
and assignments, the resources for links to the required software
and online references, and the syllabus for detailed information about
the course policies.