Mercurial > repos > icfp2013

changeset 27:655d5b19333d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add memoization support to program generator
author Mike Pavone <pavone@retrodev.com>
date Sat, 10 Aug 2013 17:25:33 -0700
parents bb80f86c5048
children 6384e577842d
files src/bv.tp
diffstat 1 files changed, 96 insertions(+), 75 deletions(-) [+]
line wrap: on
line diff
--- a/src/bv.tp	Sat Aug 10 16:31:48 2013 -0700
+++ b/src/bv.tp	Sat Aug 10 17:25:33 2013 -0700
@@ -1,16 +1,16 @@
 #{
 	program <- {
-		_input <- 0i64
-		_acc <- 0i64
-		_val <- 0i64
+		_input <- 0u64
+		_acc <- 0u64
+		_val <- 0u64
 		_zero <- #{
 			string <- { "0" }
-			eval <- { 0i64 }
+			eval <- { 0u64 }
 		}
 
 		_one <- #{
 			string <- { "1" }
-			eval <- { 1i64 }
+			eval <- { 1u64 }
 		}
 
 		_inputNode <- #{
@@ -25,6 +25,9 @@
 			string <- { "val" }
 			eval <- { _val }
 		}
+		_memo <- #[]
+		_memoFoldBody <- #[]
+		_memoFoldParam <- #[]
 		#{
 			plus <- :left right {
 				#{
@@ -64,35 +67,35 @@
 			opNot <- :exp {
 				#{
 					string <- { "(not " . (string: exp) . ")" }
-					eval <- { (eval: exp) xor -1i64 }
+					eval <- { (eval: exp) xor -1u64 }
 				}
 			}
 
 			shl1 <- :exp {
 				#{
 					string <- { "(shl1 " . (string: exp) . ")" }
-					eval <- { lshift: (eval: exp) by: 1i64 }
+					eval <- { lshift: (eval: exp) by: 1u64 }
 				}
 			}
 
 			shr1 <- :exp {
 				#{
 					string <- { "(shr1 " . (string: exp) . ")" }
-					eval <- { rshift: (eval: exp) by: 1i64 }
+					eval <- { rshift: (eval: exp) by: 1u64 }
 				}
 			}
 
 			shr4 <- :exp {
 				#{
 					string <- { "(shr4 " . (string: exp) . ")" }
-					eval <- { rshift: (eval: exp) by: 4i64 }
+					eval <- { rshift: (eval: exp) by: 4u64 }
 				}
 			}
 
 			shr16 <- :exp {
 				#{
 					string <- { "(shr16 " . (string: exp) . ")" }
-					eval <- { rshift: (eval: exp) by: 16i64 }
+					eval <- { rshift: (eval: exp) by: 16u64 }
 				}
 			}
 
