Merge pull request #10 from NicMcPhee/test-vector-instructions

Add tests for vector instructions
This commit is contained in:
Lee Spector 2021-01-23 15:49:42 -05:00 committed by GitHub
commit 5891c8641d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
6 changed files with 518 additions and 20 deletions

8
.gitignore vendored
View File

@ -14,3 +14,11 @@ pom.xml.asc
.idea/
out
notes
.clj-kondo/
.idea/
.calva/
# Don't commit the data directory that we'll
# use to hold the data from
# https://github.com/thelmuth/program-synthesis-benchmark-datasets
/data

View File

@ -4,6 +4,7 @@
:license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
:url "https://www.eclipse.org/legal/epl-2.0/"}
:dependencies [[org.clojure/clojure "1.10.0"]
[org.clojure/clojurescript "1.9.946"]]
[org.clojure/clojurescript "1.9.946"]
[org.clojure/test.check "1.1.0"]]
:main ^:skip-aot propeller.core
:repl-options {:init-ns propeller.core})

View File

@ -52,12 +52,16 @@
(make-instruction state empty? [stack] :boolean)))
;; Pushes the first item of the top element of the vector stack onto the
;; approrpiately-typed literal stack
;; appropriately-typed literal stack. If the vector is empty, return
;; :ignore-instruction so that nothing is changed on the stacks.
(def _first
^{:stacks #{:elem}}
(fn [stack state]
(let [lit-stack (get-vector-literal-type stack)]
(make-instruction state first [stack] lit-stack))))
(make-instruction state
#(if (empty? %) :ignore-instruction (first %))
[stack]
lit-stack))))
;; Pushes onto the INTEGER stack the index of the top element of the
;; appropriately-typed literal stack within the top element of the vector stack
@ -97,7 +101,11 @@
^{:stacks #{:elem}}
(fn [stack state]
(let [lit-stack (get-vector-literal-type stack)]
(make-instruction state last [stack] lit-stack))))
(make-instruction
state
#(if (empty? %) :ignore-instruction (last %))
[stack]
lit-stack))))
;; Pushes the length of the top item onto the INTEGER stack
(def _length
@ -113,7 +121,9 @@
(fn [stack state]
(let [lit-stack (get-vector-literal-type stack)]
(make-instruction state
#(get %2 (mod %1 (count %2)))
#(if (empty? %2)
:ignore-instruction
(get %2 (mod %1 (count %2))))
[:integer stack]
lit-stack))))
@ -173,7 +183,10 @@
(let [lit-stack (get-vector-literal-type stack)]
(make-instruction state
(fn [lit1 lit2 vect]
(assoc vect (utils/indexof lit1 vect) lit2))
(let [replaceindex (utils/indexof lit1 vect)]
(if (= replaceindex -1)
vect
(assoc vect replaceindex lit2))))
[lit-stack lit-stack stack]
stack))))
@ -198,8 +211,10 @@
(let [lit-stack (get-vector-literal-type stack)]
(make-instruction state
(fn [lit n vect]
(assoc vect (mod n (count vect)) lit))
[:integer lit-stack stack]
(if (empty? vect)
:ignore-instruction
(assoc vect (mod n (count vect)) lit)))
[lit-stack :integer stack]
stack))))
;; Pushes a subvector of the top item, with start and end indices determined by
@ -208,9 +223,9 @@
^{:stacks #{:integer}}
(fn [stack state]
(make-instruction state
(fn [stop-raw start-raw vect]
(fn [start-raw stop-raw vect]
(let [start (min (count vect) (max 0 start-raw))
stop (min (count vect) (max start-raw stop-raw))]
stop (min (count vect) (max 0 start-raw stop-raw))]
(subvec vect start stop)))
[:integer :integer stack]
stack)))

View File

