# HG changeset patch
# User Michael Pavone <pavone@retrodev.com>
# Date 1401606876 25200
# Node ID 03a07e540b9fa0ddc2ce04cff046fe946f67254e
# Parent  08081b0a938213599a4f4d07b10521ab91f60479
Memoize results of match:where:yield and matchOne: macros. Fix opsym rule to use the symbol ast node.

diff -r 08081b0a9382 -r 03a07e540b9f modules/parser.tp
--- a/modules/parser.tp	Sat May 31 22:51:00 2014 -0700
+++ b/modules/parser.tp	Sun Jun 01 00:14:36 2014 -0700
@@ -1,7 +1,39 @@
 {
+	_matchid <- 0
+	getMatchId <- {
+		id <- _matchid
+		_matchid <- _matchid + 1
+		id
+	}
+	matchMemo <- {
+		_posdata <- #[]
+		_checkInitData <- :len {
+			len <- len + 1
+			while: { (_posdata length) < len } do: {
+				_posdata append: (dict hash)
+			}
+		}
+		#{
+			memo:at:withId:length <- :val :at :id :len {
+				_checkInitData: len
+				(_posdata get: at) set: id val
+				self
+			}
+			
+			getMemo:at:else <- :id :at :else {
+				if: (_posdata length) > at {
+					(_posdata get: at) ifget: id :val {
+						val
+					} else: else
+				} else: else
+			}
+		}
+	}
 light:from:withLength <- :_base :_start :_len {
+	_matchmemo <- matchMemo:
 	if: (not: (_base isBasicString?)) {
 		_start <- _start + (_base start)
+		_matchmemo <- _base memoData
 		_base <- _base base
 	}
 	_needsflat? <- true
@@ -53,6 +85,16 @@
 		isBasicString? <- { false }
 		base <- { _base }
 		start <- { _start }
+		memoData <- { _matchmemo }
+		
+		memo:at:withId <- :val :at :id {
+			_matchmemo memo: val at: (at + _start) withId: id length: (_base length)
+			self
+		}
+		
+		getMemo:at:else <- :id :at :else {
+			_matchmemo getMemo: id at: (at + _start) else: else
+		}
 	}
 }
 
@@ -371,6 +413,7 @@
 	}
 
 	matchOne <- macro: :options {
+		myid <- getMatchId:
 		options <- (options value) map: :option {
 			_makeMatchCall: option
 		}
@@ -384,7 +427,12 @@
 			}
 		}
 		quote: :tomatch {
-			body
+			tomatch <- light: tomatch from: 0
+			tomatch getMemo: myid at: 0 else: {
+				ret <- body
+				tomatch memo: ret at: 0 withId: myid
+				ret
+			}
 		}
 	}
 
@@ -431,8 +479,9 @@
 	}
 
 	match:where:yield <- macro: :matchexpr :whereclause :ylambda {
+		myid <- getMatchId:
 		syms <- []
-		withwhere <- (whereclause expressions) fold: (quote: :tomatch {}) with: :acc el {
+		withwhere <- (whereclause expressions) fold: (quote: {}) with: :acc el {
 
 			if: (el nodeType) = "assignment" {
 				valassign <- quote: (val <- false)
@@ -523,10 +572,16 @@
 				(quote: (lsym <- rsym)) | acc
 			}
 			successLambda <- successLambda expressions!: sucexp
-			withwhere addExpression: (quote: (if: matchres successLambda else: {
+			withwhere addExpression: (quote: (ret <- if: matchres successLambda else: {
 				matchres
 			}))
-			withwhere
+			withwhere addExpression: (quote: (tomatch memo: ret at: 0 withId: myid))
+			withwhere addExpression: (quote: ret)
+			
+			quote: :tomatch {
+				tomatch <- light: tomatch from: 0
+				tomatch getMemo: myid at: 0 else: withwhere
+			}
 		} else: {
 			print: "#error Error in main match expression of match:where:yield: " . (mcMain message) . "\n"
 		}
@@ -797,12 +852,7 @@
 	opsym <- match: Name where: {
 		Name <- matchOne: ["&&" "||" "<=" ">=" "<" ">" "=" "!=" "=" "-" "." "*" "/" "%" "|"]
 	} yield: {
-		#{
-			name <- Name
-			string <- {
-				name
-			}
-		}
+		ast symbol: Name
 	}
 
 	assignment <- match: ws . Symbol . hws . "<-" . Expr where: {