Category of algebras

自然数の集合Nに対して、関数f x = x * nを定義すれば、{N,f}は圏であることは明らかだろう:

objects: n
morphisms: f: n -> n'
id: f x = x * 1

そこで、fはもう一つの圏のmorphismsとして働くことができる、Haskellの例:

foo :: (Int -> Int) -> (Int -> Int -> Int) -> Int -> Int -> Int
foo f g x y = g (f x) (f y)

add = foo f (+) where f = (*2)

ここで、「f x = x * 2」がバイナリ演算子の「+」を同じくバイナリ演算子の「add」へマッピングした:

f: + -> add

勿論compositionとidのルールも成立する:

-- add2 == add3

add2 = foo ((h . g) . f) (+)
         where f = (*2)
               g = (*3)
               h = (*4)

add3 = foo (h . (g . f)) (+)
         where f = (*2)
               g = (*3)
               h = (*4)

id = (*1)

ということで、ひとつの圏が出来上がり:

objects: +
morphisms: f: + -> +'
id: f x = x * 1

このような圏をAlg(II)と呼ぶらしい。さらに特殊な情況、(上記の例のような)「+」はmonoidの場合、圏をMonと呼ぶ。MonはAlg(II)のsubcategory。

モナドも、コモナドも、あるんだよ(前篇)

さて、今回はみんな大好きなモナドだよ、まあ俺もそうだけど。

まず圏論monadから見てみよう:

Fはendofunctor*1。今私たちの手元にmorphisms f:\hspace{10}a\to Fbがある。問題は:どんな状況の下で、a,bの意味を変更する事により、fが別の圏にf:\hspace{10}a\to bのような形式になるのか?
まず、何らかの方法で二つのmorphisms f:\hspace{10}a\to Fbg:\hspace{10}b\to Fca\to Fcのような形式に「結合」しなければならない。そして、この「結合」は圏のcompositionの定義を満足しなければならない。最後、\eta{\tiny a}:\hspace{10}a\to Faを圏のidとして存在しなければならない。
この新しい圏はKleisli categoryと言い、\cal{K}と表記される。\cal{K}の構成は下記通り:

\cal{K}のobject a 元の圏のobject a
\cal{K}のmorphism f:\hspace{10}a\to{\tiny \cal{K}}b 元の圏のmorphism \hspace{10}f:a\to Fb
f\hspace{5};{\tiny \cal{K}}\hspace{5}g*2 f\hspace{5};\hspace{5}Fg\hspace{5};\hspace{5}\mu
id\tiny K,a \eta\tiny a

\mu\etaはnatural transformation:

\mu:\hspace{10}FF\to F
\eta:\hspace{10}I\to F

あと、compositionの結合則とidの定義を満足するために、\mu\etaが下記の法則を従わなければならない:

1、F\mu\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}\mu F\hspace{5};\hspace{5}\mu
2、F\eta\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}\eta F\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}idF

法則1はcompositionの結合則を保証する:

(f\hspace{5};{\tiny \cal{K}}\hspace{5}g)\hspace{5};{\tiny \cal{K}}\hspace{5}h\hspace{10}=\hspace{10}f\hspace{5};{\tiny \cal{K}}\hspace{5}(g\hspace{5};{\tiny \cal{K}}\hspace{5}h)
\equiv\hspace{10}(f\hspace{5};\hspace{5}Fg\hspace{5};\hspace{5}\mu)\hspace{5};\hspace{5}Fh\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}f\hspace{5};\hspace{5}F(g\hspace{5};\hspace{5}Fh\hspace{5};\hspace{5}\mu)\hspace{5};\hspace{5}\mu
\equiv\hspace{10}f\hspace{5};\hspace{5}Fg\hspace{5};\hspace{5}\mu\hspace{5};\hspace{5}Fh\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}f\hspace{5};\hspace{5}Fg\hspace{5};\hspace{5}FFh\hspace{5};\hspace{5}F\mu\hspace{5};\hspace{5}\mu
\equiv\hspace{10}f\hspace{5};\hspace{5}Fg\hspace{5};\hspace{5}FFh\hspace{5};\hspace{5}\mu F\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}f\hspace{5};\hspace{5}Fg\hspace{5};\hspace{5}FFh\hspace{5};\hspace{5}F\mu\hspace{5};\hspace{5}\mu           (in lhs: naturality \mu)
\equiv\hspace{10}\mu F\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}F\mu\hspace{5};\hspace{5}\mu          (f,g,h\leftarrow id)

