半環を使った重み付き正則表現マッチャーをHaxeで実装する

Haskellでは、代数的構造を使ったプログラムがよく書かれる。このようなプログラムを、Haxeでどのように記述すればいいのかを調べた。ここでは、[Weighted RegExp Matching](http://sebfisch.github.io/haskell-regexp/)にある論文[A Play on Regular Expressions](http://sebfisch.github.io/haskell-regexp/regexp-play.pdf)を元に、重み付き正則表現マッチングを実装する。実装した内容の詳細は元の論文を参照してほしい。

まず、半環 semiring を実装する。半環は型パラメーターをもつ構造型として表現しよう。

```hx:Semiring.hx
package hxwre.ds;

typedef Semiring<T> = {
    var zero(get, never) : T;
    var one(get, never) : T;

    function plus(a : T, b : T) : T;
    function times(a : T, b : T) : T;
}
```

ブール代数は半環をなす。ブール代数のなす半環を定義をしよう。インスタンスはひとつあれば十分なので、Singletonパターンを使う。

```hx:SemiringBool.hx
package hxwre.ds;

class SemiringBool {
    static var s = new SemiringBool();

    public static var instance(get, never) : SemiringBool;
    static function get_instance() return s;

    function new() {}

    public var zero(get, never) : Bool;
    function get_zero() return false;

    public var one(get, never) : Bool;
    inline function get_one() return true;

    public function plus(a : Bool, b : Bool) : Bool return a || b;
    public function times(a : Bool, b : Bool) : Bool return a && b;
}
```

そして、半環を使った重み付き正則表現マッチャーを実装する。なお、正則表現の構文に、元の論文にはない`Nil`と`And`を付け加えている。

```hx:WRegExp.hx
package hxwre;

import hxwre.ds.Semiring;

private enum WRe<C,S,F:Semiring<S>> {
    Nil;
    Eps;
    Sym(f : C -> S);
    Alt(p : WReg<C,S,F>, q : WReg<C,S,F>);
    And(p : WReg<C,S,F>, q : WReg<C,S,F>);
    Seq(p : WReg<C,S,F>, q : WReg<C,S,F>);
    Rep(r : WReg<C,S,F>);
}

private class WReg<C,S,F:Semiring<S>> {
    public var empty : S;
    public var final : S;
    public var reg : WRe<C,S,F>;

    public function new(e, f, r) {
        this.empty = e;
        this.final = f;
        this.reg = r;
    }
}

class WRegExp<C,S,F:Semiring<S>> {
    var s : F;

    var nil_s : WReg<C,S,F>;
    var eps_s : WReg<C,S,F>;

    public function new(s : F) {
        this.s = s;
        this.nil_s = new WReg(s.zero, s.zero, Nil);
        this.eps_s = new WReg(s.one, s.zero, Eps);
    }

    public var nil(get, never) : WReg<C,S,F>;
    public function get_nil() return nil_s;

    public var eps(get, never) : WReg<C,S,F>;
    public function get_eps() return eps_s;

    public function sym(f : C -> S) : WReg<C,S,F> {
        return new WReg(s.zero, s.zero, Sym(f));
    }

    function symFinal(f : C -> S, m : S) : WReg<C,S,F> {
        return new WReg(s.zero, m, Sym(f));
    }

    public function alt(p : WReg<C,S,F>, q : WReg<C,S,F>) : WReg<C,S,F> {
        return new WReg(
            s.plus(p.empty, q.empty), s.plus(p.final, q.final), Alt(p, q));
    }

    public function and(p : WReg<C,S,F>, q : WReg<C,S,F>) : WReg<C,S,F> {
        return new WReg(
            s.times(p.empty, q.empty), s.times(p.final, q.final), And(p, q));
    }

    public function seq(p : WReg<C,S,F>, q : WReg<C,S,F>) : WReg<C,S,F> {
        return new WReg(
            s.times(p.empty, q.empty),
            s.plus(s.times(p.final, q.empty), q.final), Seq(p, q));
    }

    public function rep(r : WReg<C,S,F>) : WReg<C,S,F> {
        return new WReg(s.one, r.final, Rep(r));
    }

    public function shift(c : C, m : S, re : WReg<C,S,F>) : WReg<C,S,F> {
        return switch (re.reg) {
            case Nil: nil;
            case Eps: eps;
            case Sym(f): symFinal(f, s.times(m, f(c)));
            case Alt(p, q):
                alt(shift(c, m, p), shift(c, m, q));
            case And(p, q):
                and(shift(c, m, p), shift(c, m, q));
            case Seq(p, q):
                seq(shift(c, m, p),
                    shift(c, s.plus(s.times(m, p.empty), p.final), q));
            case Rep(r):
                rep(shift(c, s.plus(m, r.final), r));
        };
    }

    public function match(r : WReg<C,S,F>, cs : Iterator<C>) : S {
        if (!cs.hasNext()) return r.empty;
        var r = shift(cs.next(), s.one, r);
        for (c in cs) {
            r = shift(c, s.zero, r);
        }
        return r.final;
    }
}
```

実装の都合上、3つの部分に分けて定義されている。`enum WRe`は正則表現の構文を定義し、`class WReg`はマークを保持する構造を定義する。この2つは相互再帰的なデータ構造になっている。`class WRegExp`はそのデータ構造に対する演算を定義している。

型パラメーターに幽霊型として `F:Semiring<S>` を加える事で、異なる半環のデータを混ぜて使うことができなくなっている。半環は実行時に`F:Semiring<S>`型のインスタンスとして渡されてくるので、それぞれののインスタンスに応じて`WRegExp<C,S,F>`のインスタンスを生成して使用する。

これで正則表現を記述することができるようになったわけだが、このままでは二項演算もすべて関数形式で記述しないといけない。演算子オーバーロードを使いたいところだが、`WReg`のインスタンスに対する演算は`WRegExp`のインスタンスが持っているものを使わなければならないから、それはできない。そこで、マクロを使うことにする。

```hx:WRegExpMacro.hx
package hxwre;

import haxe.macro.Expr;
import hxwre.ds.Semiring;

class WRegExpMacro {
    static function buildwregex<C,S,F:Semiring<S>>
            (r : ExprOf<WRegExp<C,S,F>>, e : Expr) : Expr {
        return switch (e.expr) {
            case EBinop(op, e1, e2):
                var e1 = buildwregex(r, e1);
                var e2 = buildwregex(r, e2);
                switch (op) {
                    case OpOr: macro $r.alt($e1, $e2);
                    case OpAnd: macro $r.and($e1, $e2);
                    case OpShr: macro $r.seq($e1, $e2);
                    case _: e;
                }
            case ECall(e, params):
                var e = buildwregex(r, e);
                var params = [for (e in params) buildwregex(r, e)];
                macro $e($a{params});
            case _ : e;
        }
    }

    macro public static function build<C,S,F:Semiring<S>>
            (r : ExprOf<WRegExp<C,S,F>>, e : Expr) : Expr {
        return buildwregex(r, e);
    }
}
```

このマクロは、 `$e1 | $e2` を `alt($e1, $e2)` に、 `$e1 & $e2` を `and($e1, $e2)` に、 `$e1 >> $e2` を `seq($e1, $e2)` に置き換える。

準備がととのったので、使ってみよう。

```hx:Example1.hx
package example;

import hxwre.ds.SemiringBool;
import hxwre.WRegExp;
using hxwre.WRegExpMacro;

class Example1 {

    public static function iterator(s : String) {
        var i = 0;
        return {
            hasNext: function() return i < s.length,
            next: function() return s.charCodeAt(i++),
        };
    }

    public static function main() {
        var w = new WRegExp(SemiringBool.instance);

        var rep = w.rep;
        var lit = function(c) return w.sym(function(x) return x == c);
        var a = lit('a'.code);
        var b = lit('b'.code);

        // aとbからなる列で、偶数回aが現れるものにマッチする正則表現
        var even = w.build( rep( rep(b) >> a >> rep(b) >> a ) >> rep(b) );
        trace(w.match(even, iterator("aababbababb")));
        trace(w.match(even, iterator("aabbaabbaba")));

    }

}
```

実行結果:

```
Example1.hx:26: false
Example1.hx:27: true
```

GitHub リポジトリ: [mandel59/hxwre](https://github.com/mandel59/hxwre)