Functional Programming in...Ada?

Ada is not the first language that comes to mind when you want to do functional programming. (You in the back, stop laughing!) Why, with excellent functional programming languages like Haskell or ML easily available, would I choose to do a functional programming project in Ada? (I CAN STILL HEAR YOU LAUGHING!) Partly because we use Ada in some courses at our institution, and I wanted a library that could help in teaching recursion to novices. But, honestly, mostly I just wanted to see if it could be done.

“It's like this fellow I knew in El Paso. One day, he just took all his clothes off and jumped in a mess of cactus. I asked him that same question, ‘Why?’...He said, ‘It seemed like a good idea at the time.’”

– Steve McQueen, The Magnificent Seven

Somewhat to my surprise, functional programming actually works reasonably well in Ada. You wouldn't want to program a large system this way, but small-scale projects are quite possible, albeit much more verbose than functional programmers are used to.

Instrumenting recursive functions

My application is going to be a library for instrumenting recursive functions. I want to be able to take a recursive function and run it with different combinations of monitors. Each monitor executes a little bit of extra code every time the recursive function is called, including recursive calls. Simple examples of useful monitors include counting the number of calls, or tracking the maximum call depth, or printing trace information on every call or return. More complicated examples include adding memoization to a recursive function or automatically detecting when a function is stuck in an infinite recursion.

Ideally, the library should be easy enough for students to use, but I'll settle for it being easy enough for instructors to use.

Of course, there are many ways to design such a library. I'm going to use a design based on ideas from functional programming. The basic ideas have been folklore in the functional programming community for a long time. For example, I remember doing something similar in SML in the early '90s. Bruce McAdam wrote a nice tech report describing these techniques in great detail. The trick here is going to be figuring out how to implement this design in Ada.

