haXeで作るプログラミング言語(12)

関数がクロージャになるように変更

みなさんは、クロージャってご存知でしょうか？
正確に説明となると難しいですが、簡単にいうと親の関数の環境も参照できる関数をクロージャといいます。
親の親の関数の環境も、親の親の親の関数の環境も、と祖先の環境を参照できる関数といったほうがいいのでしょうか？
ま、そんなやつです。

今回は、環境を持った関数を作成します。

co=fun(a){fun(b){a=a+b}} c=co(0)println(c(1))println(c(1))c(1)

というプログラムを実現します。
このcoという関数は関数を返す関数です。
coが返す関数は内部にa変数を持った状態で帰ります。
そのため、c = co(0)のcはfun(b){a=a+b}で、最初aは0なので、1が返ります。
次にもう一度呼び出すとaは2なので、2が返ります。
このように関数なのに、aという値を持った関数になります。
なぜこのようなことができるのか？というと、c関数が環境を持っているからです。

そんなカウンターを実現してみます。

現状の処理系は、環境は関数内でしか参照できません。
これを親の環境も参照できるようにすればクロージャとして動作するようにできます。
今回は現在はメジャーな静的スコープ(static scope)レキシカルスコープとも呼ばれる構文上で決まる親の環境を参照することにします。
静的スコープに対して動的スコープ(dynamic scope)というのもあります。(perlのlocal変数など)
動的スコープの場合は、スタック構造の１つ上を参照すればよくて簡単です。

静的スコープを実現するには関数を変数に保存するときに環境も一緒に保存するようにします。

そして、変数の値を取得する際に、自分の関数の環境に変数がなかった場合は親の環境を参照するようにします。

ということで、プログラム完成です。

でコンパイルして

neko Calc12

と実行すればうまく動くはず。

とりあえず、サンプルが動くようにバグ取りました。haXeのenum使った言語作りはしんどいので、もういやです。（笑
次回は、最終回。マクロを使えるようにします。そして、新たなシリーズでは、phpで言語を作ります。
なぜ、phpなのかというと、最近phpを仕事で使っているからです。

以下ソースです。

enum Exp {
	vid;
	nil;
	num(d:Int);
	sym(d:String);
	str(d:String);
	env(e:Hash<Exp>);
	op(l:Exp, tag:String, r:Exp);
	fun(prm:Exp, body:Exp, env:Hash<Exp>);
}

class Calc12 {
	static function main() {
		var c = new Calc12();
		trace(c.eval("co=fun(a)fun(b)a=a+b c=co(0)println(c(1))println(c(1))c(1)"));
	}
	var opLs:Hash<Int>;
	var opRs:Hash<Int>;
	var opPs:Hash<String>;
	var opMs:Hash<Int>;
	var opSs:Hash<String>;
	var endPs:Hash<Int>;
	var opBs:Hash<Int>;

	function new() {
		opLs = new Hash<Int>();
		opRs = new Hash<Int>();
		opPs = new Hash<String>();
		opMs = new Hash<Int>();
		endPs = new Hash<Int>();
		opSs = new Hash<String>();
		opBs = new Hash<Int>();
		opLs.set("+", 10);
		opLs.set("-", 10);
		opLs.set("*", 20);
		opLs.set("/", 20);
		opLs.set(">",190);
		opLs.set("<",190);
		opLs.set("else",1);
		opRs.set("=", 5);
		opPs.set("(",")");
		opPs.set("[","]");
		opPs.set("{","}");
		opMs.set("(", 200);
		opMs.set("{", 200);
		opMs.set("[", 200);
		endPs.set(")", 0);
		endPs.set("]", 0);
		endPs.set("}", 0);
		opSs.set("fun","(");
		opSs.set("if","(");
		opBs.set("++", 30);
		opLs.set(",", 2);
		opBs.set(";", 1);
	}

	var src:String;
	var token:String;
	var token2:String;
	var ln:Bool;
	
