Hatena::Groupocaml-nagoya

yoshihiro503の関数的日記

2011-04-06 (Wed)

haXe用のQuickCheckを書いてみた。

| 19:31 | haXe用のQuickCheckを書いてみた。 - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXe用のQuickCheckを書いてみた。 - yoshihiro503の関数的日記

使い方はこんな感じ

import haxe.unit.TestCase;
import haxe.unit.TestRunner;
import QuickCheck;

class MyTest extends QuickCheck {
  public function testN() {
    var q = this;
    quickCheck(forall(Gen.int, function(n) {
      return q.check(2*n == n+n);
    }));
  }

  public function testAppendLength() {
    var q = this;
    quickCheck(forall(Gen.list(Gen.int), function(xs) {
      return q.forall(Gen.list(Gen.int), function(ys) {
        return q.check(xs.length + ys.length == Lambda.concat(xs,ys).length);
      });
    }));
  }
}

class Sample {
  static function main() {
    var r = new TestRunner();
    r.add(new MyTest());
    r.run();
  }
}

ソースコードはこちら

https://bitbucket.org/yoshihiro503/haxecheck

2010-06-09 (Wed)

haXeで怠惰(lazy)を実装してみた

| 23:31 | haXeで怠惰(lazy)を実装してみた - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXeで怠惰(lazy)を実装してみた - yoshihiro503の関数的日記

haXeには組み込みでは怠惰(lazy)評価 機能が備わっていないようだったので実装してみた。

関数型言語ではthunkを簡単に扱うことができ、評価を遅延させることができるが、それだとタダの遅延評価(delay evaluation)になってしまい、無駄な計算が発生してしまうかもしれない。そこで評価は遅らせるけれど、一回計算したら覚えておくというLazy型を定義した。コンストラクタにはthunkをわたして使う。

enum Option<X> {
    None;
    Some(x : X);
}

class Lazy<A> {
    var _x : Option<A>;
    var _getter : Void -> A;

    public function new (getter) {
        this._x = None;
        this._getter = getter;
    }

    public function force() {
        switch (this._x) {
            case None:
                var x = this._getter();
		this._x = Some(x);
		return x;
	    case Some(x):
		return x;
	}
    }
}

そして、それを使って怠惰リストを実装したのが次。

enum LListT<A> {
    LNil;
    LCons(x : A, tl : Lazy<LListT<A>>);
}

class LList{
    static public function from(n : Int) : LListT<Int> {
	return LCons(n, new Lazy(function() return from(n+1)));
    }

    public static function take<A>(n:Int,xs:LListT<A>) : List<A> {
	var ys = new List();
	var xs0 = xs;
	for (i in 0...n) {
	    switch (xs0) {
		case LCons(x, xs1):
		    xs0 = xs1.force();
		    ys.push(x);
		case LNil:
		    break;
	    }
	}
	return Util.list_reverse(ys);
    }

    public static function filter<A> (xs : LListT<A>, f:A -> Bool) {
	return switch(xs) {
	    case LNil: LNil;
	    case LCons(x, xs):
		if (f(x)) LCons(x, new Lazy(function ()
		   return filter(xs.force(), f)));
		else filter(xs.force(), f);
	}
    }
}

以上の怠惰評価と怠惰リストをUtil.hxというファイルにまとめて、これを試してみるために素数の無限列を作ってみた。

import Util;

class Test {
    static function main() {
	trace("primes: "+LList.take(100,primes));
    }

    static var primes = seive(LList.from(2));
		
    static function seive(xs) {
	return switch(xs) {
	    case LNil: Util.failwith("");
	    case LCons(x,xs): LCons(x, Util.lazy(function() {
		return LList.filter(seive(xs.force()), function(a) return a%x!=0);
	    }));
	}
    }
}

TestクラスはTest.hxに保存。実行結果は以下。

 $ haxe -main Test -neko Test.n
 $ neko Test.n
Test.hx:7: primes: {2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79,
 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 
193, 197, 199, 211, 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, 293, 307, 
311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, 383, 389, 397, 401, 409, 419, 421, 431, 
433, 439, 443, 449, 457, 461, 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541}

2008-12-03 (Wed)

haXeでhaXe -> schemeジェネレーター

| 08:57 | haXeでhaXe -> schemeジェネレーター - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXeでhaXe -> schemeジェネレーター - yoshihiro503の関数的日記

haXehaXeをパースしてscheme プログラムを生成しよう。

class Genscheme {

    public static function gen_class_field (class_field) {
	return switch class_field {
	    case fvar (name, expr):
		"(define "+name+" "+gen_expr(expr)+")";
	    case ffun (name, fun):
		"(define "+name+" "+gen_expr(efunction(fun))+")";
	    }
    }
    