@ -28,7 +28,11 @@
;; A utility function for making Push instructions. Takes a state, a function
;; to apply to the args, the stacks to take the args from, and the stack to
;; return the result to. Applies the function to the args (popped from the
;; given stacks), and pushes the result onto the return-stack
;; given stacks), and pushes the result onto the return-stack.
;;
;; If the function returns :ignore-instruction, then we will return the
;; initial state unchanged. This allows instructions to fail gracefully
;; without consuming stack values.
(defn make-instruction
[state function arg-stacks return-stack]
(let [popped-args (get-args-from-stacks state arg-stacks)]
@ -36,7 +40,9 @@
state
(let [result (apply function (:args popped-args))
new-state (:state popped-args)]
(state/push-to-stack new-state return-stack result)))))
(if (= result :ignore-instruction)
state
(state/push-to-stack new-state return-stack result))))))
;; Given a set of stacks, returns all instructions that operate on those stacks
;; only. Won't include random instructions unless :random is in the set as well

View File

@ -1,7 +0,0 @@
(ns propeller.core-test
(:require [clojure.test :refer :all]
[propeller.core :refer :all]))
(deftest a-test
(testing "FIXME, I fail."
(is (= 0 1))))

View File

@ -0,0 +1,475 @@
(ns propeller.push.instructions.vector-spec
(:require
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[clojure.test.check.clojure-test :as ct :refer [defspec]]
[propeller.push.state :as state]
[propeller.push.instructions.vector :as vector]
[propeller.push.interpreter :as interpreter]))
(def gen-type-pairs
[['gen/small-integer "integer"]
['gen/double "float"]
['gen/boolean "boolean"]
['gen/string "string"]])
(defn generator-for-arg-type
[arg-type generator]
(case arg-type
:boolean 'gen/boolean
:integer 'gen/small-integer
:float 'gen/double
:string 'gen/string
; This is for "generic" vectors where the element is provided by
; the `generator` argument.
:vector `(gen/vector ~generator)
:item generator
:vector_boolean '(gen/vector gen/boolean)
:vector_integer '(gen/vector gen/small-integer)
:vector_float '(gen/vector gen/double)
:vector_string '(gen/vector gen/string)))
(defmacro gen-specs
[spec-name check-fn & arg-types]
(let [symbol-names (repeatedly (count arg-types) gensym)]
`(do ~@(for [[generator value-type] gen-type-pairs
:let [name (symbol (str spec-name "-spec-" value-type))]]
`(defspec ~name
(prop/for-all
[~@(mapcat
(fn [symbol-name arg-type]
[symbol-name (generator-for-arg-type arg-type generator)])
symbol-names
arg-types)]
(~check-fn ~value-type ~@symbol-names)))))))
;;; vector/_butlast
(defn check-butlast
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_butlast stack-type start-state)
expected-result (vec (butlast vect))]
(= expected-result
(state/peek-stack end-state stack-type))))
(gen-specs "butlast" check-butlast :vector)
;;; vector/_concat
(defn check-concat
"Creates an otherwise empty Push state with the two given vectors on the
appropriate vector stack (assumed to be :vector_<value-type>).
It then runs the vector/_concat instruction, and confirms that the
result (on the :vector_<value-type> stack) is the expected value.
The order of concatenation is that the top of the stack will be
_second_ in the concatenation, i.e., its elements will come _after_
the elements in the vector one below it in the stack."
[value-type first-vect second-vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
first-vect)
stack-type second-vect)
end-state (vector/_concat stack-type start-state)]
(= (concat second-vect first-vect)
(state/peek-stack end-state stack-type))))
(gen-specs "concat" check-concat :vector :vector)
;;; vecotr/_conj
(defn check-conj
[value-type vect value]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
(keyword (str value-type))
value)
end-state (vector/_conj stack-type start-state)
expected-result (conj vect value)]
(= expected-result
(state/peek-stack end-state stack-type))))
(gen-specs "conj" check-conj :vector :item)
;;; vector/_contains
(defn check-contains
"Creates an otherwise empty Push state with the given vector on the
appropriate vector stack (assumed to be :vector_<value-type>), and
the given value on the appropriate stack (determined by value-type).
It then runs the vector/_contains instruction, and confirms that the
result (on the :boolean stack) is the expected value."
[value-type vect value]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
(keyword value-type) value)
end-state (vector/_contains stack-type start-state)
expected-result (not= (.indexOf vect value) -1)]
(= expected-result
(state/peek-stack end-state :boolean))))
(gen-specs "contains" check-contains :vector :item)
;;; vector/_emptyvector
(defn check-empty-vector
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_emptyvector stack-type start-state)]
(= (empty? vect)
(state/peek-stack end-state :boolean))))
(gen-specs "empty-vector" check-empty-vector :vector)
;;; vector/_first
(defn check-first
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_first stack-type start-state)]
(or
(and (empty? vect)
(= (state/peek-stack end-state stack-type)
vect))
(and
(= (first vect)
(state/peek-stack end-state (keyword value-type)))
(state/empty-stack? end-state stack-type)))))
(gen-specs "first" check-first :vector)
;;; vector/_indexof
(defn check-indexof
"Creates an otherwise empty Push state with the given vector on the
appropriate vector stack (assumed to be :vector_<value-type>), and
the given value on the appropriate stack (determined by value-type).
It then runs the vector/_indexof instruction, and confirms that the
result (on the :integer stack) is the expected value."
[value-type vect value]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
(keyword value-type) value)
end-state (vector/_indexof stack-type start-state)
expected-index (.indexOf vect value)]
(= expected-index
(state/peek-stack end-state :integer))))
(gen-specs "indexof" check-indexof :vector :item)
;;; vector/_iterate
(defn check-iterate
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
print-instr (keyword (str value-type "_print"))
iter-instr (keyword (str "vector_" value-type "_iterate"))
program [iter-instr print-instr]
start-state (-> state/empty-state
(state/push-to-stack stack-type vect)
(state/push-to-stack :output ""))
; 4 times the vector length should be enough for this iteration, perhaps even
; more than we strictly need.
end-state (interpreter/interpret-program program start-state (* 4 (count vect)))
; pr-str adds escaped quote marks, which causes tests to fail because _print
; treats strings and characters specially and does not call pr-str on them.
to-str-fn (if (= value-type "string") identity pr-str)
expected-result (apply str (map to-str-fn vect))]
(= expected-result
(state/peek-stack end-state :output))))
(gen-specs "iterate" check-iterate :vector)
;;; vector/_last
(defn check-last
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_last stack-type start-state)]
(or
(and (empty? vect)
(= (state/peek-stack end-state stack-type)
vect))
(and
(= (last vect)
(state/peek-stack end-state (keyword value-type)))
(state/empty-stack? end-state stack-type)))))
(gen-specs "last" check-last :vector)
;;; vector/_length
(defn check-length
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_length stack-type start-state)
expected-result (count vect)]
(= expected-result
(state/peek-stack end-state :integer))))
(gen-specs "length" check-length :vector)
;;; vector/_nth
(defn check-nth
[value-type vect n]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
:integer
n)
end-state (vector/_nth stack-type start-state)]
(or
(and (empty? vect)
(= (state/peek-stack end-state stack-type)
vect))
(and
(= (get vect (mod n (count vect)))
(state/peek-stack end-state (keyword value-type)))))))
(gen-specs "nth" check-nth :vector :integer)
;;; vector/_occurrencesof
(defn check-occurrencesof
[value-type vect value]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
(keyword value-type)
value)
end-state (vector/_occurrencesof stack-type start-state)
expected-result (count (filterv #(= value %) vect))]
(= expected-result
(state/peek-stack end-state :integer))))
(gen-specs "occurrencesof" check-occurrencesof :vector :item)
;;; vector/_pushall
(defn check-pushall
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_pushall stack-type start-state)
value-stack (keyword value-type)
vect-length (count vect)]
(and
(=
(vec (state/peek-stack-many end-state value-stack vect-length))
vect)
(state/empty-stack?
(state/pop-stack-many end-state value-stack vect-length)
value-stack))))
(gen-specs "pushall" check-pushall :vector)
;;; vector/_remove
(defn check-remove
[value-type vect value]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
(keyword value-type)
value)
end-state (vector/_remove stack-type start-state)]
(= []
(filterv #(= % value) (state/peek-stack end-state stack-type)))))
(gen-specs "remove" check-remove :vector :item)
;;; vector/_replace
(defn check-replace
[value-type vect toreplace replacement]
(let [stack-type (keyword (str "vector_" value-type))
value-stack (keyword value-type)
start-state (state/push-to-stack
(state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
value-stack
toreplace)
value-stack
replacement)
end-state (vector/_replace stack-type start-state)
expected-result (replace {toreplace replacement} vect)]
(= expected-result
(state/peek-stack end-state stack-type))))
(gen-specs "replace" check-replace :vector :item :item)
;;; vector/_replacefirst
(defn check-replacefirst
[value-type vect toreplace replacement]
(let [stack-type (keyword (str "vector_" value-type))
value-stack (keyword value-type)
start-state (state/push-to-stack
(state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
value-stack
toreplace)
value-stack
replacement)
end-state (vector/_replacefirst stack-type start-state)
end-vector (state/peek-stack end-state stack-type)
replacement-index (.indexOf vect toreplace)]
(or
(and (= replacement-index -1)
(state/empty-stack? end-state value-stack)
(= vect end-vector))
(and (state/empty-stack? end-state value-stack)
(= end-vector (assoc vect replacement-index replacement))))))
(gen-specs "replacefirst" check-replacefirst :vector :item :item)
;;; vector/_rest
(defn check-rest
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_rest stack-type start-state)
expected-result (vec (rest vect))]
(= expected-result
(state/peek-stack end-state stack-type))))
(gen-specs "rest" check-rest :vector)
;;; vector/_reverse
(defn check-reverse
[value-type vect]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack state/empty-state
stack-type
vect)
end-state (vector/_reverse stack-type start-state)
expected-result (vec (reverse vect))]
(= expected-result
(state/peek-stack end-state stack-type))))
(gen-specs "reverse" check-reverse :vector)
;;; vector/_set
(defn check-set
[value-type vect value n]
(let [stack-type (keyword (str "vector_" value-type))
value-stack (keyword value-type)
start-state (state/push-to-stack
(state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
value-stack
value)
:integer
n)
end-state (vector/_set stack-type start-state)]
(or
(and
(empty? vect)
(not (state/empty-stack? end-state :integer))
(not (state/empty-stack? end-state value-stack))
(= vect (state/peek-stack end-state stack-type)))
(and
(= (state/peek-stack end-state stack-type)
(assoc vect (mod n (count vect)) value))
(state/empty-stack? end-state :integer)
(state/empty-stack? end-state value-stack)))))
(gen-specs "set" check-set :vector :item :integer)
;;; vector/_subvec
(defn clean-subvec-bounds
[start stop vect-size]
(let [start (max 0 start)
stop (max 0 stop)
start (min start vect-size)
stop (min stop vect-size)
stop (max start stop)]
[start stop]))
(defn check-subvec
"Creates an otherwise empty Push state with the given vector on the
appropriate vector stack (assumed to be :vector_<value-type>), and
the given values on the integer stack.
It then runs the vector/_subvec instruction, and confirms that the
result (on the :vector_<value-type> stack) is the expected value."
[value-type vect start stop]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
:integer start)
:integer stop)
end-state (vector/_subvec stack-type start-state)
[cleaned-start cleaned-stop] (clean-subvec-bounds start stop (count vect))
expected-subvec (subvec vect cleaned-start cleaned-stop)]
(= expected-subvec
(state/peek-stack end-state stack-type))))
(gen-specs "subvec" check-subvec :vector :integer :integer)
;;; vector/_take
(defn check-take
[value-type vect n]
(let [stack-type (keyword (str "vector_" value-type))
start-state (state/push-to-stack
(state/push-to-stack state/empty-state
stack-type
vect)
:integer
n)
end-state (vector/_take stack-type start-state)
expected-result (vec (take n vect))]
(= expected-result
(state/peek-stack end-state stack-type))))
(gen-specs "take" check-take :vector :integer)