//////////////////////////////////////////////////////////
// ** nise-scheme **                                    //
// コマンドプロンプトから実行できます                   //
// cscript scheme.js で対話的実行                       //
// cscript scheme.js filename でスクリプト実行          //
// 適切なIOクラスを設定すればブラウザからも実行可能です //
//////////////////////////////////////////////////////////


///////////////////////////////////////
// スクリプトインタプリタの切り分け ///
///////////////////////////////////////
var browser;
try{
	WScript.Echo("WSH mode");

	// JScriptから実行
	browser = false;
}catch(e){
	// ブラウザから実行
	browser = true;
}



//////////////////
/// エラー関数 ///
//////////////////
function raise(msg){
	throw new Error(msg);
}



////////////////////////
/// 入出力関数の宣言 ///
////////////////////////
var p = null;
var putc = null;
var getc = null;



//////////////////
/// 数値クラス ///
//////////////////
function Num(v){
	this.val = v;
}
Num.prototype.toString = function (){
	return this.val.toString();
};
Num.prototype.eq = function(other){
	return (other.constructor == Num
		&& this.val == other.val) ? T: NIL;
};
Num.prototype.add = function(other){
	return num(this.val + other.val);
};
Num.prototype.sub = function(other){
	return num(this.val - other.val);
};
Num.prototype.cmp = function(other){
	var x = this.val - other.val;
	var ret = (x<0)  ?	-1:
		  	  (x==0) ?	 0:
						 1;
	return num(ret);
};
Num.prototype.car = function(){
	return num(this.val & 1);
};
Num.prototype.cdr = function(){
	return num(this.val >> 1);
};

function num(val){return new Num(val);}


////////////////////
/// 文字列クラス ///
////////////////////
function Str(v){
	this.val = v;
}
Str.prototype.toString = function(){
	return "\""+this.val+"\"";
};
Str.prototype.eq = function(other){
	return (other.constructor == Str && 
		this.val == other.val) ? T: NIL;
};
Str.prototype.add = function(other){
	return str(this.val + other.val);
};
Str.prototype.cmp = function(other){
	var ret;
	var x =0;
	var len = this.val.length<other.val.length?
		this.val.length: other.val.length;
	for(var i=0;i<len;i++){
		x = this.val.charCode(i) - other.val.charCodeAt(i);
		if(x!=0){
			if(x<0) ret = -1;
			else if(x==0) ret = 0;
			else ret = 1;
			return num(ret);
		}
	}
	var a = this.val.length<other.val.length;
	if(a<0) ret = -1;
	else if(a==0) ret = 0;
	else ret = 1;
	return num(ret);
};
Str.prototype.car = function(){
	if(this.val == "") return NIL;
	else return num(this.val.charCodeAt(0));
};
Str.prototype.cdr = function(){
	var len = this.val.length;
	if( len <= 1) return NIL;
	else return str(this.val.substring(1, len));
};

function str(val){return new Str(val);}



//////////////////////
/// シンボルクラス ///
//////////////////////
function Sym(v){
	this.val = v;
}
Sym.prototype.toString = function(){return this.val;};
Sym.prototype.eq = function(other){
	return (other.constructor == Sym && 
			this.val == other.val) ? T: NIL;
};
function sym(val){return new Sym(val);}



////////////////////
/// 真偽値クラス ///
////////////////////
function Bool(x){
	this.type = x;
}
Bool.prototype.toString = function(){return this.type;};
Bool.prototype.eq = function(other){
	return (this.constructor == other.constructor &&
			this.type == other.type)  ? T: NIL;
};
NIL = new Bool("NIL");
T = new Bool("T");
NIL.car = NIL.cdr = function(){return NIL;};




////////////////////////////////
/// 合成データ構造構築クラス ///
////////////////////////////////
// javaで書くとこんな
// class Cons{
//   private Object a,b;
//   Cons(Object _a, Object _b){a=_a;b=_b;}
//   Object car(){return a;}
//   Object cdr(){return b;}
// }
// //1,2,3,4,nullの線形リスト
// new Cons(1, new Cons(2, new Cons(3, new Cons(4, null))));  