    static function gen_expr (expr) {
	return switch expr {
	case econst(c): gen_const(c);
	case ecall(f, args):
            "("+gen_expr(f)+" "+List.string_concat (" ",List.map(gen_expr,args))+")";
	case efunction (f):
	    switch f {
	    case func(args, body):
	        "(lambda ("+List.string_concat (" ",args)+") "+gen_expr(body)+")";
	    }
	//case eswitch(e, cases): //TODO switch式
	//case evars (vs, e): //TODO let式
	case eexprs(e1, e2):
	    gen_expr(e1);
	case ereturn(e): gen_expr(e);
	default: "";
	}
    }


    static function gen_const (c) {
	return switch c {
	    case int(x): x;
	    case string(x): '"' + x + '"';
	    case ident(x): x;
	    case ctype(x): x;
	    }
    }
}

実行例

入力:

  static function main () {
    trace ("Hello, world!");
  }

出力:

(define main (lambda () (trace "Hello, world!")))

2008-12-02 (Tue)

haXeでhaXeコンパイラを作ってみる。

| 18:18 | haXeでhaXeコンパイラを作ってみる。 - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXeでhaXeコンパイラを作ってみる。 - yoshihiro503の関数的日記

haXe全部の構文をサポートするのは大変そうなので、サブセット(MinHaXe?)を実装することにする。

具体的な構文は大体以下のBNFで定める。主要なものは全て入れたつもりだ。

   <ident> ::= [a-z] [a-zA-Z0-9_]*
   <constant> ::= <ident> | <string> | <number>

   <program> ::= <type_def> <type_def> .. <type_def>
   <type_def> ::= <class> | <enum>

   <class> ::= class <type_name> { <class_field list> }
   <class_field> ::= var <ident> = <expr> ;
                   | function <ident> ( <arg>, .. ,<arg> ) <expr>

   <enum> ::= enum { <enum_constructor list> }
   <enum_constructor> ::= <ident> ( <arg>, .. ,<arg> ) ;
                        | <ident> ;

   <expr> ::= { <block> }
            | ( <expr> )
	    | <constant> <expr_next>
	    | function ( <arg>, .. ,<arg> ) <expr>
	    | return <expr>
	    | switch <expr> { <case>, .. ,<case> }

   <expr_next> ::= . <expr_next>
                 | ( <expr>, .. , <expr> ) <expr_next>

   <block> ::= <expr> ; <block> | var <ident> = <expr> ; <block>

抽象構文木

抽象構文木は以下のように記述した。

enum Constant {
    int (s : String);
    string (s : String);
    ident (s : String);
    ctype (s : String);
}

enum TypeDef {
    eclass (name:String, fields : ListT<ClassField>);
    eenum (name:String, cs : ListT<EnumConstructor>);
}

enum ClassField {
    fvar (name:String, body : Expr);
    ffun (name:String, func : Func);
}

enum EnumConstructor {
    enum_const (cname : String, params : ListT<EnumParam>);
}
enum EnumParam {
    enum_param (vname : String, vtype : String);
}

enum Expr {
    econst (c : Constant);
    ecall (f : Expr, args : ListT<Expr>);
    efunction (f: Func);
    eswitch (e : Expr, cases : ListT<Pair<ListT<Expr>, Expr>>);
    evars (vs : ListT<Pair<String,Expr>>, e : Expr);// var vs; e
    eexprs(e1 : Expr, e2 : Expr);
    ereturn (e : Expr);
    efield (e :Expr, f : String);
    enil;
}
enum Func {
    func(arg_name: ListT<String>, body: Expr);
}

パーサー

まだ一部未完成だがこんな感じ。昨日のパーサーモナドをガンガン使っている。

class Parser {

    static function parse_class (source) {
	var parse_cf_rights = plist (ptoken(kwd(kstatic)));

	var parse_fun_args = psep(comma,mbind(pident,function(name) return
	     mbind(parse_type_opt, function (t) return mreturn(name))));
	var parse_fun_field = pignore_l (ptoken(kwd(kfunction)),
	     mbind (pident, function (fname) return
             pignore_l (ptoken(popen),
             mbind (parse_fun_args, function (args) return
             pignore_l (ptoken(pclose),
             mbind (parse_expr, function (body) return
             mreturn (ffun(fname, func(args,body)))))))));

	var parse_var_field = pignore_l (ptoken(kwd(kvar)),
             mbind(pident, function (vname) return
             mbind(parse_type_opt, function (t) return
             pignore_l(ptoken(binop(op_assign)),
	     mbind (parse_expr, function (expr) return
	     pignore_l (ptoken(semicolon), mreturn (fvar(vname, expr))))))));

	var parse_field = mbind (parse_cf_rights, function (as) return door (parse_var_field, parse_fun_field));
	var p = pignore_l (ptoken(kwd(kclass)),
	     mbind (ptype, function (name) return
	     pignore_l (ptoken(br_open),
	     mbind (plist(parse_field), function (fields) return
	     pignore_l (ptoken(br_close),
	     mreturn (eclass (name, fields)))))));	
	return p (source);
    }

