# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1385624184 28800
# Node ID 4b3b57f39f10ab97a9bf4e45099feccfd7f271de
# Parent  a1b4a2bc8d7215e24bbdce90cdec2a9e97743ccd
Implement zeroPlus macro

diff -r a1b4a2bc8d72 -r 4b3b57f39f10 interp.js
--- a/interp.js	Fri Nov 22 19:37:25 2013 -0800
+++ b/interp.js	Wed Nov 27 23:36:24 2013 -0800
@@ -28,6 +28,9 @@
 Number.prototype.tpmeth_asStringChar = function() {
 	return String.fromCharCode(this);
 };
+Number.prototype['tpmeth_isString?'] = function() {
+	return false;
+};
 Number.prototype.tpmeth_string = function() {
 	return '' + this;
 };
@@ -53,6 +56,9 @@
 String.prototype['tpmeth_from:withLength'] = function(pos, length) {
 	return this.substr(pos, length);
 };
+String.prototype['tpmeth_isString?'] = function() {
+	return true;
+};
 String.prototype.tpmeth_print = function() {
 	print(this);
 };
@@ -218,13 +224,22 @@
 
 op.prototype.eval = function(env) {
 	var l = this.left.eval(env);
-	var r = this.right.eval(env);
 	var name = this.op;
+	if (name == '&&' || name == '||') {
+		var r = (new lambda([], [this.right])).eval(env);
+	} else {
+		var r = this.right.eval(env);
+	}
 	var fun = env.findNoTop(name);
 	var ret;
 	if (fun) {
 		ret = fun(l,r)
 	} else {
+		if (name == '&&') {
+			name = 'if'
+		} else if (name == '||') {
+			name = 'ifnot'
+		}
 		ret = l['tpmeth_'+name](r);
 	}
 	return ret;
@@ -242,6 +257,22 @@
 	return new op(left, this.op, right);
 };
 
+op.prototype.tpmeth_nodeType = function() {
+	return "op";
+};
+
+op.prototype.tpmeth_left = function() {
+	return this.left;
+};
+
+op.prototype.tpmeth_right = function() {
+	return this.right;
+};
+
+op.prototype.tpmeth_opName = function() {
+	return this.op;
+};
+
 var quote_prefix = 0;
 
 symbol.prototype.eval = function(env) {
@@ -255,13 +286,25 @@
 symbol.prototype.quote = function(env) {
 	var val = env.find(this.name);
 	if (val) {
-		return makeASTNode(val);
+		var newnode = makeASTNode(val);
+		if (!(newnode instanceof symbol)) {
+			newnode = newnode.quote(env);
+		}
+		return newnode;
 	} else {
 		var hygenic = env.findQuoteTrans(this.name);
 		return hygenic ? new symbol(hygenic, this.symbols) : this;
 	}
 };
 
+symbol.prototype.tpmeth_nodeType = function() {
+	return "symbol";
+};
+
+symbol.prototype.tpmeth_name = function() {
+	return this.cleanName();
+};
+
 intlit.prototype.eval =
 	floatlit.prototype.eval =
 	strlit.prototype.eval =
@@ -286,6 +329,34 @@
 	return this;
 };
 
+intlit.prototype.tpmeth_nodeType = function() {
+	return "intlit";
+};
+
+floatlit.prototype.tpmeth_nodeType = function() {
+	return "floatlit";
+};
+
+strlit.prototype.tpmeth_nodeType = function() {
+	return "strlit";
+};
+
+arraylit.prototype.tpmeth_nodeType = function() {
+	return "arraylit";
+};
+
+listlit.prototype.tpmeth_nodeType = function() {
+	return "strlit";
+};
+
+intlit.prototype.tpmeth_value =
+	floatlit.prototype.tpmeth_value =
+	strlit.prototype.tpmeth_value =
+	arraylit.prototype.tpmeth_value =
+	listlit.prototype.tpmeth_value = function() {
+	return this.val;
+}
+
 funcall.prototype.eval = function(env) {
 	var args = [];
 	var name = this.name;
@@ -297,6 +368,7 @@
 			return this.receiver.quote(env);
 		}
 		if (this.args.length) {
+			var cur = env;
 			return this.args[0].quote(env);
 		}
 		throw new Error('quote takes an argument');
@@ -365,15 +437,33 @@
 	for (var i = 0; i < this.args.length; i++) {
 		args.push(this.args[i].quote(env));
 	}
