# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1387656486 28800
# Node ID b799192e404bc053352088a214fd318b9efddf18
# Parent  adad61ea2f3a1b19b12d640c244092649dcb18f8
Implemented match:where:yield and fixed a bug in zeroPlus

diff -r adad61ea2f3a -r b799192e404b modules/parser.tp
--- a/modules/parser.tp	Sat Dec 21 12:07:51 2013 -0800
+++ b/modules/parser.tp	Sat Dec 21 12:08:06 2013 -0800
@@ -145,7 +145,8 @@
 			if: inverted {
 				old <- out
 				out <- ""
-				cur <- 0
+				//skip control characters for now
+				cur <- 32
 				while: { cur < 256 } do: {
 					notfound <- true
 					idx <- 0
@@ -229,7 +230,10 @@
 						if: allBasic? {
 							ifnot: (res basicYield?) {
 								allBasic? <- false
-								yieldvals <- (orig from: 0 withLength: cur) | yieldvals
+								if: cur > 0 {
+									yieldvals <- (orig from: 0 withLength: cur) | yieldvals
+								}
+								yieldvals <- (res yield) | yieldvals
 							}
 						} else: {
 							yieldvals <- (res yield) | yieldvals
@@ -308,6 +312,94 @@
 		}
 	}
 
+	match:where:yield <- macro: :matchexpr :whereclause :ylambda {
+		syms <- []
+		withwhere <- (whereclause expressions) fold: (quote: :tomatch {}) with: :acc el {
+
+			if: (el nodeType) = "assignment" {
+				valassign <- quote: (val <- false)
+				valsym <- (valassign) symbol
+				valsym <- valsym name!: (valsym name) . ((el symbol) name)
+				valassign <- valassign symbol!: valsym
+				acc addExpression: valassign
+
+				matchassign <- quote: (hasmatch <- false)
+				matchsym <- (matchassign) symbol
+				matchsym <- matchsym name!: (matchsym name) . ((el symbol) name)
+				matchassign <- matchassign symbol!: matchsym
+				acc addExpression: matchassign
+
+				mc <- _makeMatchCall: (el expression)
+
+				if: (mc valid?) {
+					mcall <- mc matchcall
+					matchfun <- quote: :tomatch {
+						if: matchsym {
+							if: valsym = tomatch {
+								#{
+									matched? <- { true }
+									matchlen <- { valsym length }
+									basicYield? <- { true } //TODO: Check if this is correct
+									yield <- { valsym }
+								}
+							} else: {
+								#{
+									matched? <- { false }
+								}
+							}
+						} else: {
+							mr <- mcall
+							if: (mr matched?) {
+								matchsym <- true
+								valsym <- (mr yield)
+							}
+							mr
+						}
+					}
+					acc <- acc addExpression: (el expression!: matchfun)
+					syms <- list node: #{
+						orig <- el symbol
+						matchval <- valsym
+					} withTail: syms
+					acc
+				} else: {
+					print: "#error " . ((el symbol) name) . " does not have a valid match expression: " . (mc message) . "\n"
+				}
+
+			} else: {
+				print: "#error Nodes of type " . (el nodeType) . " are not allowed in match where clauses\n"
+				acc
+			}
+		}
+		mcMain <- _makeMatchCall: matchexpr
+		if: (mcMain valid?) {
+			mcall <- mcMain matchcall
+			withwhere addExpression: (quote: (matchres <- mcall))
+			successLambda <- quote: {
+				//Extra assignments will be added here
+				mlen <- matchres matchlen
+				#{
+					matched? <- { true }
+					matchlen <- { mlen }
+					basicYield? <- { false }
+					yield <- ylambda
+				}
+			}
+			sucexp <- syms fold: (successLambda expressions) with: :acc el {
+				lsym <- el orig
+				rsym <- el matchval
+				(quote: (lsym <- rsym)) | acc
+			}
+			successLambda <- successLambda expressions!: sucexp
+			withwhere addExpression: (quote: (if: (matchres matched?) successLambda else: {
+				matchres
+			}))
+			withwhere
+		} else: {
+			print: "#error Error in main match expression of match:where:yield: " . (mcMain message) . "\n"
+		}
+	}
+
 
 	_alpha <- charClass: "a-zA-Z"
 	alpha <- zeroPlus: _alpha
@@ -330,6 +422,18 @@
 		(match: "9" yield: {9})
 	]
 
+	posint <- match: Digits where: {
+		Digits <- zeroPlus: digit
+	} yield: {
+		num <- Digits fold: 0 with: :acc el {
+			print: "Element " . el . "\n"
+			acc * 10 + el
+		}
+		#{
+			litval <- num
+		}
+	}
+
 	main <- {
 		cmatch <- alpha: "czx0123"
 		zeromatch <- alpha: "01234"
@@ -362,5 +466,12 @@
 		} else: {
 			print: "3 did not match\n"
 		}
+
+		posintm <- posint: "345"
+		if: (posintm matched?) {
+			print: "345 matched with intlit value " . ((posintm yield) litval) . "\n"
+		} else: {
+			print: "345 did not match\n"
+		}
 	}
 }