# HG changeset patch
# User Mike Pavone <pavone@retrodev.com>
# Date 1376026322 25200
# Node ID 538440e1c3d2f1f211c1ee653920972b0d8b9563
# Parent  dfc5f00c94bc3c317ce4e9419db6b03b663a8cde
Add support for fold to evaluator

diff -r dfc5f00c94bc -r 538440e1c3d2 src/bv.tp
--- a/src/bv.tp	Thu Aug 08 21:54:02 2013 -0700
+++ b/src/bv.tp	Thu Aug 08 22:32:02 2013 -0700
@@ -1,6 +1,8 @@
 #{
 	program <- {
 		_input <- 0i64
+		_acc <- 0i64
+		_val <- 0i64
 		_zero <- #{
 			string <- { "0" }
 			eval <- { 0i64 }
@@ -15,6 +17,14 @@
 			string <- { "input" }
 			eval <- { _input }
 		}
+		_accNode <- #{
+			string <- { "acc" }
+			eval <- { _acc }
+		}
+		_valNode <- #{
+			string <- { "val" }
+			eval <- { _val }
+		}
 		#{
 			plus <- :left right {
 				#{
@@ -54,39 +64,41 @@
 			opNot <- :exp {
 				#{
 					string <- { "(not " . (string: exp) . ")" }
-					eval <- { (eval: exp) xor -1 }
+					eval <- { (eval: exp) xor -1i64 }
 				}
 			}
 
 			shl1 <- :exp {
 				#{
 					string <- { "(shl1 " . (string: exp) . ")" }
-					eval <- { lshift: (eval: exp) by: 1 }
+					eval <- { lshift: (eval: exp) by: 1i64 }
 				}
 			}
 
 			shr1 <- :exp {
 				#{
 					string <- { "(shr1 " . (string: exp) . ")" }
-					eval <- { rshift: (eval: exp) by: 1 }
+					eval <- { rshift: (eval: exp) by: 1i64 }
 				}
 			}
 
 			shr4 <- :exp {
 				#{
 					string <- { "(shr4 " . (string: exp) . ")" }
-					eval <- { rshift: (eval: exp) by: 4 }
+					eval <- { rshift: (eval: exp) by: 4i64 }
 				}
 			}
 
 			shr16 <- :exp {
 				#{
 					string <- { "(shr16 " . (string: exp) . ")" }
-					eval <- { rshift: (eval: exp) by: 16 }
+					eval <- { rshift: (eval: exp) by: 16i64 }
 				}
 			}
 
 			input <- { _inputNode }
+			acc <- { _accNode }
+			val <- { _valNode }
 
 			if0:then:else <- :exp ifzero :ifnotzero {
 				#{
@@ -101,6 +113,26 @@
 				}
 			}
 
+			fold:with:startingAt <- :toFold :fun :startAcc {
+				#{
+					string <- {
+						"(fold " . (string: toFold) . " " . (string: startAcc) . "(lambda (val acc) " . (string: fun) . "))"
+					}
+					eval <- {
+						_acc <- (eval: startAcc)
+						source <- (eval: toFold)
+						//parser doesn''t currently like vertical whitespace in arays so
+						//this needs to be on a single line until that bug is fixed
+						vals <- #[source and 255i64 (rshift: source by: 8i64) and 255i64 (rshift: source by: 16i64) and 255i64 (rshift: source by: 24i64) and 255i64 (rshift: source by: 32i64) and 255i64 (rshift: source by: 40i64) and 255i64 (rshift: source by: 48i64) and 255i64 (rshift: source by: 56i64) and 255i64]
+						foreach: vals :idx cur {
+							_val <- cur
+							_acc <- (eval: fun)
+						}
+						_acc
+					}
+				}
+			}
+
 			run <- :in {
 				_input <- in
 				eval: root
@@ -120,19 +152,26 @@
 				)
 				self
 			}
+
+			exampleprog <- {
+				root <- fold: input with: (opOr: val acc) startingAt: zero
+				self
+			}
 		}
 	}
 
-	test <- {
-		prog <- program gentestprog
+	test <- :prog {
 		print: (string: prog) . "\n"
-		vals <- #[0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0x30001 0x50015]
+		//parser doesn''t currently like vertical whitespace in arays so
+		//this needs to be on a single line until that bug is fixed
+		vals <- #[0i64 1i64 2i64 3i64 4i64 5i64 6i64 7i64 8i64 9i64 10i64 11i64 12i64 13i64 14i64 15i64 0x30001i64 0x50015i64 (lshift: 0x11223344i64 by: 32i64) or 0x55667788i64]
 		foreach: vals :idx val {
 			print: "p(0x" . (hex: val) . ") = 0x" . (hex: (prog run: val)) . "\n"
 		}
 	}
 
 	main <- {
-		test:
+		test: (program gentestprog)
+		test: (program exampleprog)
 	}
 }