法則2は圏におけるidの定義を保証する:

f\hspace{5};{\tiny \cal{K}}\hspace{5}id{\tiny \cal{K}}\hspace{10}=\hspace{10}f\hspace{10}=\hspace{10}id{\tiny \cal{K}}\hspace{5};{\tiny \cal{K}}\hspace{5}f
\equiv\hspace{10}f\hspace{5};\hspace{5}F\eta\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}f\hspace{10}=\hspace{10}\eta\hspace{5};\hspace{5}Ff\hspace{5};\hspace{5}\mu
\equiv\hspace{10}f\hspace{5};\hspace{5}F\eta\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}f\hspace{10}=\hspace{10}f\hspace{5};\hspace{5}\eta F\hspace{5};\hspace{5}\mu          (naturality \eta)
\equiv\hspace{10}F\eta\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}idF\hspace{10}=\hspace{10}\eta F\hspace{5};\hspace{5}\mu          (f\leftarrow id)

triple (F,\hspace{5}\mu,\hspace{5}\eta)をモナド(monad)という。

さて、次はHaskellモナドを考察してみよう:

monadクラスの定義:

class Monad m where
  (>>=) :: m a -> (a -> m b) -> m b
  return :: a -> m a

と、関数joinの定義:

join :: (Monad m) => m (m a) -> m a

こりゃ一目で分かるっしょ:

join <=> \mu
return <=> \eta

それなら >>= は何ぞ?圏論monad定義でmonadはtripleであり、tripleの中にFがあるのことを注目しよう。つまり、monadはfunctorである。
functorクラスの定義:

class Functor where
  fmap :: (a -> b) -> f a -> f b

fmap と >>= の定義が似てると思わない?ここで >>= の引数の順番をひっくり返してみよう:

  (>>=改) :: (a -> m b) -> m a -> m b

ちょっと違うな…もし >>= が fmap なら最後の結果はm bじゃなくm (m b)でしょう?えっ?m (m b)とm b?その通り、必要なものはjoinだ。
つまり:

  x >>= f = join . (fmap f) $ x 

そして:

join . fmap f <=> Ff\hspace{5};\hspace{5}\mu

Ff\hspace{5};\hspace{5}\muは何かを似てると思わない?そう、Kleisli categoryのcomposition。実際、Haskellもこのような演算子を定義している:

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
f >=> g = \x -> f x >>= g

>>= を展開すると:

f >=> g = \x -> join . (fmap g) . f $ x 

join . fmap g . f <=> f\hspace{5};\hspace{5}Fg\hspace{5};\hspace{5}\mu

完全に一致。
次はhaskellモナド則を検証してみよう:

return >>= f  ==  f                             -- 1
m >>= return  ==  m                             -- 2
m >>= (\x -> f x >>= g)  ==  (m >>= f) >>= g    -- 3
    • 1

return >>= f == f
= join . fmap f . return == f
= join . return . f == f
= join . return == id (when f = id)<=> \eta F\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}idF

    • 2

m >>= return == m
= join . fmap return $ m == m
= join . fmap return == id<=> F\eta\hspace{5};\hspace{5}\mu\hspace{10}=\hspace{10}idF

    • 3

m >>= (\x -> f x >>= g) == (m >>= f) >>= g
= m >>= (f >=> g) == (m >>= return >>= f) >>= g
= m >>= h >>= (f >=> g) == m >>= (h >=> f) >>= g ( where h = return )
= m >>= (h >=> (f >=> g)) == m >>= ((h >=> f) >=> g)
= h >=> (f >=> g) == (h >=> f) >=> g<=> h\hspace{5};{\tiny \cal{K}}\hspace{5}(f\hspace{5};{\tiny \cal{K}}\hspace{5}g)\hspace{10}=\hspace{10}(h\hspace{5};{\tiny \cal{K}}\hspace{5}f)\hspace{5};{\tiny \cal{K}}\hspace{5}g