(Incidentally, if anybody has a truly object-oriented approach to solving the same problem, I'd be interested in seeing it.)

Preparing the recursive function

Without some kind of support for reflection, it seems too much to hope that I'll be able to observe the recursive calls inside a recursive function. Therefore, I'm willing to require some modifications to the recursive function, as long as those modifications are fairly straightforward. However, I should only need to modify the function once, rather than every time I run it with a different monitor.

Stealing an idea from functional programming called the Y combinator, I'll modify each recursive function to take an extra argument that is itself a function (or, more specifically, a pointer to a function). The recursive function will call this passed-in function wherever it would normally call itself. The passed-in function will eventually call the recursive function, but may run some other code first.

Here's an example using the ever popular Fibonacci function. The original recursive function might be written

 function Fib(X : Integer) return integer is
 begin
   if X <= 1 then
     return 1;
   else
     return Fib(X-1) + Fib(X-2);
   end if;
 end Fib;

Adding the extra argument and replacing the recursive calls with calls to the passed-in function yields

 function Fib(Rec : access function(X : Integer)
                    return Integer;
              X : Integer) return integer is
 begin
   if X <= 1 then
     return 1;
   else
     return Rec(X-1) + Rec(X-2);
   end if;
 end Fib;

where the changes are shown in red. Note that access function(X : Integer) return Integer is the type of a pointer to a function that takes an integer and returns an integer. In the rest of this post, I'll assume that the functions being instrumented always take an integer and return an integer. If I can get this to work at all, then generalizing this to arbitrary argument and return types will be trivial using Ada's notion of generics.

Running the recursive function

Now, to simply run this function recursively without attaching a monitor, I'll call it with Run, which is responsible for “tying the knot” by somehow making the function call itself. The Run function is written

 function Run(Fun : ...type to be filled in 
                       later...
              X : Integer) return Integer is
   function Rec(X : Integer) return Integer is
   begin
     Fun(Rec'Access, X);
   end Rec;
 begin
   return Rec(X);
 end Run;

Here, Fun is a function like the modified Fib above. Run defines a local helper functon, Rec, that merely passes itself to Fun.

I would call this function by writing something like

   ...Run(Fib'Access, 10)...

where Fib'Access is Ada-speak for a pointer to the Fib function. This calls Rec(10), which calls Fib(Rec'Access,10), which in turn calls Rec(9), which in turn calls Fib(Rec'Access,9), and so on. Eventually, the whole thing returns 89, as expected.

I left out the type of Fun above, because it starts to get unwieldy. I can figure out what this type should be by looking at the type of Fib. The full signature of Run is

 function Run(Fun : access function
                (Rec : access function(X:Integer)
                       return Integer;
                 X : Integer) return Integer;
              X : Integer) return Integer;

A small lie

What I'd really like to be able to do is define a type abbreviation

 type Fun_Type is access function
   (Rec : access function(X:Integer)
          return Integer;
    X : Integer) return Integer;

and then write the signature of Run as

 function Run(Fun : Fun_Type; 
              X : Integer) return Integer;

Unfortunately, I can't. Or rather, I can, but it turns out to be useless. The problem is that Ada is really paranoid about what you do with pointers to functions. In particular, it won't let a pointer to a function match a named type if that function is defined in a deeper lexical scope than the type definition. This restriction does not apply to so-called anonymous access types, so I'm forced to rewrite the entire type everywhere it's used rather than giving it a name and referring to the name.

However, to simplify the presentation, I'm going to pretend that I can use Fun_Type as defined above. Just remember that, in the real implementation, every occurrence of Fun_Type needs to be replaced with the more verbose anonymous type. I'll write Fun_Type in italics as a reminder that it's not the real code.

A simple monitor

Now, here is a simple monitor that counts the number of calls to the recursive function, and prints out that number at the end.

 function Count(Fun : Fun_Type;
                X : Integer) return Integer is

   Num_Calls : Integer := 0;

   function My_Fun
       (Rec : access function(X:Integer) 
              return Integer;
        X : Integer) return Integer is
   begin
     Num_Calls := Num_Calls + 1;
     return Fun(Rec,X);
   end My_Fun;

   Result : Integer := Run(My_Fun'Access,X);
 begin
   Put("Number of calls = ");
   Put(Num_Calls,0);
   New_Line;
   return Result;
 end Count;

Now, when I call

   Put( Count(Fib'Access,10) );

I get

Number of calls = 177
         89

where the first line is printed by the monitor and the second line is printed by the external Put.

The Count monitor creates a new function My_Fun to give to Run. My_Fun simply increments Num_Calls and calls Fun. Now, every time Fun makes a recursive call to Rec, Rec will call My_Fun, which calls Fun.

So basically, Count “wraps” Fun with a little bit of code to increment the Num_Calls variable, and this code gets executed every time the Rec function is called.

In addition, Count does a little bit of work around the top-level recursive call, namely initializing the Num_Calls variable to 0, and printing the number of calls at the end.

A memoization monitor

Here's a more complicated monitor. This one modifies the recursive function to do memoization (first cousin to dynamic programming). The idea is that, when a function is called multiple times on the same arguments, you can save time by remembering those arguments and the corresponding results. Then when the function is called with arguments you have seen before, you can simply return the stored result, instead of recomputing it.

 function Memoize(Fun : Fun_Type; 
                  X : Integer) return Integer is

   Results : array (0..X) OF Integer;
   Ready   : array (0..X) OF Boolean 
               := (others => False);

   function My_Fun
       (Rec : access function(X:Integer) 
              return Integer;
        X : Integer) return Integer is
   begin
     if not Ready(X) then
       Results(X) := Fun(Rec,X);
       Ready(X) := True;
     end if;
     return Results(X);
   end My_Fun;

 begin
   return Run(My_Fun'Access,X);
 end Memoize;

The difference can be dramatic.

   ...Memoize(Fib'Access, 30)...

executes the body of Fib a total of 31 times, whereas

   ...Run(Fib'Access, 30)...

executes the body of Fib almost 2.7 million times (2692537 times, to be exact).

I made an assumption above that, if the original argument was X, then the range of possible arguments in all the calls is 0..X. This is good enough to illustrate the idea, but a more general implementation might be parameterized by the bounds to use, or by a function that calculates those bounds from the original X.

Multiple monitors

How did I know above that Run executes the body of Fib 2692537 times? By running Fib with the Count monitor. How did I know that Memoize executes the body of Fib 31 times? By running Fib with both the Memoize and Count monitors together.

Except that, as currently written, the Memoize and Count monitors can't be used together. I can run Fib with one or the other, but not both simultaneously.

What I want is a way to layer one monitor on top of another, building arbitrary stacks of monitors. The clues to how to do this are already in the current implementations of Memoize and Count.

Notice that both Memoize and Count have the same interface as Run. In other words, a monitor is an alternative run function that adds some extra machinery to the basic Run. Further, notice that both Memoize and Count build a My_Fun function by wrapping some extra code around Fun and then run My_Fun using the Run function. The key insight is that we can parameterize Memoize and Count by which run function to use for running My_Fun. That might be the basic Run function, but it might also be a run function corresponding to a different monitor.

To achieve this parameterization, I'll use generics instead of passing function pointers. The existing definitions of Memoize and Count will still work, but they need to be preceded by additional code to take a run function as a generic parameter. For example,

 generic
   with function Run(Fun : Fun_Type; 
                     X : Integer) return Integer;
 function Count(Fun : Fun_Type; 
                X : Integer) return Integer;

 function Count(Fun : Fun_Type; 
                X : Integer) return Integer is
   ...
     ... Run(My_Fun'Access, X);
   ...

The new parts are in red. I didn't change the existing code of Count at all, but now the call to Run in the body of Count refers to the run function passed in as a generic parameter.

Using a monitor is now a two-stage process, first instantiating the generic function to create the desired run function, and then calling that run function. For example,

 function C_Run is new Count(Run);
 function MC_Run is new Memoize(C_Run);

 ...MC_Run(Fib'Access, 30)...

Notice that the basic Run function is always used in the first instantiation, where it serves as the base of the stack of monitors.

But wait! Something strange is happening here. This program displays 59 calls, not 31 calls as expected. However, if we layer the monitors in the opposite order

 function M_Run is new Memoize(Run);
 function CM_Run is new Count(M_Run);

 ...MC_Run(Fib'Access, 30)...

then we get the 31 calls.

It's really a question of when the memoization code checks for a repeated argument relative to when the counting code increments the counter. If the memoization check happens before the increment, we get 31 calls. If the memoization check happens after the increment, we get 59 calls. Either way, the body of the original Fib function is only executed 31 times.

And that's it, really. There's still a lot of grunt work involved in fleshing out a complete, robust library, but all the important design decisions have already been made. Implementing a wide variety of monitors is fairly easy using Count and Memoize as templates.

Generics vs function pointers

One aspect of this design deserves a little more discussion. I'm mixing two different styles of passing functions as arguments, using generics in some places and function pointers in other places. Why not just use one style consistently? Because the two styles of passing around functions have different strengths and weaknesses.

One major difference is that generics work much better than function pointers when you want to return a function. For example, the generic Count monitor takes a run function and returns a run function. It's easy to imagine writing Count as

 function Count(Run : Run_Type) 
                return Run_Type is ...

where Run_Type is the appropriate access function type. But, in practice, this doesn't work because Ada lacks closures. The natural way to write this would be

 function Count(Run : Run_Type) return Run_Type is

   function My_Run(Fun : Fun_Type; 
                   X : Integer) return Integer is
     ...

 begin
   return My_Run'Access;
 end Count;

but you can't return My_Run'Access because My_Run goes away as soon as Count returns.

Note that it is possible to get around this restriction against returning function pointers by re-writing strategic code fragments in continuation-passing style, so that the function pointers in question can be passed to a continuation instead of returned. This works fine on a small scale, but quickly blows the runtime stack when attempted on a large scale.

A second major difference is that it is easier to write third-order (or even higher-order) functions using function pointers than using generics. A first-order function takes an ordinary value as an argument. A second-order function takes a first-order function as an argument. A third-order function takes a second-order function as an argument, and so on. Now, consider a monitor like Count. Count takes a Run function, which takes a Fun function, which takes a Rec function, so Count is fourth-order!

Currently, I pass the Run functions using generics, but the Fun functions using function pointers. (Ignore the Rec functions for now.) Suppose I wanted to pass both Run functions and Fun functions using generics. This would mean that each Run function would take its Fun function as a generic parameter. But that means that, when we pass a Run function to a monitor like Count, we need to pass it as a generic function. In other words, Count would need to be a generic function that takes a generic function as an argument. That's not allowed in Ada. Or, more truthfully, it is sometimes allowed, but it's extremely painful.

In Ada, a generic function can neither take a generic function as an argument nor return a generic function as a result. However, a package can contain generic components, so you can sometimes fake it wrapping the argument or result in a package. For example, you can fake a generic function that returns a generic function by writing a generic package that contains a generic function as a component.

In a limited way, you can do the same thing in the other direction. If you want a generic function to take a generic function as an argument, you can fake it by wrapping the argument in a package, so that the outer generic function takes a package (which contains a generic function as a component). The catch is that you can't instantiate the outer generic function with just any old package meeting a certain specification, but only with packages that are themselves instantiations of a single generic package. Making all that work is an exercise in pain that I leave to the most masochistic of readers.