-	var name = env.findQuoteTrans(this.name);
-	if (!name) {
-		name = this.name;
+	var name = this.name;
+	if (name[name.length-1] == ":") {
+		name = name.substr(0, name.length-1);
+	}
+	var fun = env.find(name);
+	if (fun) {
+		fun = makeASTNode(fun);
+		if (fun instanceof symbol) {
+			name = fun.cleanName();
+		} else if (fun instanceof lambda) {
+			throw new Error('FIXME');
+		}
+	} else {
+		var hygenic = env.findQuoteTrans(this.name);
+		if (hygenic) {
+			name = hygenic;
+		}
 	}
 	var ret = new funcall(name, args);
 	ret.receiver = receiver;
 	return ret;
 };
 
+funcall.prototype.tpmeth_nodeType = function() {
+	return "funcall";
+};
+
 object.prototype.eval = function(parentenv) {
 	var env = new environment(parentenv);
 	var obj = {env: env};
@@ -480,6 +570,10 @@
 	return new object(outmessages);
 };
 
+object.prototype.tpmeth_nodeType = function() {
+	return "object";
+};
+
 lambda.prototype.eval = function(parentenv) {
 	var args = this.args;
 	var exprs = this.expressions;
@@ -539,6 +633,10 @@
 	return new lambda(args, expressions);
 };
 
+lambda.prototype.tpmeth_nodeType = function() {
+	return "lambda";
+};
+
 assignment.prototype.eval = function(env) {
 	var val = this.expression.eval(env);
 	env.findSet(this.symbol.name, val);
@@ -557,3 +655,7 @@
 	env.quotetrans[name] = hygenic;
 	return new assignment(new symbol(hygenic, this.symbol.symbols), this.expression.quote(env));
 };
+
+assignment.prototype.tpmeth_nodeType = function() {
+	return "assignment";
+};
diff -r a1b4a2bc8d72 -r 4b3b57f39f10 modules/parser.tp
--- a/modules/parser.tp	Fri Nov 22 19:37:25 2013 -0800
+++ b/modules/parser.tp	Wed Nov 27 23:36:24 2013 -0800
@@ -1,4 +1,7 @@
 #{
+	_applyMatch <- :fun tomatch {
+		fun: tomatch
+	}
 	expandClass <- :chars {
 		if: (chars length) > 0 {
 			pos <- 0
@@ -90,20 +93,73 @@
 			print: "uh oh"
 		}
 	}
-	alpha <- charClass: "a-zA-Z"
+
+	zeroPlus <- macro: :matchexpr {
+		funexpr <- false
+		valid <- false
+		matchcall <- if: (matchexpr nodeType) = "lambda" {
+			valid <- true
+			quote: (_applyMatch: matchexpr tomatch)
+		} else: {
+			if: (matchexpr nodeType) = "symbol" {
+				valid <- true
+				quote: (matchexpr: tomatch)
+			}
+		}
+		if: valid {
+			quote: :tomatch {
+				cur <- 0
+				n <- tomatch byte_length
+				orig <- tomatch
+				match <- true
+				while: { match && cur < n } do: {
+					res <- matchcall
+					match <- res matched?
+					if: match {
+						//TODO: Use some kind of lightweight substring wrapper here
+						tomatch <- tomatch from: (res matchlen)
+						cur <- cur + (res matchlen)
+					}
+				}
+				if: cur > 0 {
+					#{
+						matched? <- { true }
+						matchlen <- { cur }
+					}
+				} else: {
+					#{
+						matched? <- { false }
+					}
+				}
+			}
+		} else: {
+			print: "#error Invalid zeroPlus macro call\n"
+		}
+	}
+
+
+	_alpha <- charClass: "a-zA-Z"
+	alpha <- zeroPlus: _alpha
+	alphaNum <- zeroPlus: (charClass: "a-zA-Z0-9")
 
 	main <- {
-		cmatch <- alpha: "c0123"
+		cmatch <- alpha: "czx0123"
 		zeromatch <- alpha: "01234"
 		if: (cmatch matched?) {
-			print: "c0123 matched with length " . (cmatch matchlen) . "\n"
+			print: "czx0123 matched with length " . (cmatch matchlen) . "\n"
 		} else: {
-			print: "c0123 didn't match\n"
+			print: "czx0123 didn't match\n"
 		}
 		if: (zeromatch matched?) {
 			print: "0123 matched with length " . (zeromatch matchlen) . "\n"
 		} else: {
 			print: "0123 didn't match\n"
 		}
+		zeromatchanum <- alphaNum: "01234"
+		if: (zeromatchanum matched?) {
+			print: "01234 matched with length " . (zeromatchanum matchlen) . "\n"
+		} else: {
+			print: "01234 didn't match\n"
+		}
 	}
 }