またしても完全に一致。

以上の考察により、圏論Haskellモナドは全く同じものと言っても良いだろう。しかし、Haskellはjoinではなく>>=演算子Monadクラスのインタフェースとして定義した。まあ実用の面から考えたら当然だが、結果としてjoinの存在感が薄くなり、初心者にとって空気のような存在になるとかならないとか。joinの重要性に対してこのような扱いはあまりにも不憫しすぎだろう…

結論:joinは犠牲になったのた…>>=の犠牲にな…

(多分つづく)
追記:後篇

参考資料:
Dyads, a generalisation of monads, 1994, Maarten M. Fokkinga http://wwwhome.ewi.utwente.nl/~fokkinga/mmf94c.pdf

*1:endofunctorとはF:\hspace{10}\cal{A}\to\cal{A}のようなfunctor,つまりendofunctorのマッピング元とマッピング元は同じの圏の意味である。

*2:「;」はmorphisms compositionを意味する記号:「f\hspace{5};\hspace{5}g\hspace{10}=\hspace{10}g\hspace{5}\circ\hspace{5}f\hspace{10}=\hspace{10}gf」、まあ「g\hspace{5}\circ\hspace{5}f」の記法がHaskellの「g . f」と同じ順番だからこっちの方が好む人が多いかもしれないが…

Haskellの型システムについて

今後も使う予定なのでメモしとく。
詳細は↓の文章を参照してください:
http://en.wikibooks.org/wiki/Haskell/Category_theory

Haskellの型システムが圏であり、ここでHaskと名をつける。
Haskの要素は下表通り:

Category Hask
objects 型の集合{Int, Double, String...}
morphisms 関数: f:: a -> b
domain 上記fの型a
codomain 上記fの型b
composition 関数の結合: f . g → (f . g) . h = f . (g . h)
id id :: a -> a