    static function parse_expr (source) {
	// ブロック式のパーサ: { <block> }
	var p1 = pignore_l (ptoken(br_open), pignore_r (block, ptoken(br_close))); 
	// 丸カッコで囲まれた式のパーサ: ( <expr> )
	var p2 = pignore_l (ptoken(popen), pignore_r (parse_expr, ptoken(pclose)));
	// 定数、ident式のパーサ: <const> <expr_next>
	var p3 = mbind (pconst, Util.comp (expr_next, econst));
	// var p4 = //TODO: 無名関数のパーサ
	// return式のパーサ: return <expr>
	var p5 = pignore_l (ptoken(kwd(kreturn)), parse_expr);
	// var p6 = //TODO: switch式のパーサ
	return Util.apply (door(p1, door(p2, door(p3, p5))), source);
    }

    static function expr_next (e1) {
	// フィールド(メソッド)呼び出し: e1 . <expr_next>
	var p1 = pignore_l (ptoken(dot), mbind (pident, function (fld) return expr_next (efield(e1, fld))));
	// 関数適用: e1 ( <expr> , <expr> ,.., <expr> )	
	var p2 = pignore_l (ptoken(popen), pignore_r (mbind (psep(comma,parse_expr),
                      function (args) return expr_next (ecall(e1,args))), ptoken(pclose)));
							     
	return door (p1, door (p2, mreturn(e1)));
    }
    static function block (source) {
	// セミコロン区切りで並んだ式のパーサ: <expr>; <block>
	var p1 = mbind (parse_expr, function (e1) return pignore_l (ptoken(semicolon),
                     mbind (block, function (e2) return mreturn (eexprs(e1,e2)))));	
	//var p2 = //TODO var式のパーサ
	return Util.apply (door (p1, mreturn(enil)), source);
    }
}

syd_sydsyd_syd2008/12/02 23:31pignore_lとかpignore_rってなに?定義がないっぽいです。

yoshihiro503yoshihiro5032008/12/03 07:41ホントだ。失礼しました。
pignore_l(p1,p2)はパーサーp1で読んだ結果を無視してパーサーp2を適用するという関数で、pignore_rはその逆です。
static function pignore_l<S, X, Y> (p1 : ParserT<S, X>, p2 : ParserT<S, Y>) : ParserT<S, Y> {
return mbind (p1, function (_) return p2);
}
static function pignore_r<S, X, Y> (p1 : ParserT<S, X>, p2 : ParserT<S, Y>) : ParserT<S, X> {
return mbind (p1, function (x) return mbind (p2, function (_) return mreturn (x)));
}

syd_sydsyd_syd2008/12/04 01:50なるほど。 というか pなんとかのメソッド全て定義がないみたい。また教えてくださいな。

yoshihiro503yoshihiro5032008/12/05 14:00pなんとか関数などの小さい関数含めたソースコード全体をBitbacketに置きました。http://www.bitbucket.org/yoshihiro503/myhaxe/src/