@@ -104,7 +107,7 @@
 				#{
 					string <- { "(if0 " . (string: exp) . " " . (string: ifzero) . " " . (string: ifnotzero) . ")" }
 					eval <- {
-						if: (eval: exp) = 0i64 {
+						if: (eval: exp) = 0u64 {
 							eval: ifzero
 						} else: {
 							eval: ifnotzero
@@ -123,7 +126,7 @@
 						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]
+						vals <- #[source and 255u64 (rshift: source by: 8u64) and 255u64 (rshift: source by: 16u64) and 255u64 (rshift: source by: 24u64) and 255u64 (rshift: source by: 32u64) and 255u64 (rshift: source by: 40u64) and 255u64 (rshift: source by: 48u64) and 255u64 (rshift: source by: 56u64) and 255u64]
 						foreach: vals :idx cur {
 							_val <- cur
 							_acc <- (eval: fun)
@@ -160,84 +163,102 @@
 
 			//TODO: memoize this to improve runtime for large n
 			allOfSize:inFold? <- :n :infold? {
-				if: n = 1 {
-					res <- #[one zero input]
-					if: infold? = 2 {
-						res append: acc
-						res append: val
-					}
-					res
+				memo <- if: infold? = 2 {
+					_memoFoldBody
 				} else: {
-					res <- #[]
-					foreach: (allOfSize: n - 1 inFold?: infold?) :idx exp {
-						res append: (opNot: exp)
-						res append: (shl1: exp)
-						res append: (shr1: exp)
-						res append: (shr4: exp)
-						res append: (shr16: exp)
+					if: infold? = 1 && n > 4 {
+						_memoFoldParam
+					} else: {
+						_memo
 					}
-					if: n > 2 {
-						numLeft <- 1
-						argTotal <- n - 1
-						while: { numLeft < argTotal } do: {
-							numRight <- argTotal - numLeft
-							choicesRight <- (allOfSize: numRight inFold?: infold?)
-							foreach: (allOfSize: numLeft inFold?: infold?) :idx leftExp {
-								foreach: choicesRight :idx rightExp {
-									res append: (opAnd: leftExp rightExp)
-									res append: (opOr: leftExp rightExp)
-									res append: (opXor: leftExp rightExp)
-									res append: (plus: leftExp rightExp)
-								}
-							}
-							numLeft <- numLeft + 1
+				}
+				if: n - 1 < (memo length) {
+					print: "Memo hit: " . (string: n) . "\n"
+					memo get: (n - 1)
+				} else: {
+					if: n = 1 {
+						res <- #[one zero input]
+						if: infold? = 2 {
+							res append: acc
+							res append: val
 						}
-						if: n > 3 {
+						print: "Saving at memo index: " . (string: (memo length)) . "\n"
+						memo append: res
+						res
+					} else: {
+						res <- #[]
+						foreach: (allOfSize: n - 1 inFold?: infold?) :idx exp {
+							res append: (opNot: exp)
+							res append: (shl1: exp)
+							res append: (shr1: exp)
+							res append: (shr4: exp)
+							res append: (shr16: exp)
+						}
+						if: n > 2 {
 							numLeft <- 1
-							limitLeft <- n - 2
-							while: { numLeft < limitLeft } do: {
-								numMid <- 1
-								limitMid <- n - (1 + numLeft)
-								while: { numMid < limitMid } do: {
-									numRight <- n - (1 + numLeft + numMid)
-									choicesRight <- (allOfSize: numRight inFold?: infold?)
-									choicesMid <- (allOfSize: numMid inFold?: infold?)
-									foreach: (allOfSize: numLeft inFold?: infold?) :idx leftExp {
-										foreach: choicesMid :idx midExp {
-											foreach: choicesRight :idx rightExp {
-												res append: (if0: leftExp then: midExp else: rightExp)
-											}
-										}
+							argTotal <- n - 1
+							while: { numLeft < argTotal } do: {
+								numRight <- argTotal - numLeft
+								choicesRight <- (allOfSize: numRight inFold?: infold?)
+								foreach: (allOfSize: numLeft inFold?: infold?) :idx leftExp {
+									foreach: choicesRight :idx rightExp {
+										res append: (opAnd: leftExp rightExp)
+										res append: (opOr: leftExp rightExp)
+										res append: (opXor: leftExp rightExp)
+										res append: (plus: leftExp rightExp)
 									}
-									numMid <- numMid + 1
 								}
 								numLeft <- numLeft + 1
 							}
-							if: n > 4 && infold? = 0 {
-								numSeq <- 1
-								limitSeq <- n - 3
-								while: { numSeq < limitSeq } do: {
-									numFun <- 1
-									limitFun <- n - (2 + numSeq)
-									while: { numFun < limitFun } do: {
-										numStart <- n - (2 + numSeq + numFun)
-										choicesStart <- (allOfSize: numStart inFold?: 1)
-										choicesFun <- (allOfSize: numFun inFold?: 2)
-										foreach: (allOfSize: numSeq inFold?: 1) :idx seqExp {
-											foreach: choicesFun :idx funExp {
-												foreach: choicesStart :idx startExp {
-													res append: (fold: seqExp with: funExp startingAt: startExp)
+							if: n > 3 {
+								numLeft <- 1
+								limitLeft <- n - 2
+								while: { numLeft < limitLeft } do: {
+									numMid <- 1
+									limitMid <- n - (1 + numLeft)
+									while: { numMid < limitMid } do: {
+										numRight <- n - (1 + numLeft + numMid)
+										choicesRight <- (allOfSize: numRight inFold?: infold?)
+										choicesMid <- (allOfSize: numMid inFold?: infold?)
+										foreach: (allOfSize: numLeft inFold?: infold?) :idx leftExp {
+											foreach: choicesMid :idx midExp {
+												foreach: choicesRight :idx rightExp {
+													res append: (if0: leftExp then: midExp else: rightExp)
 												}
 											}
 										}
-										numFun <- numFun + 1
+										numMid <- numMid + 1
 									}
-									numSeq <- numSeq + 1
+									numLeft <- numLeft + 1
+								}
+								if: n > 4 && infold? = 0 {
+									numSeq <- 1
+									limitSeq <- n - 3
+									while: { numSeq < limitSeq } do: {
+										numFun <- 1
+										limitFun <- n - (2 + numSeq)
+										while: { numFun < limitFun } do: {
+											numStart <- n - (2 + numSeq + numFun)
+											choicesStart <- (allOfSize: numStart inFold?: 1)
+											choicesFun <- (allOfSize: numFun inFold?: 2)
+											foreach: (allOfSize: numSeq inFold?: 1) :idx seqExp {
+												foreach: choicesFun :idx funExp {
+													foreach: choicesStart :idx startExp {
+														res append: (fold: seqExp with: funExp startingAt: startExp)
+													}
+												}
+											}
+											numFun <- numFun + 1
+										}
+										numSeq <- numSeq + 1
+									}
 								}
 							}
 						}
+						print: "Saving " . (string: n) . " at memo index: " . (string: (memo length)) . "\n"
+						memo append: res
+						res
 					}
-					res
 				}
 			}
 
@@ -251,7 +272,7 @@
 		print: (string: prog) . "\n"
 		//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]
+		vals <- #[0u64 1u64 2u64 3u64 4u64 5u64 6u64 7u64 8u64 9u64 10u64 11u64 12u64 13u64 14u64 15u64 0x30001u64 0x50015u64 (lshift: 0x11223344u64 by: 32u64) or 0x55667788u64]
 		foreach: vals :idx val {
 			print: "p(0x" . (hex: val) . ") = 0x" . (hex: (prog run: val)) . "\n"
 		}