特に忘れがちなのは:
objectは型であり、データの実体ではありません。
objectは型であり、データの実体ではありません。
大事なことなので(ry

Functor篇:

Category theory Haskell
funtor: F Functor classに属する型F
F:\cal{A}\to\cal{B} F: a -> F a
Ff fmap f
F{\small id}{\tiny A} = id\small FA fmap id
F(f;g)=Ff;Fg fmap (g . f) = fmap g . fmap f

Monad篇:
もなどってなに?

これ機能満載だな、数式もできるんだ...

例えば:

\Large f(x)=\int_{-\infty}^x e^{-t^2}dt

詳細は:
http://hatenadiary.g.hatena.ne.jp/keyword/%E6%95%B0%E5%BC%8F%E3%82%92%E8%A1%A8%E7%A4%BA%E3%81%99%E3%82%8B%EF%BC%88tex%E8%A8%98%E6%B3%95%EF%BC%89
http://www.forkosh.com/mimetexmanual.html
http://www.forkosh.com/mimetextutorial.html

米田の補題について

先ずはHomo functorの定義:

h(-,C): Cop -> Set

さらに:

h(-): C -> (Cop -> Set)

functor h(-) は米田埋め込み(Yoneda embedding)という名があり、Yと表記される。
米田の補題(Yoneda lemma)は下記となる:

∀F ∈ (Cop -> Set) と ∀A ∈ C, ∃ fA,F: ( h(-,A) -> F ) -> F(A), fA,Fは全単射(bijection/fully faithful)である。更に、この全単射は下記の意味ではCとFの間でnaturalの性質を持つ:

gとμを与える:
g: A' -> A in C
μ: F ⇒ F' in (Cop -> Set), 下図のようにSet中で交換可能の意味を持つ:
                        fA,F
( h(-,A) -> F ) -----------> F(A)
         |                                |
(g, μ)|                                |μA'F(g) = F'(g)μA
       |                                |
     ↓                              ↓
( h(-,A') -> F' )----------> F'(A')
                        fA',F'

抽象過ぎて全く意味分からないのでHaskellマッピングできるかを試してみた。
まずは h(-,C) を定義する:

data Homo c cop = Homo c cop deriving( Eq, Show )

instance Functor (Homo c) where
  fmap f (Homo c cop) = Homo c (f cop)

この定義ではh(Cop, C)はmorphism:( C -> Cop )の意味合いを表現できないが、今回はこいつをmorphismとして使わないから、morphismであることをこころに留めればいいと思う。
次はF、今回は特殊ケースでFもhomo functorを使うから特にすることがない。
次はfA,F:

-- h(-,A) -> F -> F(A)
bijection :: Homo c cop -> Homo c' cop' -> Homo c' c
bijection (Homo x _) (Homo y _) = Homo y x

正直微妙だね。なぜなら上記の定義から「h(-,A) -> F」がnatural transfermationのことが分からない。
まあ実際はnatural transfermationだけどね(下記μの定義を参照)。
こんな風に:

bijection :: (Homo c -> Homo c') -> Homo c' c

書ければ一番いいのだが、残念な事でできない。
あとはgとμを適当に定義して結果を見るだけだ:

myu :: Homo c cop -> Homo (Homo c c) cop
myu (Homo x y) = Homo (Homo x x) y

main :: IO ()
main = print (bijection (Homo (g "A") "_") (myu (Homo "B" "_"))) >>   -- (1), 図の↓、→ルート
       print (myu . fg $ bijection (Homo "A" "_") (Homo "B" "_")) >>  -- (2), 図の→、↓ルート
       print (f'g . myu $ bijection (Homo "A" "_") (Homo "B" "_"))    -- (3), (1-3) must be equal
         where g = \x->x++"!"
               fg = fmap g
               f'g = fmap g

Output:

Homo (Homo "B" "B") "A!"
Homo (Homo "B" "B") "A!"
Homo (Homo "B" "B") "A!"

おお!素晴らしい!米田さんマジぱねぇっす!シビれるあこがれるゥ!
結論:米田の補題について理解したとは言えないが、少し具体的なイメージを捉えた。一応収穫ありってことね。

プログラミング言語「あずにゃんペロペロ」

動機はこれを見た後:

プログラミング言語「ほむほむ」。
http://d.hatena.ne.jp/yuroyoro/20110601/1306908421

改造元はunlambda,

` あずにゃん
i → ぺロぺロ
d → ペロペロ
c → ぺロぺロ
v → ぺロぺロ
s → ぺロぺロ
k → ぺロぺロ
r → ペロぺロ
. → ペロペロ

出力コンビネータのあとに任意文字は無粋なので、"\u2a"みたいなUSC文字コードに変えた:

\u → あずにゃん
0 → ぺロぺロペロペロ
1 → ぺロぺロぺロぺロペロペロ
...

例: 下記コードは"*(\u2a)"を出力する:

ペロペロあずにゃんぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロ

という訳で、頑張って処理系を作った。
言語はC++構文解析にboost.spiritを使った:
テスト環境はubuntu10.04 + gcc4.6.1:

g++ -I$BOOST_ROOT -std=gnu++0x test.cpp

下記ソース:

#include <string>
#include <locale>
#include <clocale>
#include <iostream>
#include <stack>
#include <memory>
#include <tuple>
#include <cassert>

#include <boost/spirit/include/classic.hpp>

namespace ununlambda {

namespace combinators{

  struct combinator {
    typedef std::shared_ptr<combinator> pointer;
    typedef std::stack<pointer> stack_t;

    enum class stack_idx: unsigned int {
      idx_first,
      idx_second,
      idx_null
    };

    typedef std::stack<stack_idx> stack_idx_t;

    virtual pointer operator() ( pointer pcombi ) const = 0;

  };

  struct apply_combinator : combinator { 
    typedef combinator::pointer pointer;

    apply_combinator( pointer first, pointer second ) { first_ = first; second_ = second; }

    virtual pointer operator() ( pointer pcombi ) const { 
      return pointer();
    }

    pointer first_;
    pointer second_;
  };

  struct i_combinator : combinator {
    typedef combinator::pointer pointer;

    virtual pointer operator() ( pointer pcombi ) const {
      return pcombi;
    }
  };

  struct d_combinator : combinator { 
    typedef combinator::pointer pointer;

    virtual pointer operator() ( pointer pcombi ) const {
      return pointer();
    }
  };

  struct d0_combinator : combinator { 
    typedef combinator::pointer pointer;

    d0_combinator( pointer first ) : first_(first) {}

    virtual pointer operator() ( pointer pcombi ) const {
      return pointer();
    }

    pointer first_;
  };

  struct c_combinator : combinator {
    typedef combinator::pointer pointer;

    virtual pointer operator() ( pointer pcombi ) const {
      return pointer();
    }
  };

  struct cont_combinator : combinator { 
    typedef combinator::pointer pointer;

    virtual pointer operator() ( pointer pcombi ) const	{ 
      return pointer();
    }
  };

  struct v_combinator : combinator { 
    typedef combinator::pointer pointer;

    virtual pointer operator() ( pointer pcombi ) const {
      return pointer( new v_combinator() );
    }
  };

  struct s_combinator : combinator { 
    typedef combinator::pointer pointer;

    s_combinator( ) {}
    s_combinator( pointer first ) : first_(first) {}
    s_combinator( pointer first, pointer second ) : first_(first), second_(second) {}

    virtual pointer operator() ( pointer pcombi ) const {
      if( second_ ) {
        return pointer();
      }
      else if( first_ ) {
        return pointer( new s_combinator( first_, pcombi ) );
      }
      else {
        return pointer( new s_combinator( pcombi ) );
      }
    }

    pointer first_;
    pointer second_;
  };

  struct k_combinator : combinator { 
    typedef combinator::pointer pointer;

    k_combinator( ) {}
    k_combinator( pointer first ) : first_( first ) {}

    virtual pointer operator() ( pointer pcombi ) const {
        if( first_ ) {
          return first_;
        }
        else {
          return pointer( new k_combinator( pcombi ) );
        }
    }

    pointer first_;
  };

  struct r_combinator : combinator { 
    typedef combinator::pointer pointer;

    virtual pointer operator() ( pointer pcombi ) const {
      std::cout << std::endl;
      return pcombi;
    }
  };

  struct dot_combinator : combinator { 
    typedef combinator::pointer pointer;

    dot_combinator( std::string&& s ) : str_(s) {}

    virtual pointer operator() ( pointer pcombi ) const {
      std::cout << str_;
      return pcombi;
    }

    std::string str_;
  };


}

class rt_stack_manager
{
public:
  typedef combinators::combinator::pointer combi_ptr;
  typedef combinators::combinator::stack_t stack_t;
  typedef combinators::combinator::stack_idx stack_idx;
  typedef combinators::combinator::stack_idx_t stack_idx_t;
  typedef std::tuple< stack_t, stack_t, stack_idx_t > stack_group_t;

  rt_stack_manager() { stack_group_.push( stack_group_t(stack_t(), stack_t(), stack_idx_t() ) ); }

  stack_t& get_current_stack( stack_idx idx ) {
    if( idx == stack_idx::idx_first ) return std::get<0>( stack_group_.top() );
    else if( idx == stack_idx::idx_second ) return std::get<1>( stack_group_.top() );
    else assert(0);
  }

  void push_stack_value( combi_ptr v, stack_idx idx ) {
    if( idx == stack_idx::idx_first ) std::get<0>( stack_group_.top() ).push( v );
    else if( idx == stack_idx::idx_second ) std::get<1>( stack_group_.top() ).push( v );
  }

  stack_idx get_stack_idx() const {
    auto& stack = std::get<2>( stack_group_.top() );
    if( !stack.empty() ) return stack.top(); 
    else return stack_idx::idx_null;
  }

  void push_stack_idx( stack_idx idx ) { std::get<2>( stack_group_.top() ).push( idx ); }

  stack_idx pop_stack_idx() { 
    auto& stack = std::get<2>( stack_group_.top() );
    if( !stack.empty() ) {
      auto ret = stack.top();
      stack.pop();
      return ret;
    }
    else return stack_idx::idx_null;
  }

  combi_ptr get_callcc_ret() const {
    if( !stack_callcc_ret_.empty() ) return stack_callcc_ret_.top(); 
    else return combi_ptr();
  }

  void push_callcc_ret( combi_ptr ptr ) { stack_callcc_ret_.push( ptr );  }

  combi_ptr pop_callcc_ret() {
    if( !stack_callcc_ret_.empty() ) {
      auto ret = stack_callcc_ret_.top();
      stack_callcc_ret_.pop();
      return ret;
    }
    else {
      return combi_ptr();
    }
  }

  void push_current_stack() {
    stack_group_t stack = stack_group_.top(); //copy
    stack_group_.push( std::move(stack) ); //move
  }

  void pop_current_stack() {
    if( stack_group_.size() > 1 ) stack_group_.pop();
    else assert(0);
  }

  void clear() {
    stack_group_ = std::stack< stack_group_t >();
    stack_callcc_ret_ = stack_t();
    stack_group_.push( stack_group_t(stack_t(), stack_t(), stack_idx_t() ) );
  }

private:
  std::stack< stack_group_t > stack_group_;
  stack_t stack_callcc_ret_;
};

class interpreter {

  template< typename CombiT >
  struct create_combinator {
    create_combinator( interpreter& ownner ) : ownner_(ownner) {}

    template<typename IterT>
    void operator() ( IterT, IterT ) const {
      using namespace combinators;

      ownner_.cp_stack_.push( combinator::pointer( new CombiT() ) );
    }

    interpreter& ownner_;
  };

  struct create_dot_combinator {
    create_dot_combinator( interpreter& ownner ) : ownner_(ownner) {}

    template<typename IterT>
    void operator() ( IterT begin, IterT end ) const {
      using namespace combinators;

      const std::string number = "ペロペロ";
      const std::string stop = "ペロペロ";

      std::string source( begin, end );
      int stop_pos = source.find( stop, 0 );
      int pos = 0;
      int value = 0;

      do {
        value = (value << 4) + (stop_pos - pos) / number.size() - 1;
        stop_pos += stop.size();
        pos = stop_pos;
      }while( (stop_pos = source.find( stop, stop_pos )) >= 0 );

      wchar_t wcs[] = { value, 0 };  //BMP超えると変な結果になる。
      std::string result;
      result.resize( 10 );
      wcstombs( const_cast<char*>(result.data()), wcs, 10 );


      ownner_.cp_stack_.push
      ( 
        combinator::pointer( new dot_combinator( std::move(result) ) )
      );
    }

    interpreter& ownner_;
  };

  
  struct do_apply { 
    do_apply( interpreter& ownner ) : ownner_(ownner) {}

    template<typename IterT>
    void operator() ( IterT, IterT ) const {
      using namespace combinators;

      auto& stack = ownner_.cp_stack_;

      auto second = stack.top();
      stack.pop();
      auto first = stack.top();
      stack.pop();

      stack.push( combinator::pointer( new apply_combinator( first, second ) ) );
    }

    interpreter& ownner_;
  };

  struct parser : public boost::spirit::classic::grammar<parser> {
    typedef boost::spirit::classic::grammar<parser> super_t;

    template<typename ScannerT>
    struct definition {
      typedef boost::spirit::classic::rule<ScannerT> rule_t;

      definition( const parser& self ) {
        using namespace boost::spirit;
        using namespace combinators;

        expression = (classic::str_p("あずにゃん") >> (combis >> combis))[do_apply(self.ownner_)];
        i_combi = classic::str_p("ぺロぺロ")[create_combinator<i_combinator>(self.ownner_)];
        d_combi = classic::str_p("ペロペロ")[create_combinator<d_combinator>(self.ownner_)];
        c_combi = classic::str_p("ぺロぺロ")[create_combinator<c_combinator>(self.ownner_)];
        v_combi = classic::str_p("ぺロぺロ")[create_combinator<v_combinator>(self.ownner_)];
        s_combi = classic::str_p("ぺロぺロ")[create_combinator<s_combinator>(self.ownner_)];
        k_combi = classic::str_p("ぺロぺロ")[create_combinator<k_combinator>(self.ownner_)];
        r_combi = classic::str_p("ペロぺロ")[create_combinator<r_combinator>(self.ownner_)];
        dot_combi = classic::str_p("ペロペロ") >> classic::str_p("あずにゃん") >> (+(+classic::str_p("ぺロぺロ") >> classic::str_p("ペロペロ")))[create_dot_combinator(self.ownner_)];
        combis = expression | i_combi | d_combi | c_combi | v_combi | s_combi | k_combi | r_combi | dot_combi;
      }
  
      const rule_t& start() const { return expression; }

      rule_t expression, combis;
      rule_t i_combi, d_combi, c_combi, v_combi, s_combi, k_combi, r_combi, dot_combi;
    };

    parser( interpreter& ownner ) : super_t(), ownner_(ownner) {}
  
    interpreter& ownner_;
  };

public:
  void run( const char * str ) {
    _cp_stack_clear();
    rt_stack_mgr_.clear();

    if( _compile( str ) ) {
      _run();
    }
    else {
      std::cout << ">>Parse fail!!" << std::endl;
    }

  }

protected:
  bool _compile( const char * str ) {
    parser ps( *this );
    return boost::spirit::classic::parse( str, ps, boost::spirit::classic::space_p ).full;
  }

  void _run() {
    using namespace combinators;

    rt_stack_manager::stack_idx ret_value_idx;

    combinator::pointer root_base = cp_stack_.top();
    cp_stack_.pop();
    if( auto root = std::dynamic_pointer_cast<apply_combinator>( root_base )  ) { 
      rt_stack_mgr_.get_current_stack( rt_stack_manager::stack_idx::idx_first ).push( root->first_ );
      rt_stack_mgr_.get_current_stack( rt_stack_manager::stack_idx::idx_second ).push( root->second_ );
      rt_stack_mgr_.push_stack_idx( rt_stack_manager::stack_idx::idx_first );

      while ( ( ret_value_idx = rt_stack_mgr_.pop_stack_idx() )
             != rt_stack_manager::stack_idx::idx_null ) {

        auto& first_stack = rt_stack_mgr_.get_current_stack( rt_stack_manager::stack_idx::idx_first );
        auto& second_stack = rt_stack_mgr_.get_current_stack( rt_stack_manager::stack_idx::idx_second );
        auto first = first_stack.top();
        first_stack.pop();
        if( auto node = std::dynamic_pointer_cast<apply_combinator>( first )  ) {
          first_stack.push( node->first_ );
          second_stack.push( node->second_ );
          rt_stack_mgr_.push_stack_idx( ret_value_idx );
          rt_stack_mgr_.push_stack_idx( rt_stack_manager::stack_idx::idx_first );
          continue;
        }
        else if( auto node = std::dynamic_pointer_cast<c_combinator>( first )  ) {
          auto second = second_stack.top();
          second_stack.pop();

          if( auto node = rt_stack_mgr_.pop_callcc_ret() ){
            rt_stack_mgr_.push_stack_value( node, ret_value_idx );
          }
          else{
            first_stack.push( first );
            second_stack.push( second );
            rt_stack_mgr_.push_stack_idx( ret_value_idx );

            rt_stack_mgr_.push_current_stack(); //backup the whole stack
            
            auto& first_stack2 = rt_stack_mgr_.get_current_stack( rt_stack_manager::stack_idx::idx_first );
            auto& second_stack2 = rt_stack_mgr_.get_current_stack( rt_stack_manager::stack_idx::idx_second );

            first_stack2.pop();
            second_stack2.pop();
            first_stack2.push( second );
            second_stack2.push( combinator::pointer( new cont_combinator() ) );
          }
          continue;
        }
        else if( auto node = std::dynamic_pointer_cast<d_combinator>( first )  ) {
          auto second = second_stack.top();
          second_stack.pop();
          rt_stack_mgr_.push_stack_value
          ( 
            combinator::pointer( new d0_combinator( second ) ),
            ret_value_idx
          );
          continue;
        }
        else if( auto node = std::dynamic_pointer_cast<d0_combinator>( first )  ) {
          first_stack.push( node->first_ );
          rt_stack_mgr_.push_stack_idx( ret_value_idx );
          continue;
        }

        auto second = second_stack.top();
        second_stack.pop();
        if( auto node = std::dynamic_pointer_cast<apply_combinator>( second )  ) {
          first_stack.push( first );
          first_stack.push( node->first_ );
          second_stack.push( node->second_ );
          rt_stack_mgr_.push_stack_idx( ret_value_idx );
          rt_stack_mgr_.push_stack_idx( rt_stack_manager::stack_idx::idx_second );
          continue;
        }

        if( auto node = std::dynamic_pointer_cast<cont_combinator>( first )  ) {
          rt_stack_mgr_.push_callcc_ret( second );
          rt_stack_mgr_.pop_current_stack();
          continue;
        }
        else if( auto node = std::dynamic_pointer_cast<s_combinator>( first )  ) {
          if( node->second_ ) {
            first_stack.push(
              combinator::pointer( new apply_combinator( node->first_, second ) )
            );
            second_stack.push(
              combinator::pointer( new apply_combinator( node->second_, second ) )
            );
            rt_stack_mgr_.push_stack_idx( ret_value_idx );
            continue;
          }
        }

        rt_stack_mgr_.push_stack_value( (*first)( second ), ret_value_idx );
      } // end while
    } // end if
    std::cout << std::endl;
    std::cout << ">>Run End!!" << std::endl;
  }

  inline void _cp_stack_clear() { cp_stack_ = decltype(cp_stack_)(); }

private:
  rt_stack_manager rt_stack_mgr_;
  std::stack<combinators::combinator::pointer> cp_stack_;
};

}

int main()
{
  using namespace ununlambda;

  std::locale::global( std::locale("") );

  interpreter interp;
  interp.run(
"あずにゃんペロぺロあずにゃんあずにゃんあずにゃんあずにゃんあずにゃんあずにゃんあずにゃんあずにゃんあずにゃん"
"あずにゃんあずにゃんペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロ"
"ぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロ"
"ぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロ"
"ぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロ"
"ぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロペロペロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロぺロぺロ"
  );//print Hello, world


  interp.run( 
"あずにゃんあずにゃんあずにゃんぺロぺロあずにゃんあずにゃんぺロぺロあずにゃんあずにゃんぺロぺロぺロぺロぺロぺロあずにゃんぺロぺロぺロぺロ"
"あずにゃんぺロぺロペロペロあずにゃんぺロぺロぺロぺロぺロぺロペロペロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロぺロペロペロあずにゃんあずにゃんぺロぺロあずにゃんあずにゃんぺロぺロあずにゃんぺロぺロぺロぺロ"
"あずにゃんあずにゃんぺロぺロあずにゃんぺロぺロあずにゃんぺロぺロあずにゃんぺロぺロぺロぺロあずにゃんあずにゃんぺロぺロあずにゃんあずにゃんぺロぺロあずにゃんぺロぺロぺロぺロあずにゃんあずにゃんぺロぺロあずにゃんぺロぺロあずにゃんぺロぺロあずにゃんぺロぺロペロぺロあずにゃんあずにゃんぺロぺロあずにゃんぺロぺロあずにゃんぺロぺロぺロぺロぺロぺロぺロぺロ"
"あずにゃんぺロぺロあずにゃんあずにゃんぺロぺロあずにゃんぺロぺロぺロぺロぺロぺロ"
  ); //print Fibonacci numbers(as lines of asterisks), loop forever.

}

参考になったサイト、
python46行のコードなぜか俺がやると10倍増えるんだろう?

http://coderepos.org/share/wiki/unlambda_lambda_ja