view src/solver.tp @ 40:1cadb591eef1

Fix bug that was causing the solver to not find certain matches
author Mike Pavone <pavone@retrodev.com>
date Sun, 11 Aug 2013 00:37:34 -0700
parents cde3f5943cd4
children e795f7179456
line wrap: on
line source

{
	_classifNode <- :vals prog startIdx child? {
		if: startIdx < (vals length) {
			_dict <- dict linear
			_const <- #[]
			_first <- false
			_hasFirst? <- false
			_val <- vals get: startIdx
			#{
				input <- { _val }
				valmap <- { _dict }
				allInputs <- { vals }
				constantProgs <- { _const }
				append <- :tree {
					if: child? && (tree constant?) {
						_const append: tree
					} else: {
						if: (_dict length) > 0 {
							prog root!: tree
							res <- prog run: _val
							node <- _dict get: res elseSet: {
								_classifNode: vals prog startIdx + 1 true
							}
							node append: tree
						} else: {
							if: _hasFirst? {
								prog root!: _first
								res <- prog run: _val
								node <- _classifNode: vals prog startIdx + 1 true
								_dict set: res node
								node append: _first
								append: tree
							} else: {
								_first <- tree
								_hasFirst? <- true
							}
						}
					}
				}
				length <- {
					len <- _dict length
					if: len = 0 && _hasFirst? {
						len <- 1
					}
					len + (_const length)
				}
				printwithIndent <- :indent {
					print: indent . "Input: " . (hex: _val) . "\n"
					nextindent <- indent . "    "
					if: (_const length) > 0 {
						print: indent . "Constants:\n"
						foreach: _const :idx val {
							print: nextindent . (string: val) . "\n"
						}
					}
					if: (_dict length) > 0 {
						foreach: _dict :key val {
							print: indent . (hex: key) . " ->\n"
							val printwithIndent: nextindent
						}
					} else: {
						if: _hasFirst? {
							print: nextindent . (string: _first) . "\n"
						}
					}
				}
				print <- {
					printwithIndent: ""
				}
				findMatches:at <- :outputs :startIdx {
					outVal <- outputs get: startIdx
					sub <- _dict get: outVal withDefault: #{
						length <- { 0 }
					}
					res <- #[]
					if: (sub length) > 0 {
						res <- sub findMatches: outputs at: (startIdx + 1)
						cps <- sub constantProgs
						if: (cps length) > 0 {
							isConstant <- true
							cur <- 0
							while: { isConstant && cur < (cps length)} do: {
								isConstant <- outVal = (outputs get: cur)
								cur <- cur + 1
							}
							if: isConstant {
								foreach: cps :idx tree {
									res append: cps
								}
							}
						}
					} else: {
						if: _hasFirst? {
							res append: _first
						}
					}
					res
				}
			}
		} else: {
			_arr <- #[]
			#{
				append <- :tree {
					_arr append: tree
				}
				length <- { _arr length }
				constantProgs <- { #[] }
				printwithIndent <- :indent {
					print: indent . "No more values for these:\n"
					indent <- indent . "    "
					foreach: _arr :idx val {
						print: indent . (string: val) . "\n"
					}
				}
				print <- {
					printwithIndent: ""
				}
				findMatches:at <- :outputs :startIdx {
					_arr
				}
			}
		}
	}
	#{
		classify <- :prog trees numTests {
			testvals <- #[]
			i <- 0
			(os srand: (os time))
			while: {i < numTests} do: {
				i <- i + 1
				testvals append: (uint64: (os rand64))
			}
			root <- _classifNode: testvals prog 0 false
			foreach: trees :idx tree {
				root append: tree
			}
			root
		}

		solve:withAuth:andInfo:andProg <- :progId :authKey :info :prog {
			resp <- (requests evalId: progId (info allInputs)) sendWithKey: authKey
			if: (resp status) = "ok" {
				matches <- info findMatches: (resp outputs) at: 0
				noSuccess <- true
				cur <- 0
				if: (matches length) = 0 {
					print: "No matches? :(\n"
					print: info
				}
				while: { noSuccess && cur < (matches length) } do: {
					prog root!: (matches get: cur)
					gresp <- (requests guess: progId (string: prog)) sendWithKey: authKey
					if: (gresp status) = "win" {
						noSuccess <- false
					} else: {
						if: (gresp status) = "mismatch" {
							failInput <- (gresp values) get: 0
							failOutput <- (gresp values) get: 1
							filtered <- #[]
							foreach: matches :idx tree {
								prog root!: tree
								if: (prog run: failInput) = failOutput {
									filtered append: tree
								}
							}
							matches <- filtered
							if: (matches length) = 0 {
								print: "None of our programs actually matched 0x" . (hex: failOutput) ." with input 0x" . (hex: failInput) ." :(\n"
							}
						} else: {
							print: "Got message: " . (gresp message) . ", moving on\n"
							cur <- cur + 1
						}
					}
				}
			} else: {
				print: resp
			}
		}

		main <- :args {
			size <- 3
			if: (args length) > 1 {
				size <- int32: (args get: 1)
			}
			prog <- bv program
			if: size >= 2 {
				trees <- (prog allOfSize: size)
				numTests <- 0
				if: (args length) > 2 {
					numTests <- int32: (args get: 2)
				}
				if: numTests <= 0 {
					numTests <- 16
				}
				if: (args length) > 3 {
					ops <- (args get: 3) splitOn: ","
					trees <- prog filterTrees: trees ops
				}
				info <- classify: prog trees numTests
				if: (args length) > 5 {
					progId <- (args get: 4)
					authKey <- (args get: 5)

					solve: progId withAuth: authKey andInfo: info andProg: prog
				} else: {
					print: info
				}
			}
			0
		}
	}
}