In a prior entry we proposed a Boost.MPL-based representation of monads in C++ template metaprogramming. Let us exercise this framework by translating the resource monad R described in section 9.3 of Hudak et al. A Gentle Introduction to Haskell 98. You are advised to familiarize yourself with the original formulation of the resource monad in Haskell before reading the following. Good knowledge of Boost.MPL is also required.
Resource monads store functions from some Resource type to (Resource, Either a (R a)); the function expresses a computation that consumes resources and returns the remaining resource supply along with the result of the computation or a "suspended" computation in the form of an unevaluated resource monad if resources were exhausted.
data R a = R (Resource -> (Resource, Either a (R a)))
This translates to C++ TMP simply as
template<typename C>
struct RMonad
{
typedef C value_type;
};
We cannot narrow down the kind of arguments accepted by RMonad because C++ TMP is basically untyped, so it is assumed that C is a proper metafunction class. The nested value_type definition allows us to access C without resorting to pattern matching via partial specialization, which simplifies some of the code below. Haskell pairs can be modeled by boost::mpl::pair; as for Either, we can simply translate their Left and Right data constructors:
template<typename T>struct left;
template<typename T>struct right;
The monad operations of
R are defined like this:
instance Monad R where
R c1 >>= fc2 = R (\r -> case c1 r of
(r', Left v) -> let R c2 = fc2 v in
c2 r'
(r', Right pc1) -> (r', Right (pc1 >>= fc2)))
return v = R (\r -> (r, (Left v)))
The semantics of these constructs is explained in the original source. The translation to C++ TMP consists in partially specializing the metafunctions mbind and mreturn as follows:
template<typename C1,typename FC2>
struct mbind<RMonad<C1>,FC2>
{
struct C
{
template<typename R>
struct apply
{
template<typename _>
struct impl;
template<typename R1,typename V>
struct impl<pair<R1,left<V> > >
{
typedef typename boost::mpl::apply<
typename boost::mpl::apply<FC2,V>::type::value_type,
R1
>::type type;
};
template<typename R1,typename PC1>
struct impl<pair<R1,right<PC1> > >
{
typedef pair<
R1,
right<typename mbind<PC1,FC2>::type>
> type;
};
typedef typename impl<
typename boost::mpl::apply<C1,R>::type
>::type type;
};
};
typedef RMonad<C> type;
};
template<typename _,typename V>
struct mreturn<RMonad<_>,V>
{
struct C
{
template<typename R>
struct apply
{
typedef pair<R,left<V> > type;
};
};
typedef RMonad<C> type;
};
Despite the imposing look of the code above, the translation is straightforward once one grasps the overall structure of the definitions: so, in the mapping of >>= to C++ TMP, C corresponds to the anonymous function in the Haskell definition; the case construct on c1 r is translated by means of the impl auxiliary class template, which is partially specialized according to the patterns (r', Left v) and (r', Right pc1). The names of the variables involved are kept consistent to aid the reader: c1 becomes C1, fc2 becomes FC2 and so on.
In line with the original exposition, we assume that the type Resource is simply an integer: each computation decreases the resource count by one until 0 is reached. This process is performed by the step function:
step :: a -> R a
step v = c where
c = R (\r -> if r /= 0 then (r-1, Left v)
else (r, Right c))
In C++ TMP we will model integers by means of
boost::mpl::int_ and implement
step as the following metafunction:
template<typename V>
struct step
{
struct C
{
template<typename R>
struct apply:
if_c<
R::value!=0,
pair<int_<R::value-1>,left<V> >,
pair<R,right<RMonad<C> > >
>
{};
};
typedef RMonad<C> type;
};
Whereas in the Haskell definition c is the local name for the returned monad, which recursively mentions itself, in C++ TMP is simpler to implement this recursivity by letting the local struct C refer to the metafunction contained inside RMonad rather than the RMonad instantiation proper. Other than this, the translation is direct.
step is used to lift unary and binary functions from regular types to their mapped types in the resource monad world so that the resulted lifted functions operate analogously, but adding resource consumption to the computation:
lift1 :: (a -> b) -> (R a -> R b)
lift1 f = \ra1 -> do a1 <- ra1
step (f a1)
lift2 :: (a -> b -> c) -> (R a -> R b -> R c)
lift2 f = \ra1 ra2 -> do a1 <- ra1
a2 <- ra2
step (f a1 a2)
How do we simulate the do notation in C++ TMP? Fortunately, we need not do it, since do is just syntactic sugar and can be dispensed with using the transformation:
do p <- e1; e2 = e1 >>= \p -> e2
So the definitions of lift1 and lift2 can be rewritten as:
lift1 :: (a -> b) -> (R a -> R b)
lift1 f = \ra1 -> (ra1 >>= \a1 -> step (f a1))
lift2 :: (a -> b -> c) -> (R a -> R b -> R c)
lift2 f = \ra1 ra2 -> (ra1 >>= \a1 -> ( ra2 >>= \a2 -> step (f a1 a2)))
Using this formulation, the translation to C++ TMP poses no particular problems:
template<typename F>
struct lift1
{
struct type
{
template<typename RA1>
struct apply
{
struct FC
{
template<typename A1>
struct apply
{
typedef typename step<
typename boost::mpl::apply<F,A1>::type
>::type type;
};
};
typedef typename mbind<RA1,FC>::type type;
};
};
};
template<typename F>
struct lift2
{
struct type
{
template<typename RA1,typename RA2>
struct apply
{
struct FC1
{
template<typename A1>
struct apply
{
struct FC2
{
template<typename A2>
struct apply
{
typedef typename step<
typename boost::mpl::apply<F,A1,A2>::type
>::type type;
};
};
typedef typename mbind<RA2,FC2>::type type;
};
};
typedef typename mbind<RA1,FC1>::type type;
};
};
};
Arithmetic operations are lifted to the resource monad like this:
instance Num a => Num (R a) where
(+) = lift2 (+)
(-) = lift2 (-)
negate = lift1 negate
(*) = lift2 (*)
abs = lift1 abs
fromInteger = return . fromInteger
On the other hand, == cannot be overloaded due to signature incompatibilities (the return type has to be R Bool rather than Bool), whereas if is no function at all, and cannot be used directly as its condition has to be a Bool when we need a R Bool. Consequently, alternatives are provided:
(==*) :: Ord a => R a -> R a -> R Bool
(==*) = lift2 (==)
ifR :: R Bool -> R a -> R a -> R a
ifR tst thn els = do t <- tst
if t then thn else els
Curiously, as C++ TMP is untyped and boost:mpl::if_ is not a special construct but a regular metafunction, we can partially specialize everything without the problems found in Haskell:
#define LIFT1(f) \
template<typename C> \
struct f<RMonad<C> > \
{ \
struct F \
{ \
template<typename T> \
struct apply \
{ \
typedef typename f<T>::type type; \
}; \
}; \
\
typedef typename apply< \
typename lift1<F>::type, \
RMonad<C> \
>::type type; \
};
#define LIFT2(f) \
template<typename C1,typename C2> \
struct f<RMonad<C1>,RMonad<C2> > \
{ \
struct F \
{ \
template<typename T1,typename T2> \
struct apply \
{ \
typedef typename f<T1,T2>::type type; \
}; \
}; \
\
typedef typename apply< \
typename lift2<F>::type, \
RMonad<C1>,RMonad<C2> \
>::type type; \
};
namespace boost{
namespace mpl{
LIFT1(negate)
LIFT1(next)
LIFT1(prior)
LIFT2(equal_to)
LIFT2(plus)
LIFT2(minus)
LIFT2(times)
LIFT2(divides)
LIFT2(modulus)
template<typename C,typename T1,typename T2>
struct if_<RMonad<C>,T1,T2>
{
struct impl
{
template<typename CC>
struct apply:if_<CC,T1,T2>{};
};
typedef typename mbind<RMonad<C>,impl>::type type;
};
template<typename C,typename T1,typename T2>
struct eval_if<RMonad<C>,T1,T2>
{
struct impl
{
template<typename CC>
struct apply:eval_if<CC,T1,T2>{};
};
typedef typename mbind<RMonad<C>,impl>::type type;
};
} // namespace mpl
} // namespace boost
template<int N>
struct from_int
{
typedef typename mreturn<RMonad<void>,int_<N> >::type type;
};
Note that lift1 and lift2 accept metafunction classes rather than plain metafunctions, hence the local F adaptor inside the implementation of the LIFT macros. from_int is the C++ TMP translation of the fromInteger Haskell function; unlike in Haskell, we will have to use explicitly this conversion function when needed.
We have now all the the tools to implement a factorial function on RMonad<boost:mpl::int_>:
template<typename X>
struct fact
{
struct else_:
times<
X,
typename fact<typename prior<X>::type>::type
>
{};
typedef typename eval_if<
typename equal_to<X,from_int<0>::type>::type,
from_int<1>,
else_
>::type type;
};
This looks remarkably closer to an implementation of the function for boost::mpl::int_. If you are an experienced Boost.MPL programmer you might have noticed there are a few ::types that can be omitted in the regular case: here they are needed so that the proper RMonad specializations of the arithmetic operations are invoked.
Now, these resource monads encapsulate computation, but do not automatically execute it: for instance, fact<from_int<3>::type>::type is not from_int<6>::type, but rather can be thought of as a program that will produce from_int<6>::type when fed with enough resources. This is what the original source provides the run function for:
run :: Resource -> R a -> Maybe a
run s (R p) = case (p s) of
(_, Left v) -> Just v
_ -> Nothing
run accepts a maximum number of computation steps and a resource monad; if the computation takes less than the limit run returns the output, otherwise it returns Nothing. We opt for a little different treatment of the output in our C++ TMP translation:
template<int N,typename RM>
struct run
{
template<typename _>
struct impl:int_<0>
{
enum{steps=-1};
};
template<typename R,typename V>
struct impl<pair<R,left<V> > >:V
{
enum{steps=N-R::value};
};
typedef impl<
typename apply<typename RM::value_type,int_<N> >::type
> type;
};
If the computation succeeds, the metafunction run returns the result, and the nested value ::steps additionally informs of the number of computational steps taken; if the computation runs out or resource, int_<0> is returned by convention and ::steps is set to −1.
A complete program is provided that exercises the ideas we have developed. GCC copes fine with the metacomputations involved; MSVC++ 8.0, on the other hand, seems to take inordinate amounts of memory resources during compilation: adding a couple of additional run instantiations to the program can easily bring a powerful machine to its knees.
One final note: if you play a little with fact monads you may be surprised to learn that computing the factorial of n takes (n+1)2 steps. This quadratic performance is due to the fact that the intermediate values are never reduced but instead they are executed any time they are needed: remember that resources monads represent computations, not final values.
