# HG changeset patch
# User Mike Pavone <pavone@retrodev.com>
# Date 1385974216 28800
# Node ID e00a8bc6361b4254c2e9ec5f36c33bb5dbeb639e
# Parent  32080f96c3a032fb6e0c1c21be39a894b15ffae1
Implement match:yield macro

diff -r 32080f96c3a0 -r e00a8bc6361b interp.js
--- a/interp.js	Sat Nov 30 15:05:24 2013 -0800
+++ b/interp.js	Mon Dec 02 00:50:16 2013 -0800
@@ -295,7 +295,11 @@
 	if (val) {
 		var newnode = makeASTNode(val);
 		if (!(newnode instanceof symbol)) {
-			newnode = newnode.quote(env);
+			if ('quote' in newnode) {
+				newnode = newnode.quote(env);
+			} else {
+				throw new Error('Symbol ' + this.name + ' is not bound to a valid AST value, instead it is bound to an object with keys ' + JSON.stringify(Object.keys(newnode)));
+			}
 		}
 		return newnode;
 	} else {
diff -r 32080f96c3a0 -r e00a8bc6361b modules/parser.tp
--- a/modules/parser.tp	Sat Nov 30 15:05:24 2013 -0800
+++ b/modules/parser.tp	Mon Dec 02 00:50:16 2013 -0800
@@ -16,6 +16,8 @@
 					#{
 						matched? <- { true }
 						matchlen <- { str length }
+						basicYield? <- { true }
+						yield <- { str }
 					}
 				} else: {
 					#{
@@ -71,6 +73,8 @@
 											#{
 												matched? <- { true }
 												matchlen <- { total }
+												basicYield? <- { true }
+												yield <- { tomatch from: 0 withLen: total }
 											}
 										} else: {
 											rm
@@ -188,6 +192,8 @@
 						#{
 							matched? <- { true }
 							matchlen <- { 1 }
+							basicYield? <- { true }
+							yield <- { tomatch from: 0 withLength: 1 }
 						}
 					}
 				} else: {
@@ -212,19 +218,42 @@
 				n <- tomatch byte_length
 				orig <- tomatch
 				match <- true
+				allBasic? <- true
+				yieldvals <- []
 				while: { match && cur < n } do: {
 					res <- mcall
 					match <- res matched?
 					if: match {
 						//TODO: Use some kind of lightweight substring wrapper here
 						tomatch <- tomatch from: (res matchlen)
+						if: allBasic? {
+							ifnot: (res basicYield?) {
+								allBasic? <- false
+								yieldvals <- (orig from: 0 withLength: cur) | yieldvals
+							}
+						} else: {
+							yieldvals <- (res yield) | yieldvals
+						}
+						allBasic? <- allBasic? && (res basicYield?)
 						cur <- cur + (res matchlen)
 					}
 				}
 				if: cur > 0 {
-					#{
-						matched? <- { true }
-						matchlen <- { cur }
+					if: allBasic? {
+						#{
+							matched? <- { true }
+							matchlen <- { cur }
+							basicYield? <- { true }
+							yield <- { orig from: 0 withLength: cur }
+						}
+					} else: {
+						yieldvals <- yieldvals reverse
+						#{
+							matched? <- { true }
+							matchlen <- { cur }
+							basicYield? <- { false }
+							yield <- { yieldvals }
+						}
 					}
 				} else: {
 					#{
@@ -257,6 +286,28 @@
 		}
 	}
 
+	match:yield <- macro: :matchexpr :ylambda {
+		mc <- _makeMatchCall: matchexpr
+		if: (mc valid?) {
+			mcall <- mc matchcall
+			quote: :tomatch {
+				res <- mcall
+				if: (res matched?) {
+					#{
+						matched? <- { true }
+						matchlen <- { res matchlen }
+						basicYield? <- { false }
+						yield <- ylambda
+					}
+				} else: {
+					res
+				}
+			}
+		} else: {
+			print: "#error Invalid macth:yield macro call: " . (mc message) . "\n"
+		}
+	}
+
 
 	_alpha <- charClass: "a-zA-Z"
 	alpha <- zeroPlus: _alpha
@@ -266,6 +317,18 @@
 		"/*" . (zeroPlus: (matchOne: [(charClass: "^*") "*" . (charClass: "^/")])) . "*/"
 	])
 
+	digit <- matchOne: [
+		(match: "0" yield: {0})
+		(match: "1" yield: {1})
+		(match: "2" yield: {2})
+		(match: "3" yield: {3})
+		(match: "4" yield: {4})
+		(match: "5" yield: {5})
+		(match: "6" yield: {6})
+		(match: "7" yield: {7})
+		(match: "8" yield: {8})
+		(match: "9" yield: {9})
+	]
 
 	main <- {
 		cmatch <- alpha: "czx0123"
@@ -293,5 +356,11 @@
 		} else: {
 			print: stuff . " did not match hws rule\n"
 		}
+		tmatch <- digit: "3"
+		if: (tmatch matched?) {
+			print: "3 matched with yield " . (tmatch yield) . ", yield + 1 = " . ((tmatch yield) + 1) . "\n"
+		} else: {
+			print: "3 did not match\n"
+		}
 	}
 }