wnvexszjfpwnvexszjfp2011/03/07 11:14ouw3YL <a href="http://ayeudredtsny.com/">ayeudredtsny</a>, [url=http://spyebfvidnog.com/]spyebfvidnog[/url], [link=http://kqgqdyzsdawf.com/]kqgqdyzsdawf[/link], http://pxxiblccbowy.com/

2008-12-01 (Mon)

haXeでパーサーの演算

| 15:36 | haXeでパーサーの演算 - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXeでパーサーの演算 - yoshihiro503の関数的日記

トークンの列などを解析して、何かを読み取るパーサー型をhaXeで次のように定義した。

typedef ParserT<X> = ListT<Token> -> Either<Pair<ListT<Token>, X>, Error>;

読み取る対象はトークンのリストで、X型のものを読もうとする。

パースが成功したときは 「left(残りの列, 読んだものx)」を返し、失敗したときは「right(エラーメッセージ等)」を返す。

パーサーは関数だが、haXeは関数型言語なので、パーサー同士の演算を考えることが出来る。

パーサーの足し算

パーサー同士の足し算を次のように定義してみた。

// <|> operation : ParserT<X> -> ParserT<X> -> ParserT<X>
static function door<X> (p1 : ParserT<X>, p2 : ParserT<X>) : ParserT<X> {
    return function (source) {
	return switch p1(source) {
	case left(rest_x): left(rest_x);
	case right(err1):
            switch p2(source) {
	    case left(rest_x): left(rest_x);
	    case right(err2):
		right(err1+", "+err2);
	    }
	}
    }
}

足し算で得られるパーサーは、p1でパースして、成功したらその結果を返し、失敗したら、p2でパースしてみる。両方失敗したら失敗を返すパーサーだ。

HaskellのParsecとかにある <|> 関数(その見た目からCSNagoyaではドア関数と読んでいる)みたいなものだ。

p1とp2の型は一致していないといけない。

ここで、zeroパーサーを考える。これは何にもマッチしないパーサーだ。これは足し算における単位元になっている。

つまり door (p1, zero) === p1 かつ door (zero, p2) === p2となる。

パーサーのかけ算

パーサー同士のかけ算は次のように定義してみた。

// ParserT<X> -> ParserT<Y> -> ParserT <Pair<X,Y>>
static function prod<X, Y> (p1: ParserT<X>, p2: ParserT<Y>) : ParserT<Pair<X, Y>> {
    return function (source) {
	return switch p1(source) {
	case left(rest_x):
            var rest = Util.fst(rest_x);
            var x = Util.snd(rest_x);
 	    switch p2(rest) {
	    case left(rest_y):
		var rest = Util.fst(rest_y);
		var y = Util.snd(rest_y);
	        left(rest, (x, y));
	    case right(msg): right(msg);
            }
	case right(msg): right(msg);
	}
    }
}

かけ算によるパーサーはp1で読んでからp2で読んで、XとYのペアを返すようなパーサーで、両方パースできたときにのみパースが成功する。いくつかのパーサーで順番に読んでいくときに便利だ。


足し算とかけ算の問題点

小さいパーサーをこれらの演算で組み合わせて、大きいパーサーを構築する事ができる、さらにそれらを組み合わせて

より複雑なパーサーを作る事ができる。この足し算とかけ算は非常に便利で、いろいろなパーサーを表現する事ができる。

しかし、一見数学的にもきれいなように思えるこの演算体系はあんまりきれいじゃない。環にもならないし群も形成しない。かけ算に関しては、逆元も持たないし、推移律すら成り立たない。

また、かけ算では常にペアのパーサーしか構築できず、そのためにパーサーのmap関数とかも考えたけど、どうもかっこ悪い気がする。p1で読んだ結果に応じてp2の振る舞いを変えるとかみたいな柔軟な設計もできない。

そこで、次のような関数を考えてみた。

// combine : ParserT<X> -> (X -> ParserT<Y>) -> ParserT<Y>
static function combine<X, Y> (p1 : ParserT<X>, f : X -> ParserT<Y>) : ParserT<Y> {
    return function (source) {
	return switch p1 (source) {
	case left (rest_x):
	    var rest = Util.fst (rest_x);
	    var x = Util.snd (rest_x);
	    Util.apply (f (x), rest);
	case right (msg): right (msg);
	}
    }
}

この関数は、パーサーp1とパーサーを生成する関数fを受け取ってパーサーを返す関数である。

combine (p1, f) パーサーにトークンの列 source を渡すと、

まずp1でトークンを読んで、成功したら、読めたxにfを適用して生成したパーサーf(x)を使って残りを読み、p1で失敗したら、失敗を返す。

この関数の型をよくよく見てみると、どこかで見たことがある気がする。そうだ!モナドだ!モナドの ( >>= )関数になっている!

そこで、この関数名をmbindという名前に変えて、次はmreturnを実装してみる。

// mreturn : X -> ParserT<X>
static function mreturn<X> (x : X) : ParserT<X> {
    return function (source) return left(source, x);
}

これらmbindとmreturnを使えば、さっきのprod関数は以下のようにクールに定義できる。

// ParserT<X> -> ParserT<Y> -> ParserT <Pair<X,Y>>
static function prod<X, Y> (p1: ParserT<X>, p2: ParserT<Y>) : ParserT<Pair<X, Y>> {
    return mbind (p1, function (x) return mbind (p2, function (y) return mreturn(pair(x, y))));
}

以下の記事を読めば、より具体的に理解できるので、オススメである。

モナディック・パーサー - あどけない話

結論:パーサーモジュールは mbind と mreturn と door 関数があれば十分。

2008-11-30 (Sun)

haXeで便利モジュールを作ってみた。

| 20:10 | haXeで便利モジュールを作ってみた。 - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXeで便利モジュールを作ってみた。 - yoshihiro503の関数的日記

enum Pair<L, R> {
    pair (l:L, r:R);
}
enum Either<A, B> {
    left (a:A);
    right (b:B);
}
enum Option<X> {
    none;
    some(x: X);
}

class Util {
    public static function fix<A, B> (f : (A->B) -> A -> B) {
	return function (x) return f (fix (f), x);
    }

    public static function fst<A,B> (p: Pair<A,B>) : A
        return switch p { case pair (l, _): l; }

    public static function snd<A,B> (p: Pair<A,B>) : B
        return switch p { case pair (_, r): r; }
    
    public static function apply<A,B> (f : A -> B, x : A) : B return f (x)

    public static function apply2<A1,A2,B> (f : A1 -> A2 -> B, x : A1, y : A2) : B
        return f (x, y)

    public static function comp<A, B, C> (g : B -> C, f : A -> B)
	return function (x : A) return g (f (x))

}

2008-11-27 (Thu)

haXeで不動点演算子(fixed point operator)

| 18:27 | haXeで不動点演算子(fixed point operator) - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXeで不動点演算子(fixed point operator) - yoshihiro503の関数的日記

haXeでは関数が第一級なので、次のように関数内での変数宣言でローカル関数を定義することが出来る。

function hoge (a, b) {
  var f = function (x) { return 2*x + 1; };
  return f (a) + f (b);
}

このため、補助関数を隠蔽したりできてとても便利である。しかし、次のような場合に、fact_iter補助関数をfact関数内で定義しようと思うと、ちょっと問題が生じる。

function fact (n) {
  return fact_iter (1, n);
}
function fact_iter (a, n) {
  if (n == 0) return a;
  else return fact_iter(n*a, n-1);
}

fact_iter関数は自分自身を呼ぶ再帰関数だからだ。

function fact (n) {
  var fact_iter = function (a, n) { 
    if (n == 0) return a;
    else return fact_iter(n*a, n-1);
  }
  return fact_iter (1, n);
}

とはできない。

再帰する補助関数を関数内で宣言したくて次のような項を定義した。

function fix<A, B> (f : (A -> B) -> A -> B) {
  return function (x) {
    return f (fix (f), x);
  }
}

このfixという項を使えば、先ほどの再帰する補助関数を内部に隠蔽することが出来る。

function fact (n) {
  var local = fix (function (f, s_n) {
    return switch (s_n) {
	case pair(store, n):
	  if(n == 0)  store;
          else f (n*store, n-1);
	}
  });
  return local (pair(1, n));
}

ValnirValnir2012/04/08 18:01Thanks guys, I just about lost it lokonig for this.

2008-11-26 (Wed)

haXeでlistモジュールを作ってみた。

| 14:43 | haXeでlistモジュールを作ってみた。 - yoshihiro503の関数的日記 を含むブックマーク はてなブックマーク - haXeでlistモジュールを作ってみた。 - yoshihiro503の関数的日記

今流行りの関数型言語haXeを勉強ついでに、OCamlみたいなListモジュールを書いてみた。

class内にenumを定義することは出来ないみたいなので、List型は外で定義した。

enum ListT<E> {
    nil;
    cons(e: E, tl: ListT<E>);
}

class List {

    public static function length<E> (l:ListT<E>) {
	return switch (l) {
	case nil: 0;
	case cons (x, xs): 1 + length (xs);
	}
    }

    public static function fold_left<A, B> (f:A -> B -> A, a:A, l:ListT<B>) {
	return switch (l) {
	case nil: a;
	case cons (b, bs): fold_left (f, (f (a, b)), bs);
	}
    }

    public static function map<A, B> (f:A -> B, l:ListT<A>) {
	return switch (l) {
	case nil: nil;
	case cons (x, xs): cons (f (x), map (f, xs));
	}
    }

    public static function rev<A>(l:ListT<A>) {
	return rev_append(nil, l);
    }
    public static function rev_append<A> (store:ListT<A>, l:ListT<A>) {
	return switch (l) {
	case nil: store;
	case cons(x, xs): rev_append (cons (x, store), xs);
	}
    }


}

osiireosiire2008/11/28 10:12すばらしい。意図的かどうか分からないけど、iterとnthが無いのが面白い.

yoshihiro503yoshihiro5032008/11/28 10:28ありがとうございます。
取り合えず必要なものから定義していっています。
iterがないのは、まだ必要になっていないし、Unit型が必要になるからです。
nthがないのは、Option型が必要になるからです。