diff src/solver.tp @ 33:b00904b36aca

More solver work
author Mike Pavone <pavone@retrodev.com>
date Sat, 10 Aug 2013 22:25:49 -0700
parents 2b5357b13e2d
children cde3f5943cd4
line wrap: on
line diff
--- a/src/solver.tp	Sat Aug 10 19:54:20 2013 -0700
+++ b/src/solver.tp	Sat Aug 10 22:25:49 2013 -0700
@@ -1,43 +1,129 @@
-#{
-	classify <- :prog trees {
-		testvals <- #[]
-		i <- 0
-		(os srand: (os time))
-		while: {i < 256} do: {
-			i <- i + 1
-			testvals append: (uint64: (os rand64))
-		}
-		root <- dict linear
-		foreach: trees :idx tree {
-			prog root!: tree
-			res <- prog run: (testvals get: 0)
-			arr <- root get: res withDefault: #[]
-			arr append: tree
-			if: (arr length) = 1 {
-				root set: res arr
+{
+	_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 }
+				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: ""
+				}
+			}
+		} else: {
+			_arr <- #[]
+			#{
+				append <- :tree {
+					_arr append: tree
+				}
+				length <- { _arr length }
+				printwithIndent <- :indent {
+					print: indent . "No more values for these:\n"
+					indent <- indent . "    "
+					foreach: _arr :idx val {
+						print: indent . (string: val) . "\n"
+					}
+				}
+				print <- {
+					printwithIndent: ""
+				}
 			}
 		}
-		#{
-			inputs <- { testvals }
-			valmap <- { root }
-		}
 	}
-
-	main <- :args {
-		size <- 3
-		if: (args length) > 1 {
-			size <- int32: (args get: 1)
+	#{
+		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
 		}
-		prog <- bv program
-		if: size >= 2 {
-			trees <- (prog allOfSize: size)
-			if: (args length) > 2 {
-				ops <- (args get: 2) splitOn: ","
-				trees <- prog filterTrees: trees ops
+
+		main <- :args {
+			size <- 3
+			if: (args length) > 1 {
+				size <- int32: (args get: 1)
 			}
-			info <- classify: prog trees
-			foreach: (info valmap) :val arr {
-				print: "Value: 0x" . (hex: val) ." produced by " . (string: (arr length)) . "programs\n"
+			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
+				print: info
 			}
 		}
 	}