Haskellの<$>と<*>をC++で書いてみる

はじめに

これは実用的でゎなぃ
無駄にcompile-timeを増やしているだけな気が

もともとは<$>演算子と<*>演算子を定義できないかな？
って思って試しに検討してみたものです

C++では、オーバーロードできる演算子が制限されているので
もちろんこんな事はできないです

しかし非常に近い事はできそうです
今回は<$>を<Fa>に、<*>を<Ap>に代用させて作ってみました
（好きな演算子を自由に定義できるようにならないかな・・・）

以下の順序で実装を検討します
-とても簡単な多相型(Box型)
- Maybe型の改造
-<Fa>演算子
-<Ap>演算子

Box型

部分適応した関数を保有させる必要があります
なので以前作ったものから、抜本的に改造する必要があります

今回はMaybe型からNothing判定を削った、つまりただの箱の多相型
を使って話を進めます

まず、以前のように内部変数を指定した具体型で受取るような方式を
考えてみます

途中まで考察していたのですがやめました
やはりMaybe型をベースに考えます

Maybe型（その１）

template<typename A>
struct Maybe
{
    enum{Nothing=false,Just} Opt;

    A   a_;
    Opt b_; 
    Maybe(A a):a_(a),b_(Just   ){}
    Maybe(   ):a_( ).b_(Nothing){}
    A get(){return (b_)?a_:0;}
};
template<typename A>
Maybe<A> Just(A a)
{
    return Maybe<A>(A a);
}
template<typename A=int>
Maybe<A> Nothing( )
{
    return Maybe<A>(   );
}

そのままですね
A=std::function<R(Args...)>であっても
そのまま受取ればよいです
次にfmap関数を定義します

// bind1stを定義
template<typename F,typename A>
auto bind1st(F f,A a)
{return[=](auto... args){
     return f(a,args...);
};}

// function<B(A)>とBox<A>を受取ってBox<B>を返す
template<typename B>
friend auto fmap(std::function<B(A)> f, Maybe a)->Maybe<B>
{
    // Maybeではここで評価している
    return (a.b_) ? Maybe<B>( f(a.a_) ) : Maybe<B>( );
}

// function<B(A,Args...)>とBox<A>を受取ってBox<std::function<B(Args...)>>を返す
template<typename B,typename... Args>
friend auto fmap(std::function<B(A,Args...)> f, Maybe a)->May<std::function<B(Args...)>>
{
    // Maybeではここで評価している
    return (a.b_) ? Maybe<std::function<B(Args...)>>( my::bind1st(f,a.a_) ) : Maybe<std::function<A(Args...)>>();
}

こちらは結構改造する必要があります
まずfmapが受取る関数の引数が1つとは限らなくなります

そのため
1.関数型Func<B(A)>とMaybe型Maybe<B>を受取って、Maybe型Maybe<B>を返すfmap関数と
2.関数型Func<B(A,...)>とMaybe型Maybe<B>を受取って、Maybe型Maybe<Func<B(...)>>を返すfmap関数
の2種類の関数をオーバーロードする必要があります

これはめんどくさい・・・
bind_1_関数は定形ですが
新しい型を定義するたびに、この2つのfmap関数を書かねばなりません

Maybe型（その２）

次に、そもそも関数型を保持するように改造してみます

template<typename F>
struct Maybe
{};
template<typename A,typenaem... Ts>
struct Maybe<std::function<A(Ts...)>>
{
    using F = std::function<A(Ts...)>;

    enum : bool {Nothing=false,Just} Opt;

    F   a_;
    Opt b_;
    Maybe(F a):a_(a),b_(Just   ){}
    Maybe(   ):a_( ).b_(Nothing){}
    A get(){return (b_)?a_():0;}
};
template<typename A>
Maybe<A> Just(A a)
{
    return Maybe<std::function<A()>>([=]{return a;});
}
template<typename A=int>
Maybe<A> Nothing( )
{
    return Maybe<std::function<A()>>(   );
}

以前との違いは値をそのまま保有せずにlambda式で包んで持っているところです
そのため、Just関数では引き数をlambdaに包んでコンストラクタに引き渡しています
また関数型がそのまま渡される場合のコンストラクタを定義してあげる必要があります
（変わりに値型のコンストラクタは不要になります）

また、この場合は型引数としてstd::functionで分岐する必要がないので 以下のように戻り値型と引き数型だけ受取ってもできます

template<typename A,typenaem... Ts>
struct Maybe
{
    using F = std::function<A(Ts...)>;

    enum : bool {Nothing=false,Just} Opt;

    F   a_;
    Opt b_;
    Maybe(F a):a_(a),b_(Just   ){}
    Maybe(   ):a_( ).b_(Nothing){}
    A get(){return (b_)?a_():0;}
};
template<typename A>
Maybe<A> Just(A a)
{
    return Maybe<A>([=]{return a;});
}
template<typename A=int>
Maybe<A> Nothing( )
{
    return Maybe<A>(   );
}

fmap関数の定義

HaskellではMaybe型のfmap関数は以下のように定義されています