function Cons(a, d){
	this._car = a;
	this._cdr = d;
}
Cons.prototype.eq = function(other){
	return	(other.constructor == Cons &&
			this._car.eq(other._car) == T &&
			this._cdr.eq(other._cdr) == T) ? T: NIL;
};
Cons.prototype.isList = function(){
	var temp = this;
	while(true){
		if(temp == NIL){
			return true;
		}else if(temp.constructor == Cons){
			temp = temp._cdr;
		}else{
			return false;
		}
	}
};
Cons.prototype.toString = function(){
	var temp = this;
	if(this.isList()){
		var str = "(";
		var temp = this;
		while(temp != NIL){
			str += temp._car.toString() + " ";
			temp = temp._cdr;
		}
		str = str.substring(0,str.length-1);
		return str + ")";
	}else{
		return "(" + this._car + "." + this._cdr + ")";
	}
};
Cons.prototype.car = function(){
	return this._car;
};
Cons.prototype.cdr = function(){
	return this._cdr;
};

function cons(a,b){return new Cons(a,b);}


/////////////////////////////////////////
/// Javascriptの配列に機能を追加      ///
/// (nise-schemeの配列に変換する機能) ///
/////////////////////////////////////////
Array.prototype.toList = function(){
	var foo = function (list,index){
		if(list.length == index){
			return NIL;
		}else{
			var e = list[index];
			if(e.constructor == Array) e = e.toList();
			return new Cons(e, foo(list, index+1));
		}
	};
	return foo(this, 0);
};

