diff --git a/.gitignore b/.gitignore index f46b5a3..66b50af 100644 --- a/.gitignore +++ b/.gitignore @@ -13,4 +13,12 @@ pom.xml.asc *.iml .idea/ out -notes \ No newline at end of file +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 \ No newline at end of file diff --git a/project.clj b/project.clj index ae2d7d2..e941433 100644 --- a/project.clj +++ b/project.clj @@ -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}) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index cf88860..ccdc980 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -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))) diff --git a/src/propeller/push/utils/helpers.cljc b/src/propeller/push/utils/helpers.cljc index 46eb572..4eccfb6 100755 --- a/src/propeller/push/utils/helpers.cljc +++ b/src/propeller/push/utils/helpers.cljc @@ -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 diff --git a/test/propeller/core_test.clj b/test/propeller/core_test.clj deleted file mode 100644 index b11c171..0000000 --- a/test/propeller/core_test.clj +++ /dev/null @@ -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)))) diff --git a/test/propeller/push/instructions/vector_spec.clj b/test/propeller/push/instructions/vector_spec.clj new file mode 100644 index 0000000..4a16e19 --- /dev/null +++ b/test/propeller/push/instructions/vector_spec.clj @@ -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_). + It then runs the vector/_concat instruction, and confirms that the + result (on the :vector_ 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_), 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_), 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_), and + the given values on the integer stack. + It then runs the vector/_subvec instruction, and confirms that the + result (on the :vector_ 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) \ No newline at end of file