view src/bv.tp @ 7:301f16245955

Add support for generating all programs up to size 3 inclusive
author Mike Pavone <pavone@retrodev.com>
date Fri, 09 Aug 2013 00:01:05 -0700
parents 538440e1c3d2
children 3f0172ceab81
line wrap: on
line source

#{
	program <- {
		_input <- 0i64
		_acc <- 0i64
		_val <- 0i64
		_zero <- #{
			string <- { "0" }
			eval <- { 0i64 }
		}

		_one <- #{
			string <- { "1" }
			eval <- { 1i64 }
		}

		_inputNode <- #{
			string <- { "input" }
			eval <- { _input }
		}
		_accNode <- #{
			string <- { "acc" }
			eval <- { _acc }
		}
		_valNode <- #{
			string <- { "val" }
			eval <- { _val }
		}
		#{
			plus <- :left right {
				#{
					string <- { "(plus " . (string: left) . " " . (string: right) . ")" }
					eval <- { (eval: left) + (eval: right)}
				}
			}
			zero <- {
				_zero
			}

			one <- {
				_one
			}

			opAnd <- :left right {
				#{
					string <- { "(and " . (string: left) . " " . (string: right) . ")" }
					eval <- { (eval: left) and (eval: right)}
				}
			}

			opOr <- :left right {
				#{
					string <- { "(or " . (string: left) . " " . (string: right) . ")" }
					eval <- { (eval: left) or (eval: right)}
				}
			}

			opXor <- :left right {
				#{
					string <- { "(xor " . (string: left) . " " . (string: right) . ")" }
					eval <- { (eval: left) xor (eval: right)}
				}
			}

			opNot <- :exp {
				#{
					string <- { "(not " . (string: exp) . ")" }
					eval <- { (eval: exp) xor -1i64 }
				}
			}

			shl1 <- :exp {
				#{
					string <- { "(shl1 " . (string: exp) . ")" }
					eval <- { lshift: (eval: exp) by: 1i64 }
				}
			}

			shr1 <- :exp {
				#{
					string <- { "(shr1 " . (string: exp) . ")" }
					eval <- { rshift: (eval: exp) by: 1i64 }
				}
			}

			shr4 <- :exp {
				#{
					string <- { "(shr4 " . (string: exp) . ")" }
					eval <- { rshift: (eval: exp) by: 4i64 }
				}
			}

			shr16 <- :exp {
				#{
					string <- { "(shr16 " . (string: exp) . ")" }
					eval <- { rshift: (eval: exp) by: 16i64 }
				}
			}

			input <- { _inputNode }
			acc <- { _accNode }
			val <- { _valNode }

			if0:then:else <- :exp ifzero :ifnotzero {
				#{
					string <- { "(if0 " . (string: exp) . " " . (string: ifzero) . " " . (string: ifnotzero) . ")" }
					eval <- {
						if: (eval: exp) = 0i64 {
							eval: ifzero
						} else: {
							eval: ifnotzero
						}
					}
				}
			}

			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
			}

			root <- _zero

			string <- {
				"(lambda (input) " . (string: root) . ")"
			}

			gentestprog <- {
				root <- if0: (opAnd: input one) then: (
					plus: (opOr: input (shl1: one))
				) else: (
					opXor: input (shr16: input)
				)
				self
			}

			exampleprog <- {
				root <- fold: input with: (opOr: val acc) startingAt: zero
				self
			}

			//TODO: memoize this to improve runtime for large n
			allOfSize:inFold? <- :n :infold? {
				if: n = 1 {
					res <- #[one zero input]
					if: infold? {
						res append: acc
						res append: val
					}
					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
						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
						}
					}
					res
				}
			}

			allOfSize <- :n {
				allOfSize: n inFold?: false
			}
		}
	}

	test <- :prog {
		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]
		foreach: vals :idx val {
			print: "p(0x" . (hex: val) . ") = 0x" . (hex: (prog run: val)) . "\n"
		}
	}

	main <- {
		test: (program gentestprog)
		test: (program exampleprog)
		prog <- program
		foreach: (prog allOfSize: 3) :idx tree {
			prog root! tree
			test: prog
		}
	}
}