	function lex():String {
		var r : EReg = ~/^[\t ]*([\r\n]*)[\t \r\n]*([0-9]+|[,;\[\]{}()]|[+*\-\/=<>]+|[a-zA-Z_][a-zA-Z0-9]*|"([^"]*|\\.)")/;
		token2 = token;
		if(r.match(src)){
			if(r.matched(1).length > 0) {
				ln = true;
			} else {
				ln = false;
			}
			token = r.matched(2);
			src = src.substr(r.matched(0).length);
			return token2;
		}
		token = "";
		return token2;
	}

	function eval(str:String):Exp {
		var exp = parse(str);
		trace(exp);
		env1 = new Hash<Exp>();
		return execute(exp);
	}

	function parse(str:String):Exp {
		src = str;
		lex();
		
		return exp();
	}

	function eat(e:String):String {
		var t = lex();
		if(t != e) throw ("expect error " + e);
		return t;
	}
	function exp() {
		var rc = expn(0);
		while (token != "" && token != "}" && token != ")" && token != "]") {
			rc = op(rc, "@", expn(0));
		}
		return rc;
	}
	function expn(p:Int):Exp {
		if(endPs.exists(token)) return vid;
		var tk = lex();
		var numReg : EReg = ~/[0-9]+/;
		var t:Exp;

		if (opSs.exists(tk) && opSs.get(tk) == token) {
			var p1 = lex();
			var e = exp();
			var op2 = eat(opPs.get(p1));
			t = op(e, "S"+tk+p1+op2, expn(0));
		} else
		if(opPs.exists(tk + "")) {
			var t2 = exp();
			if(lex() != opPs.get(tk)) throw ("error");
			t = op(nil, "P"+tk+opPs.get(tk), t2);
		} else if(numReg.match(tk)) {
			t = num(Std.parseInt(tk));
		} else {
			t = sym(tk);
		}

		var tagp:Int;
		while(true) {
			if(!ln && opMs.exists(token) && (tagp = opMs.get(token)) >= p) {
				var tag = lex();
				var e = exp();
				var tag2 = eat(opPs.get(tag));
				t = op(t, "M"+tag+tag2, e);
				continue;
			}
			if(opBs.exists(token) && (tagp = opBs.get(token)) >= p) {
				var tag = lex();
				t = op(t, "B"+tag, nil);
				p = tagp;
				continue;
			}
			if(opLs.exists(token) && (tagp = opLs.get(token)) > p) {
				var tag = lex();
				t = op(t, "L"+tag, expn(tagp));
				continue;
			}
			if(opRs.exists(token) && (tagp = opRs.get(token)) >= p) {
				var tag = lex();
				t = op(t, "R"+tag, expn(tagp));
				continue;
			}
			break;
		}
		return t;
	}

	var env1:Hash<Exp>;
	function getEnv(env:Hash<Exp>, name):Exp {
		if (env.exists(name)) {
			return env.get(name);
		}
		if (env.exists("parent")) {
			switch (env.get("parent")) {
			case env(p): return getEnv(p, name);
			default: nil;
			}
		}
		return nil;
	}

	function putEnv(env:Hash<Exp>, name, value):Exp {
		var rc = put1(env, name, value);
		if(rc == nil) {
			env.set(name, value);
			return value;
		} else {
			return rc;
		}
	}
	function put1(env:Hash<Exp>, name, value) {
		if (env.exists(name)) {
			env.set(name, value);
			return value;
		}
		if (env.exists("parent")) {
			switch (env.get("parent")) {
			case env(e): return put1(e, name, value);
			default: return nil;
			}
		}
		return nil;
	}

	function bind(env1:Hash<Exp>, prm:Exp, l:Exp):Void{
		switch(prm) {
		case sym(p):
//			trace("set "+p+" "+l);
			env1.set(p,l); return;
		case op(p,t,ps):
			switch(l){
			case op(lp, lt, lps):
				bind(env1, p, lp);
				bind(env1, ps, lps);
			default: throw "error";
			}
		default: throw "error";
		}
	}

	function execute(exp:Exp):Exp {
//		trace("execute***"+exp);
		switch(exp) {
		case fun(a,b,c): return exp;
		case str(d): return exp;
		case vid: return num(0);
		case nil: return num(0);
		case num(d): return num(d);
		case sym(d): return getEnv(env1, d);
		case op(l, tag, r):
			switch(tag){
			case "P{}": return execute(r);
			case "Sif()":
				var l1 = execute(l);
				switch(r) {
				case op(l2, tag2, r2):
					if(tag2 == "Lelse") {
						switch(l1){
						case num(n):
							if(n != 0) return execute(l2);
						default:
						}
						return execute(r2);
					}
				default:
				}
				switch(l1){
				case num(n):
					if(n != 0) return execute(r);
				default:
				}
				return nil;

			case "Sfun()": return fun(l, r, env1);
			case "P()": return execute(r);
			case "B;": return execute(l);
			default:
			}
			switch(l) {
			case sym(d):
				switch(tag){
				case "R=":
					var rc = execute(r);
					putEnv(env1, d, rc);
					return rc;
				case "M()":
					if(d=="println"){
						var r = execute(r);
						trace(r);
						return r;
					}
				case "B++":
					var dt = getEnv(env1, d);
					switch(dt){
					case num(b):
						putEnv(env1, d, num(b + 1));
						return dt;
					default:
					}
				default:
				}
			default:
			}
			// 左辺を評価
			var a = execute(l);
			switch (a) {
			case num(a):
				var b = execute(r);
				switch(b){
				case num(b):
					switch (tag) {
					case "L+": return num(a + b);
					case "L-": return num(a - b);
					case "L*": return num(a * b);
					case "L/": return num(cast(a / b, Int));
					case "L>": return num(b - a);
					case "L<": return num(a - b);
					case "@": return num(b);
					}
					default:
				}
			default:
			}
			switch(tag) {
			case "@": return execute(r);
			case "M()":
				switch(a){
				case fun(prm,body, ee):
					var back = env1;
					env1 = new Hash<Exp>();
					bind(env1, prm, r);
					env1.set("parent", env(ee));
					a = execute(body);
					env1 = back;
					return a;
				default:
				}
			default:
			}
			return a;
		case env(e): return exp;
		}
	}
}