//////////////////
/// 字句解析器 ///
//////////////////
function Parser(){
	function Reader(_str){
		this.str = _str;
		this.index = 0;
		this.next = function (){
			var ret = this.str.charAt(this.index);
			this.index++;
			return ret;
		};
		this.back = function (){
			this.index--;
		};
		this.hasNext = function (){
			return 0<=this.index && this.index<this.str.length;
		};
	}

	function parse_int(reader){
		var str_int = "";
		while(reader.hasNext()){
			var ch = reader.next();
			if( !ch.match(/\d/ )){
				reader.back();
				break;
			}
			str_int += ch;
		}
		return num(str_int-0);
	}

	function parse_str(reader){
		var s = "";
		while(reader.hasNext()){
			var ch = reader.next();
			if( ch=="\"" )　break;
			s += ch;
		}
		return str(s);	
	}

	function parse_sym(reader){
		var s = "";
		while(reader.hasNext()){
			var ch = reader.next();
			if( ch.match(/[\s()#]/) ){
				reader.back();
				break;
			}
			s += ch;
		}
		return sym(s);	
	}

	function parse_ws(reader){
		while(reader.hasNext()){
			var ch = reader.next();
			if( !ch.match(/\s/) ){
				reader.back();
				break;
			}
		}
		return null;
	}

	function parse_comment(reader){
		while(reader.hasNext()){
			var ch = reader.next();
			if( ch == "\n"){
				break;
			}
		}
		return null;
	}

	function parse_quote(reader){
		var foo = _parse(reader);
		var first = foo.shift();
		p(""+first+"<==>"+foo);
		return [[sym("quote"), first], foo];
	}

	function _parse(reader){
		var ch = " ";
		var tree = new Array();
		while(reader.hasNext()){
			ch = reader.next();
			if(ch.match(/\s/)){
				parse_ws(reader);
			}else if(ch == "\""){
				tree.push(parse_str(reader));
			}else if(ch.match(/\d/)){
				reader.back();
				tree.push(parse_int(reader));
			}else if(ch == "("){
				tree.push(_parse(reader));
			}else if(ch == ")"){
				return tree;
			}else if(ch == "#"){
				parse_comment(reader);
			}else if(ch == "'"){
				return parse_quote(reader);
			}else{//symbol
				reader.back();
				tree.push(parse_sym(reader));
			}
		}
		return tree;
	}

	function parse(_str){
		return _parse(new Reader(_str)).toList();
	}
	Parser.prototype.parse = parse;
}

//////////////////////////////////////
/// 変数のスコープを管理するクラス ///
//////////////////////////////////////
function Scope(upper){
	this.db = new Array();
	this.superScope = upper;
}
Scope.prototype.define = function(sym_str, val){
	if(this.db["@"+sym_str]) raise(sym_str+" is already defined.");
	this.db["@"+sym_str] = val;
};
Scope.prototype.get = function(sym_str){
	var x = this.db["@"+sym_str];
	if(x) return x;
	
	if(this.superScope){
		return this.superScope.get(sym_str);
	}else{
		raise("Scope::get() symbol not found:["+sym_str+"]");
	}
};
Scope.prototype.update = function(sym_str, val){
	if( this.db["@"+sym_str] ){
		return this.db["@"+sym_str] = val;
	}else if(this.superScope){
		return this.superScope.update(sym_str, val);
	}else{
		raise("Scope::update() symbol not found:["+sym_str+"]");
	}
};
Scope.prototype.subScope =  function(){
	return new Scope(this);
};



//////////////////
/// 関数クラス ///
//////////////////
function Lambda(scope, args, body){
	this.args = args;
	this.body = body;
	this.scope = scope;
}
Lambda.prototype.toTree = function (){
	return cons(sym("lambda"),
			cons(this.args,
				cons(this.body, 
					NIL)));
};
Lambda.prototype.toString = function (){
	return this.toTree().toString();
};

Lambda.prototype._mapeval = function(scope, xs){
	if(xs == NIL) return NIL;
	return cons(_eval(scope, xs.car()), 
					this._mapeval(scope, xs.cdr()));
}
Lambda.prototype.call = function(scope, args){
	var evaled_args = this._mapeval(scope, args);
	var local_scope = this.scope.subScope();
	var names = this.args;
	var values = evaled_args;
	while(names != NIL && values != NIL){
		var name = names.car().val
		if(name.charAt(0) == "*"){
			local_scope.define(
				sym(name.substring(1,name.length)), values);
			break;
		}else{
			local_scope.define(names.car(), values.car());
			names = names.cdr();
			values = values.cdr();
		}
	}
	var ret;
	var b = this.body;

	while( b != NIL ){
		ret = _eval(local_scope, b.car());
		b = b.cdr();
	}
	return ret;
};



////////////////////
/// マクロクラス ///
////////////////////
function Macro(args, body){
	this.args = args;
	this.body = body;
}
Macro.prototype.toTree = function (){
	return cons(sym("macro"),
			cons(this.args,
				cons(this.body, 
					NIL)));
};
Macro.prototype.toString = function (){
	return this.toTree().toString();
};
Macro.prototype.call = function(scope, args){
	var local_scope = scope.subScope();
	var names = this.args;
	var bodys = args;
	
	while(bodys != NIL){
		var name = names.car().val
		if(name.charAt(0) == "*"){
			local_scope.define(
				sym(name.substring(1,name.length)), bodys);
			break;
		}else{
			local_scope.define(names.car(), bodys.car());
			bodys = bodys.cdr();
			names = names.cdr();
		}
	}
	var e = NIL;
	var bodies = this.body;

	while (bodies != NIL){
		e = _eval(local_scope, bodies.car());
		bodies = bodies.cdr();
	}
	p(e);
	return _eval(local_scope, e);
}

//////////////////////
/// 基本構文クラス ///
//////////////////////
function Syntax(name, proc){
	this.name = name;
	this.call = proc;
}
Syntax.prototype.toString = function (){return this.name;};
function syntax(name,proc){return new Syntax(name,proc);}




////////////////////
/// 組み込み関数 ///
////////////////////
function eval_eval(scope, args){
	return _eval(scope, _eval(scope, args.car()));
}

function eval_define(scope, args){
	var s = args.car();
	var v = _eval(scope, args.cdr().car());
	scope.define(s.val, v);
	return s;
}

function eval_update(scope, args){	
	var evaled = _eval(scope, args.cdr().car());
	scope.update(args.car().val, evaled);
	return evaled;
}

function eval_if(scope, args){
	var cond = args.car();
	var tcase = args.cdr().car();
	var fcase = args.cdr().cdr().car();
	if(_eval(scope, cond) != NIL){
		return _eval(scope,tcase);
	}else{
		return _eval(scope, fcase);
	}
}

function eval_lambda(scope, args){
	var f_args = args.car();
	var f_body = args.cdr();
	return new Lambda(scope.subScope(), f_args, f_body);
}

function eval_macro(scope, args){
	var f_args = args.car();
	var f_body = args.cdr();
	return new Macro(f_args, f_body);
}

function eval_cons(scope, args){
	return cons(_eval(scope, args.car()), 
		_eval(scope, args.cdr().car()));
}

function eval_car(scope, args){
	return _eval(scope, args.car()).car();
}

function eval_cdr(scope, args){
	return _eval(scope, args.car()).cdr();
}

function eval_eq(scope, args){
	var a1 = _eval(scope, args.car());
	var a2 = _eval(scope, args.cdr().car());
	var ret = a1.eq(a2);
	return ret;
}

function eval_cmp(scope, args){
	var a1 = _eval(scope, args.car());
	var a2 = _eval(scope, args.cdr().car());
	var x = a1.cmp(a2);
	return x;
}

function eval_add(scope, args){
	var a1 = _eval(scope, args.car());
	var a2 = _eval(scope, args.cdr().car());
	return a1.add(a2);
}

function eval_sub(scope, args){
	var a1 = _eval(scope, args.car());
	var a2 = _eval(scope, args.cdr().car());
	return a1.sub(a2);
}

function eval_quote(scope, args){
	return args.car();
}

function eval_typeof(scope, args){
	var e = _eval(scope, args.car()).constructor;
	switch(e){
	case Num: return str("num");
	case Str: return str("str");
	case Sym: return str("sym");
	case Lambda: return str("lambda");
	case Macro: return str("macro");
	case Bool: return str(e==NIL ? "NIL":"T");
	case Cons: return str("cons");
	case Syntax: return str("syntax");
	default: raise("typeof");
	}
}

function eval_while(scope, args){
	var cond = args.car();
	var bodies = args.cdr();
	var ret = NIL;
	while(_eval(scope, cond) != NIL){
		var ptr = bodies;
		while(ptr != NIL){
			ret = _eval(scope, ptr.car());
			ptr = ptr.cdr();
		}
	}
	return ret;
}

function eval_catch(scope, args){
	var ret = null;
	try{
		ret = _eval(scope, args.car());
	}catch(x){
		ret = x.ret_val;
	}
	return ret;
}
function eval_throw(scope, args){
	var e = new Error("<<throw object>>");
	e.ret_val = _eval(scope, args.car());
	throw e;
}
function eval_parse(scope, args){
	var src = _eval(scope, args.car());
	var ret = (new Parser()).parse(src.val);
	return ret;
}
function eval_setcar(scope, args){
	var c = _eval(scope, args.car());
	var x = _eval(scope, args.cdr().car());
	c._car = x;
	return x;
}

function eval_setcdr(scope, args){
	var c = _eval(scope, args.car());
	var x = _eval(scope, args.cdr().car());
	c._cdr = x;
	return x;
}
function eval_conv(scope, args){
	var val = _eval(scope, args.car());
	if ( val.constructor == Num)
		return String.fromCharCode(val.val);
	if ( val.constructor == Str)
		return val.val.charCodeAt(0);
	return NIL;
}

function eval_p(scope, args){
	var evaled = _eval(scope, args.car());
	p(evaled.toString());
	return evaled;
}
function eval_putc(scope, args){
	var evaled = _eval(scope, args.car());
	putc(evaled.val);
	return evaled;
}
function eval_getc(scope, args){
	var x = getc();
	return x==-1? NIL: num(x);
}


function _eval(scope, code){
	//p("EVAL::"+code);
	switch(code.constructor){
	case Num:	return code;
	case Str:	return code;
	case Bool:	return code;
	case Sym:	return scope.get(code.val);
	case Cons:
	{
		var func = code.car();
		var args = code.cdr();

		if (func.constructor == Sym){
			func = scope.get(func);
		}else if(func.constructor == Cons){
			func = _eval(scope, func);
		}
		
		switch(func.constructor) {
		case Lambda:
		case Macro:
		case Syntax:
			return func.call(scope, args);
		default:
			raise("not function:"+func+":"+func.constructor);
		}
	}
	default: 
		raise("_eval unknown object");
	}
}






////////////////////
/// 評価器クラス ///
////////////////////
function Evaluator(){
	var root = new Scope();
	this.root = root;
	root.define("T", T);
	root.define("NIL", NIL);
	root.define("eval",syntax("eval", eval_eval));
	root.define("define",syntax("define", eval_define));
	root.define("update",syntax("update", eval_update));
	root.define("if",syntax("if", eval_if));
	root.define("cons",syntax("cons", eval_cons));
	root.define("car",syntax("car", eval_car));
	root.define("cdr",syntax("cdr", eval_cdr));
	root.define("lambda",syntax("lambda", eval_lambda));
	root.define("macro",syntax("macro", eval_macro));
	root.define("eq",syntax("eq", eval_eq));
	root.define("cmp",syntax("cmp", eval_cmp));
	root.define("typeof",syntax("typeof", eval_typeof));
	root.define("p",syntax("p", eval_p));
	root.define("+",syntax("+", eval_add));
	root.define("-",syntax("-", eval_sub));
	root.define("quote",syntax("quote", eval_quote));
	root.define("getc",syntax("getc", eval_getc));
	root.define("putc",syntax("putc", eval_putc));
	root.define("while",syntax("while", eval_while));
	root.define("catch",syntax("catch", eval_catch));
	root.define("throw",syntax("throw", eval_throw));
	root.define("parse",syntax("parse", eval_parse));
	root.define("conv",syntax("conv", eval_conv));
	root.define("setcar",syntax("setcar", eval_setcar));
	root.define("setcdr",syntax("setcdr", eval_setcdr));

	this.eval = function(tree){
		return _eval(this.root, tree);
	};
}



////////////////////////
/// インタプリタ本体 ///
////////////////////////
function Interpriter(io){
	this.show_flag = false;
	if(!io) {
		this.io = new NOPIO();
	}
	this.set_io(io);

	this.parser = new Parser();
	this.evaluator = new Evaluator();
}

Interpriter.prototype.set_io = function(_io){
	this.io = _io;
	p = this.io.p;
	putc = this.io.putc;
	getc = this.io.getc;
};
Interpriter.prototype.eval_str = function(code){
	var src = this.parser.parse(code);
	var s;
	while(src != NIL){
		s = src.car();
		if(this.show_flag) p(">>>"+s);
		var v = this.evaluator.eval(s);
		p(v);
		src = src.cdr();
	}
};
//////////////////////////////
/// 標準ライブラリ PoorLib ///
//////////////////////////////
Interpriter.prototype.poor_lib = ""
	+"(define not (lambda (b) (if b NIL T)))\n"
	+"(define ne (lambda(a b) (not (eq a b))))\n"
	+"(define lt (lambda(a b) (eq (cmp a b) (- 0 1))))\n"
	+"(define gt (lambda(a b) (eq (cmp a b) 1)))\n"
	+"(define le (lambda(a b) (not (gt a b))))\n"
	+"(define ge (lambda(a b) (not (lt a b))))\n"

	+"(define *(lambda(a b)(if(eq a 0)0(+ b(*(- a 1)b)))))\n"
	+"(define /(lambda(a b)"
	+"	(if (lt a b) 0"
	+"		(+ 1 (/ (- a b) b)))))\n"
	+"(define % (lambda(a b)"
	+"	(if (lt a b) a"
	+"		(% (- a b) b))))\n"

	+"(define list (lambda (*args) args))\n"

	+"(define map (lambda (xs proc)\n"
	+"	(if (eq xs NIL) NIL\n"
	+"		(cons (proc (car xs))\n"
	+"			(map (cdr xs) proc)))))\n"

	+"(define let (macro (pairs body)\n"
	+"	(p (cons\n"
	+"		(list\n"
	+"			(quote lambda)\n"
	+"			(map pairs (lambda (e) (car e)))\n"
	+"			body)\n"
	+"		(map pairs (lambda (e) (car (cdr e)))))\n"
	+")))\n"

	+"(define reduce (lambda (xs init proc)\n"
	+"	(define loop (lambda (xs val)\n"
	+"		(if (eq xs NIL) val\n"
	+"			(loop (cdr xs) (proc val (car xs))))))\n"
	+"	(loop xs init)))\n"

	+"(define and (macro(a b)\n"
	+"	(list "
	+"		(quote if) a b NIL)))"

	+"(define or (macro (a b)\n"
	+"	(list "
	+"		(quote if) a T b)))"

	+"(define cond (macro (cs)\n"
	+"	(define loop (lambda (xs)\n"
	+"		(if (eq xs NIL) NIL\n"
	+"			(list \n" 
	+"				(quote if)\n"
	+"				(car (car xs))\n"
	+"				(car (cdr (car xs)))\n"
	+"				(loop (cdr xs))))))\n"
	+"	(loop cs)))\n"

	+"(define case (macro (val *branch)\n"
	+"	(define loop (lambda (bs)\n"
	+"		(if (not (eq (typeof (car bs)) \"cons\"))\n"
	+"			(car bs)\n"
	+"			(list \n"
	+"				(quote if)\n"
	+"				(list (quote eq) val (car (car bs)))\n"
	+"			(car (cdr (car bs)))\n"
	+"			(loop (cdr bs))))))\n"
	+"	(loop branch)))\n"

	+"(define reverse (lambda (foo)\n"
	+"	(define loop (lambda (xs val)\n"
	+"		(if (eq xs NIL) val\n"
	+"			(loop (cdr xs) (cons (car xs) val)))))\n"
	+"	(loop foo NIL)))\n"

	+"(define begin (macro (*args)\n"
	+"	(list (cons (quote lambda) (cons NIL args)))))\n"

	+"(define sort (lambda (xs)\n"
	+"	(define ins (lambda (xs x)\n"
	+"		(if (eq xs NIL) (cons x NIL)\n"
	+"			(if (lt x (car xs)) (cons x xs)\n"
	+"				(cons (car xs) (ins (cdr xs) x))))))\n"
	+"	(define _sort (lambda (xs val)\n"
	+"		(if (eq xs NIL) val\n"
	+"			(_sort (cdr xs) (ins val (car xs))))))\n"
	+"	(_sort xs NIL)))\n"

	+"	(define find (lambda (xs proc)\n"
	+"		(if (eq xs NIL) NIL\n"
	+"			(if (proc (car xs)) (cons (car xs) (find (cdr xs) proc))\n"
	+"				(find (cdr xs) proc)))))\n"

	;

////////////////////////////////
/// 何も入出力しないIOクラス ///
////////////////////////////////
function NOPIO(){
	this.putc = this.p = function (x){return x;};
	this.getc = function (){return -1;};
}

//////////////////////////
/// JScript用 IOクラス ///
//////////////////////////
function WScriptIO(){
	WScriptIO.prototype.p = function(x){
		WScript.StdOut.Write(x+"\n");
		return x;
	};
	WScriptIO.prototype.putc = function(n){
		WScript.StdOut.Write(String.fromCharCode(n));
		return n;
	};
	WScriptIO.prototype.getc = function(){
		if(WScript.StdIn.AtEndOfStream) return -1;
		return WScript.StdIn.Read(1).charCodeAt(0);
	};		
}
/////////////////////////
/// JScript用main関数 ///
/////////////////////////
function jscript_main(){
	// インタプリタ生成
	var interpriter = new Interpriter(new NOPIO());

	// 標準ライブラリ "PoorLib"の読み込み
	interpriter.eval_str(interpriter.poor_lib);

	// 入出力設定
	interpriter.set_io(new WScriptIO());

	// ファイルシステム
	var fso = WScript.CreateObject("Scripting.FileSystemObject");

	
	if(WScript.Arguments.Length == 0){
		// 対話的実行
		interpriter.show_flag = false;
		while(!WScript.AtEndOfLine){
			WScript.StdOut.Write(">>> ");
			var src = WScript.StdIn.ReadLine();
			var result = interpriter.eval_str(src);
		}
	}else{
		// ソースコードを一気に実行
		interpriter.show_flag = true;
		var fin = fso.GetFile(WScript.Arguments.Item(0)).OpenAsTextStream(1);
		var src = fin.ReadAll();
		interpriter.eval_str(src);
	}

}

if(!browser){
	jscript_main();
}