instance Functor Maybe where
  fmap :: (a -> b) -> f a -> f b
  fmap _ (Nothing) = Nothing
  fmap f (Just a)  = just ( f a )

Maybe（その２）型にinstanceされたfmapは以下のようになります

// bind1stを定義
template<typename F,typename A>
auto bind1st(F f,A a)
{return[=](auto... args){
     return f(a,args...);
};}


template<typename A, typename... Ts>
struct Maybe {

//...

template<typename B,typename... Args>
friend auto fmap(std::function<B(A,Args...)> f, Maybe a) -> Maybe<B,Args...>
{
    // Maybeではここで評価している  -> a_ではなくa_()
    return (a.b_) ? Maybe<B,Args...>( my::bind1st(f,a_()) ) : Maybe<B,Args...>();
}

//...

};

Maybe（その１）と比較した場合に この方式は大きなメリットが一つあります
それは実装者が再定義するfmap関数が一つになる事です

liftA関数の定義

同様にしてliftA関数も定義します HaskellではMaybe型のliftA関数は以下のように定義されています

instance Applicative Maybe where
  liftA :: f (a -> b) -> f a -> f b
  liftA _ (Nothing) = Nothing
  liftA (Just f) (Just a) = Just (f a)

関数型を格納できるFanctor型クラスが
Applicative Functor型クラスになります
と言うわけで、C++での実装は以下のようになります

template<typename A, typename... Ts>
struct Maybe {

//...

template<typename B,typename... Args>
friend auto lift( Maybe<B,A,Args...> f, Maybe a) -> Maybe<B,Args...>
{
    // Maybeではここで評価している  -> a_ではなくa_()
    return (a.b_) ? Maybe<B,Args...>( my::bind1st(f.a_,a_()) ) : Maybe<B,Args...>();
}

//...

};

あとはこの二つを演算子で呼び出せれば完成です

<Fa>の定義方針

最終的にはA<Fa>Bをfmap(A,B)に置き換えます
置き換えるまでに、2つの型を経由しています

// ２つめ
template<typename F>
struct Fa_impl_{}; //dummy

template<typename R, typename Arg1, typename... Args>
struct Fa_impl_<std::function<R(Arg1,Args...)>>
{ 
    std::function<R(Arg1,Args...)> f_;

    Fa_impl_(std::function<R(Arg1,Args...)> f):f_(f){}

    template<template<typename...>class T,typename A>
    friend auto operator>(Fa_impl_ f,T<A> t)-> T<R,Args...>
    {return fmap(f.f_,t);}
};

// 1つめ
struct Fa_{ 
    template<typename F>
    friend Fa_impl_<F> operator<(F f,Fa_){return Fa_impl_<F>(f);} 
} Fa;

一つ目の型はFa_型です
この型は唯一つの関数として<演算子を持っています
<演算子はfriend関数で、引き数として右辺に自分の型(Fa_)を取ります 左辺には任意の型を取ります これは1つ以上の引き数をもつstd::function型でなければなりません この関数は返し値としてFa_impl_型の値を返します

そして二つ目の型がこのFa_impl_型です
この関数はコンストラクタと<演算子を持っています コンストラクタはクラステンプレートの型引数で指定した型を引き数に取ります ここでは部分特殊化を利用し、引き数を1つ以上持つ関数でなければ受取れないようになっています 問題なく関数型の型引き数を受取れば、実体化します >演算子はfriend関数で、引き数として左辺に自分の型(Fa_impl_)を取ります そして右辺には任意の型を取ります こちらも制限があり、Fa_impl_インスタンス化の際にクラステンプレートの型引数で指定した関数型の第1引き数と 同じ型を型引き数にもつ別のクラステンプレートのみを受取る事ができます 無事に型制約を満たし他場合にはfmap関数を呼び出しコンストラクタで受取った関数型と左辺を引き数に呼び出します

したがって、全体の処理を追って行くと、以下のようになります

std::function<B(A)> f;
Maybe<A>            m;

    auto a = f <Fa> m;
//  auto a = f < Fa > m;
//  auto a = ( f < Fa ) > m;
//  auto a = Fa_impl_{} > m;
//  auto a = fmap(f,m);

このようにして、左から順に型が置き換わっていき、最終的にfmapが呼ばれます

<Ap>の定義方針

<Fa>同様に最終的にはlift(A,B)に置き換えます

template<typename F>
struct Ap_impl_{}; //dummy
template<template<typename...>class T, typename A, typename... Args>
struct Ap_impl_<T<std::function<R(A,Args...)>>>{ 
    T<std::function<R(A,Args...)>> t_; 
    Ap_impl_(T<std::function<R(A,Args...)>> t):t_(t){}
    
    template<typename A>
    friend auto operator>(Ap_impl_ a,T<A> t) -> T<Args...>
    {return lift(a.t_,t);}
};
struct Ap_{
    template<typename F> 
    friend Ap_impl_<F> operator<(F f,Ap_){return Ap_impl_<F>(f);}
} Ap;

まとめ

後で書く

http://melpon.org/wandbox/permlink/S8OXYmKHMKoGdawI