Instrumentation.lhs

This is an example of how using "fix" and open recursion lets us instrument
functions in a way reminiscent of aspect-oriented programming.

We are going to take an evaluator function for a simple expression language,
and augument it with an interactive debugger. 

But first, the unavoidable dance of extensions and imports:

> {-# LANGUAGE ScopedTypeVariables #-}
> {-# LANGUAGE MultiWayIf #-}
> 
> module Main (main) where
> 
> import Data.Function (fix)
> import Data.Functor.Identity
> import Data.List (intercalate)

Consider this datatype for simple mathematical expressions:
 
> data Exp = Val Int
>          | Add Exp Exp
>          | Mul Exp Exp
>          deriving (Read,Show)
 
We can write the following evaluation function for it:

> eval :: Exp -> Int
> eval e = case e of
>     Val int -> int
>     Add e1 e2 -> eval e1 + eval e2
>     Mul e1 e2 -> eval e1 * eval e2
 
This works, but what if we wanted to inspect how intermediate results are
calculated, or to change some intermediate result in an interactive way? As
defined, the function is pretty monolithic. It fully controls its own
recursion, and there isn't any seam that could enable us to inject new
behaviour. 

Let's generalize "eval" in two ways. 

First, instead of direct recursion, let's open the recursion and pass as an
argument the function to be used for the sub-calls. 

Second, wrap the result of the evaluator in a monad, but make the evaluator
polymorphic over all monads. This maintains purity because the evaluator can't
perform any concrete effect.

This is the generalized evaluator:

> eval' :: forall m . Monad m => (Exp -> m Int) -> (Exp -> m Int)
> eval' rec e = case e of
>     Val int -> pure int
>     Add e1 e2 -> (+) <$> rec e1 <*> rec e2
>     Mul e1 e2 -> (*) <$> rec e1 <*> rec e2

We can always recover the original evaluation function by closing the recursion
using fix, and setting the ambient monad to be Identity: 

> boring :: Exp -> Int
> boring e = runIdentity $ fix eval' e

Notice by the way that the type of fix

< fix :: (a -> a) -> a

is a bit misleading, in that it bad things (as in, infinite loops) happen with
many function values that we can pass as argument. 

For example, if you try to fix a function like "not" or "succ", you'll get an
infinite loop. Ditto for "id". It'll work for our evaluator, though.

Ok, we have generalized the evaluation function, and we have found a way to
recover the original evaluator. But the whole point of generalizing was to
extend the evaluator in interesting ways. How to do that?
 
Look at this type synonym:

> type Instrumentation m i r = ((i -> m r) -> (i -> m r)) -> (i -> m r) -> (i -> m r)

It's a function that takes as parameter an open recursive function, and returns
another open recursive function with, presumably, some new behaviour. 

From another point of view, it's a function that takes as parameters an open
recursive function, a function to use when we want to instrument sub-calls, and
the current input, and returns the result for the current input.

What would be the do-nothing Instrumentation? The identity function of course.
Or, being a bit more explicit about the arguments:

> nop :: Instrumentation m i r
> nop base rec e =  
>     base rec e

We apply the instrumentation before fixing the evaluator:

> boring' :: Exp -> Int
> boring' e = runIdentity (fix (nop eval') e)
 
Now let's go for something more interesting. Let's write an interactive
debugger that lets us step through the evaluation with a series of commands,
potentially overriding the return value of some subexpressions. 

We'll work in the IO monad. Notice that we aren't tied to the Exp type; we only
require some Read and Show constraints: 

> debugger :: forall e r . (Show e, Show r, Read r) => Instrumentation IO e r
> debugger base rec e = do

We have the current expression in scope. Let's show it, and then ask the user
what he wants to do:

>     putStrLn $ "current expression: " ++ show e
>     let cmds@[giveValue, stepOver, stepReturn, _] = ["give value", "step over", "step return", "or <ENTER> to step into"]
>     putStrLn $ "what to do? " ++ intercalate ", " cmds ++ ":"
>     cmd <- getLine

If the user wants to override the return value of the current expression, we
simply ask him for the value and return it. We don't recurse at all.

>     if 
>        | cmd == giveValue ->
>             do  putStrLn $ "specify a value: "
>                 value <- read <$> getLine
>                 return value

If the user doesn't want to step into each of the sub-expressions of the
current expression, we fix the uninstrumented function and apply it to the
current expression.

>        | cmd == stepOver ->
>             fix base e

If the user wants to know the result value of the current expression, we show
it after running the evaluation.

>        | cmd == stepReturn ->
>             do r <- fix base e
>                putStrLn $ "return value is: " ++ show r
>                return r

What if the user wants to step into the sub-expressions of the current
expression? What should we pass as argument to the open recursive function that
we are instrumenting? 

We can't simply fix the function outright as before, because we want to add the
debugging behaviour. What we need to do is to pass the sub-expression handler
rec that we have in scope. That handler carries the debugging behaviour. Well,
it *will* carry it, once we fix the function that results from instrumenting
the evaluator. This is the hardest part to wrap your head around IMHO.

>        | cmd == "" -> 
>             base rec e
 
Here's an example expression to play with:

> val :: Exp
> val = Add (Mul (Val 2) (Val 3)) (Add (Val 5) (Add (Val 11) (Val 13)))
 
Putting our debugger to work:

> main :: IO ()
> main = do
>     result <- fix (debugger eval') val
>     print result

An interesting follow-up exercise would be to add instructions to stop only at
certain constructors of Exp. To stop only at multiplications, for example. How
to do this without tying the debugger to Exp?

Here's a bunch of links related to open recursion:

https://gist.github.com/danidiaz/36f5647c0968361eedd677ad3870715f#file-open-recursion-reading-list-md