Merge branch 'master' into fix/def-instruction-not-macro
This commit is contained in:
Tom Helmuth
commit
6b39e078ee
33
.github/workflows/CI.yaml
vendored
Normal file
33
.github/workflows/CI.yaml
vendored
Normal file
@ -0,0 +1,33 @@
|
||||
name: CI
|
||||
|
||||
on: [ push ]
|
||||
|
||||
jobs:
|
||||
test-clj:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
- name: Install Lein
|
||||
uses: DeLaGuardo/setup-clojure@master
|
||||
with:
|
||||
lein: 'latest'
|
||||
- name: Run Tests
|
||||
run: lein test
|
||||
test-cljs:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v2
|
||||
- name: Prepare Java
|
||||
uses: actions/setup-java@v2
|
||||
with:
|
||||
distribution: 'temurin'
|
||||
java-version: '8'
|
||||
- name: Install Node
|
||||
uses: actions/setup-node@v2
|
||||
with:
|
||||
node-version: '14'
|
||||
- run: npm install
|
||||
- name: Install shadow-cljs
|
||||
run: npm install -g shadow-cljs
|
||||
- name: Run Tests
|
||||
run: shadow-cljs compile test && node out/node-tests.js
|
||||
4
.gitignore
vendored
4
.gitignore
vendored
@ -24,6 +24,10 @@ notes
|
||||
*~
|
||||
q
|
||||
|
||||
# Clojure Script
|
||||
.shadow-cljs/
|
||||
node_modules/
|
||||
|
||||
# Don't commit the data directory that we'll
|
||||
# use to hold the data from
|
||||
# https://github.com/thelmuth/program-synthesis-benchmark-datasets
|
||||
|
||||
2427
package-lock.json
generated
Normal file
2427
package-lock.json
generated
Normal file
File diff suppressed because it is too large
Load Diff
@ -16,6 +16,10 @@
|
||||
"license": "EPL",
|
||||
"devDependencies": {
|
||||
"http-server": "^0.12.3",
|
||||
"shadow-cljs": "^2.10.10"
|
||||
"shadow-cljs": "^2.10.10",
|
||||
"source-map-support": "^0.5.20"
|
||||
},
|
||||
"dependencies": {
|
||||
"ws": "^8.2.3"
|
||||
}
|
||||
}
|
||||
|
||||
@ -7,7 +7,7 @@
|
||||
[org.clojure/clojurescript "1.9.946"]
|
||||
[org.clojure/test.check "1.1.0"]
|
||||
[net.clojars.schneau/psb2 "1.1.0"]]
|
||||
:profiles {:profiling {:dependencies [[com.clojure-goes-fast/clj-async-profiler "0.5.1"]]}}
|
||||
:main ^:skip-aot propeller.core
|
||||
:repl-options {:init-ns propeller.core}
|
||||
:jvm-opts ^:replace [])
|
||||
|
||||
|
||||
@ -1,39 +0,0 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<module cursive.leiningen.project.LeiningenProjectsManager.displayName="net.clojars.lspector/propeller:0.2.1" cursive.leiningen.project.LeiningenProjectsManager.isLeinModule="true" type="JAVA_MODULE" version="4">
|
||||
<component name="NewModuleRootManager">
|
||||
<output url="file://$MODULE_DIR$/target/classes" />
|
||||
<output-test url="file://$MODULE_DIR$/target/classes" />
|
||||
<exclude-output />
|
||||
<content url="file://$MODULE_DIR$">
|
||||
<sourceFolder url="file://$MODULE_DIR$/dev-resources" isTestSource="false" />
|
||||
<sourceFolder url="file://$MODULE_DIR$/resources" isTestSource="false" />
|
||||
<sourceFolder url="file://$MODULE_DIR$/src" isTestSource="false" />
|
||||
<sourceFolder url="file://$MODULE_DIR$/test" isTestSource="true" />
|
||||
<excludeFolder url="file://$MODULE_DIR$/target" />
|
||||
</content>
|
||||
<orderEntry type="inheritedJdk" />
|
||||
<orderEntry type="sourceFolder" forTests="false" />
|
||||
<orderEntry type="library" name="Leiningen: args4j:2.33" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: clojure-complete:0.2.5" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.code.findbugs/jsr305:3.0.1" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.code.gson/gson:2.7" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.errorprone/error_prone_annotations:2.0.18" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.guava/guava:20.0" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.javascript/closure-compiler-externs:v20170910" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.javascript/closure-compiler-unshaded:v20170910" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.jsinterop/jsinterop-annotations:1.0.0" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: com.google.protobuf/protobuf-java:3.0.2" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: net.clojars.schneau/psb2:1.1.0" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: nrepl:0.6.0" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/clojure:1.10.0" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/clojurescript:1.9.946" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/core.specs.alpha:0.2.44" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/data.json:0.2.6" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/google-closure-library-third-party:0.0-20170809-b9c14c6b" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/google-closure-library:0.0-20170809-b9c14c6b" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/spec.alpha:0.2.176" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/test.check:1.1.0" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.clojure/tools.reader:1.1.0" level="project" />
|
||||
<orderEntry type="library" name="Leiningen: org.mozilla/rhino:1.7R5" level="project" />
|
||||
</component>
|
||||
</module>
|
||||
@ -1,7 +1,10 @@
|
||||
{:source-paths ["src"]
|
||||
{:source-paths ["src" "test"]
|
||||
:dependencies []
|
||||
:dev-http {8080 "target/"}
|
||||
:builds {:app {:output-dir "target/"
|
||||
:asset-path "."
|
||||
:target :browser
|
||||
:modules {:main {:init-fn propeller.main/main!}}}}}
|
||||
:dev-http {8080 "target/"}
|
||||
:builds {:app {:output-dir "target/"
|
||||
:asset-path "."
|
||||
:target :browser
|
||||
:modules {:main {:init-fn propeller.main/main!}}}
|
||||
:test {:extra-paths ["src"]
|
||||
:target :node-test
|
||||
:output-to "out/node-tests.js"}}}
|
||||
|
||||
@ -31,21 +31,22 @@
|
||||
(defn gp
|
||||
"Main GP loop."
|
||||
[{:keys [population-size max-generations error-function instructions
|
||||
max-initial-plushy-size]
|
||||
max-initial-plushy-size solution-error-threshold mapper]
|
||||
:or {solution-error-threshold 0.0
|
||||
;; The `mapper` will perform a `map`-like operation to apply a function to every individual
|
||||
;; in the population. The default is `map` but other options include `mapv`, or `pmap`.
|
||||
mapper #?(:clj pmap :cljs map)}
|
||||
:as argmap}]
|
||||
;;
|
||||
(prn {:starting-args (update (update argmap :error-function str) :instructions str)})
|
||||
(println)
|
||||
;;
|
||||
(loop [generation 0
|
||||
population (repeatedly
|
||||
population-size
|
||||
#(hash-map :plushy (genome/make-random-plushy
|
||||
instructions
|
||||
max-initial-plushy-size)))]
|
||||
population (mapper
|
||||
(fn [_] {:plushy (genome/make-random-plushy instructions max-initial-plushy-size)})
|
||||
(range population-size))]
|
||||
(let [evaluated-pop (sort-by :total-error
|
||||
(#?(:clj pmap
|
||||
:cljs map)
|
||||
(mapper
|
||||
(partial error-function argmap (:training-data argmap))
|
||||
population))
|
||||
best-individual (first evaluated-pop)]
|
||||
@ -54,11 +55,10 @@
|
||||
(report evaluated-pop generation argmap))
|
||||
(cond
|
||||
;; Success on training cases is verified on testing cases
|
||||
(zero? (:total-error best-individual))
|
||||
(<= (:total-error best-individual) solution-error-threshold)
|
||||
(do (prn {:success-generation generation})
|
||||
(prn {:total-test-error
|
||||
(:total-error (error-function argmap (:testing-data argmap) best-individual))})
|
||||
(#?(:clj shutdown-agents)))
|
||||
(:total-error (error-function argmap (:testing-data argmap) best-individual))}))
|
||||
;;
|
||||
(>= generation max-generations)
|
||||
nil
|
||||
|
||||
@ -78,5 +78,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -90,4 +90,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -77,4 +77,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -113,4 +113,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -86,4 +86,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -82,5 +82,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -79,5 +79,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -87,4 +87,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -80,6 +80,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
|
||||
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -82,4 +82,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -78,5 +78,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -88,4 +88,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -92,4 +92,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -81,4 +81,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -109,5 +109,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -82,6 +82,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
|
||||
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -95,4 +95,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -86,4 +86,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 1.0 :crossover 0.0}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -66,17 +66,18 @@
|
||||
[& args]
|
||||
(gp/gp
|
||||
(merge
|
||||
{:instructions instructions
|
||||
:error-function error-function
|
||||
:training-data (:train train-and-test-data)
|
||||
:testing-data (:test train-and-test-data)
|
||||
:max-generations 500
|
||||
:population-size 500
|
||||
:max-initial-plushy-size 100
|
||||
:step-limit 200
|
||||
:parent-selection :lexicase
|
||||
:tournament-size 5
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 0.5 :crossover 0.5}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
{:instructions instructions
|
||||
:error-function error-function
|
||||
:training-data (:train train-and-test-data)
|
||||
:testing-data (:test train-and-test-data)
|
||||
:max-generations 500
|
||||
:population-size 500
|
||||
:max-initial-plushy-size 100
|
||||
:step-limit 200
|
||||
:parent-selection :lexicase
|
||||
:tournament-size 5
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 0.5 :crossover 0.5}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -1,6 +1,9 @@
|
||||
(ns propeller.problems.software.fizz-buzz
|
||||
(:require [psb2.core :as psb2]))
|
||||
|
||||
;; @todo This namespace is never used an it isn't a complete problem. Furthermore fizz-buzz exists in the PSB2 folder.
|
||||
;; Consider removing this file.
|
||||
|
||||
;; NOTE: Need to change directory below to location of the PSB2 files
|
||||
(def train-and-test (psb2/fetch-examples "PSB2/directory/path/goes/here/" "fizz-buzz" 200 2000))
|
||||
|
||||
|
||||
@ -108,4 +108,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 0.5 :crossover 0.5}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -110,4 +110,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 0.5 :crossover 0.5}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -99,4 +99,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 0.5 :crossover 0.5}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -78,4 +78,5 @@
|
||||
:umad-rate 0.1
|
||||
:variation {:umad 0.5 :crossover 0.5}
|
||||
:elitism false}
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args)))))
|
||||
(apply hash-map (map #(if (string? %) (read-string %) %) args))))
|
||||
(#?(:clj shutdown-agents)))
|
||||
|
||||
@ -5,7 +5,7 @@
|
||||
(:require [propeller.utils :as utils]
|
||||
[propeller.push.state :as state]
|
||||
[propeller.push.utils.helpers :refer [make-instruction]]
|
||||
[propeller.push.utils.globals :as globals]
|
||||
[propeller.push.utils.limits :as limit]
|
||||
#?(:clj [propeller.push.utils.macros :refer [def-instruction
|
||||
generate-instructions]])))
|
||||
|
||||
@ -42,7 +42,7 @@
|
||||
(not (state/empty-stack? state :integer))
|
||||
(not (state/empty-stack? state stack))))
|
||||
(let [n (min (state/peek-stack state :integer)
|
||||
(inc (- globals/max-stack-items (state/stack-size state stack))))
|
||||
(inc (- limit/max-stack-items (state/stack-size state stack))))
|
||||
popped-state (state/pop-stack state :integer)
|
||||
top-item (state/peek-stack popped-state stack)
|
||||
top-item-dup (take (- n 1) (repeat top-item))]
|
||||
@ -62,7 +62,7 @@
|
||||
(if (state/empty-stack? state :integer)
|
||||
state
|
||||
(let [n (min (state/peek-stack state :integer)
|
||||
(- globals/max-stack-items (state/stack-size state stack)))
|
||||
(- limit/max-stack-items (state/stack-size state stack)))
|
||||
popped-state (state/pop-stack state :integer)
|
||||
top-items (take n (get popped-state stack))]
|
||||
(state/push-to-stack-many popped-state stack top-items)))))
|
||||
@ -201,7 +201,7 @@
|
||||
(not (state/empty-stack? state stack))))
|
||||
(let [index-raw (state/peek-stack state :integer)
|
||||
popped-state (state/pop-stack state :integer)
|
||||
index (max 0 (min index-raw (dec (count (get popped-state stack)))))
|
||||
index (max 0 (min index-raw (dec (state/stack-size popped-state stack))))
|
||||
indexed-item (nth (reverse (get popped-state stack)) index)]
|
||||
(state/push-to-stack popped-state stack indexed-item))
|
||||
state)))
|
||||
|
||||
@ -1,4 +1,6 @@
|
||||
(ns propeller.push.state)
|
||||
(ns propeller.push.state
|
||||
(:require [propeller.push.utils.limits :as l]
|
||||
#?(:cljs [goog.string :as gstring])))
|
||||
|
||||
;; Empty push state - all available stacks are empty
|
||||
(defonce empty-state {:boolean '()
|
||||
@ -26,6 +28,16 @@
|
||||
:vector_integer :integer
|
||||
:vector_string :string})
|
||||
|
||||
(defonce stack-limiter {:exec l/limit-code
|
||||
:code l/limit-code
|
||||
:integer #(long (l/limit-number %))
|
||||
:float l/limit-number
|
||||
:string l/limit-string
|
||||
:vector_boolean l/limit-string
|
||||
:vector_float #(mapv l/limit-number (l/limit-vector %))
|
||||
:vector_integer #(mapv (fn [i] (int (l/limit-number i))) (l/limit-vector %))
|
||||
:vector_string #(mapv (fn [s] (l/limit-string s)) (l/limit-vector %))})
|
||||
|
||||
(def example-state {:exec '()
|
||||
:integer '(1 2 3 4 5 6 7)
|
||||
:string '("abc")
|
||||
@ -68,14 +80,47 @@
|
||||
;; Pushes an item onto the stack
|
||||
(defn push-to-stack
|
||||
[state stack item]
|
||||
(if (nil? item)
|
||||
(if (or (nil? item)
|
||||
(>= (stack-size state stack) l/max-stack-items))
|
||||
state
|
||||
(update state stack conj item)))
|
||||
(let [limiter (get stack-limiter stack identity)]
|
||||
(update state stack conj (limiter item)))))
|
||||
|
||||
;; Pushes a collection of items onto the stack, as a chunk (i.e. leaving them in
|
||||
;; the order they are in)
|
||||
(defn push-to-stack-many
|
||||
[state stack items]
|
||||
(let [items (if (coll? items) items (list items))
|
||||
items-no-nil (filter #(not (nil? %)) items)]
|
||||
(update state stack into (reverse items-no-nil))))
|
||||
items-no-nil (filter #(not (nil? %)) items)
|
||||
items-to-push (take (- l/max-stack-items (stack-size state stack)) items-no-nil)
|
||||
limit (get stack-limiter stack identity)]
|
||||
(update state stack into (map limit (reverse items-to-push)))))
|
||||
|
||||
;; Takes a state and a collection of stacks to take args from. If there are
|
||||
;; enough args on each of the desired stacks, returns a map with keys
|
||||
;; {:state :args}, where :state is the new state and :args is a list of args
|
||||
;; popped from the stacks. If there aren't enough args on the stacks, returns
|
||||
;; :not-enough-args without popping anything
|
||||
(defn get-args-from-stacks
|
||||
[state stacks]
|
||||
(loop [state state
|
||||
stacks (reverse stacks)
|
||||
args '()]
|
||||
(if (empty? stacks)
|
||||
{:state state :args args}
|
||||
(let [current-stack (first stacks)]
|
||||
(if (empty-stack? state current-stack)
|
||||
:not-enough-args
|
||||
(recur (pop-stack state current-stack)
|
||||
(rest stacks)
|
||||
(conj args (peek-stack state current-stack))))))))
|
||||
|
||||
|
||||
;; Pretty-print a Push state, for logging or debugging purposes
|
||||
(defn print-state
|
||||
[state]
|
||||
(doseq [stack (keys empty-state)]
|
||||
#?(:clj (printf "%-15s = " stack)
|
||||
:cljs (print (gstring/format "%-15s = " stack)))
|
||||
(prn (if (get state stack) (get state stack) '()))
|
||||
(flush)))
|
||||
|
||||
@ -1,30 +0,0 @@
|
||||
(ns propeller.push.utils.globals)
|
||||
|
||||
;; =============================================================================
|
||||
;; Values used by the Push instructions to keep the stack sizes within
|
||||
;; reasonable limits.
|
||||
;; =============================================================================
|
||||
|
||||
;; Limits the number of items that can be duplicated onto a stack at once.
|
||||
;; We might want to extend this to limit all the different that things may be
|
||||
;; placed on a stack.
|
||||
(def max-stack-items 100)
|
||||
|
||||
|
||||
|
||||
;; =============================================================================
|
||||
;; Values used by the Push instructions to keep computed values within
|
||||
;; reasonable size limits.
|
||||
;; =============================================================================
|
||||
|
||||
;; Used by keep-number-reasonable as the maximum magnitude of any integer/float
|
||||
(def max-number-magnitude 1.0E6)
|
||||
|
||||
;; Used by keep-number-reasonable as the minimum magnitude of any float
|
||||
(def min-number-magnitude 1.0E-6)
|
||||
|
||||
;; Used by reasonable-string-length? to ensure that strings don't get too large
|
||||
(def max-string-length 1000)
|
||||
|
||||
;; Used by keep-vector-reasonable to ensure that vectors don't get too large
|
||||
(def max-vector-length 1000)
|
||||
@ -2,63 +2,10 @@
|
||||
(:require [clojure.set]
|
||||
[propeller.push.core :as push]
|
||||
[propeller.push.state :as state]
|
||||
[propeller.push.utils.globals :as globals]
|
||||
[propeller.utils :as u]
|
||||
#?(:cljs [goog.string :as gstring])
|
||||
#?(:cljs [goog.string.format])))
|
||||
|
||||
;; Returns a version of the number n that is within reasonable size bounds
|
||||
(defn keep-number-reasonable
|
||||
[n]
|
||||
(cond
|
||||
(integer? n)
|
||||
(cond
|
||||
(> n globals/max-number-magnitude) (long globals/max-number-magnitude)
|
||||
(< n (- globals/max-number-magnitude)) (long (- globals/max-number-magnitude))
|
||||
:else n)
|
||||
:else
|
||||
(cond
|
||||
(#?(:clj Double/isNaN
|
||||
:cljs js/isNaN) n) 0.0
|
||||
(or (= n #?(:clj Double/POSITIVE_INFINITY
|
||||
:cljs js/Infinity))
|
||||
(> n globals/max-number-magnitude)) globals/max-number-magnitude
|
||||
(or (= n #?(:clj Double/NEGATIVE_INFINITY
|
||||
:cljs js/-Infinity))
|
||||
(< n (- globals/max-number-magnitude))) (- globals/max-number-magnitude)
|
||||
(< (- globals/min-number-magnitude) n globals/min-number-magnitude) 0.0
|
||||
:else n)))
|
||||
|
||||
;; Returns true if the string is of a reasonable size
|
||||
(defn reasonable-string-length?
|
||||
[string]
|
||||
(let [length (count string)]
|
||||
(<= length globals/max-string-length)))
|
||||
|
||||
;; Returns true if the vector is of a reasonable size
|
||||
(defn reasonable-vector-length?
|
||||
[vector]
|
||||
(let [length (count vector)]
|
||||
(<= length globals/max-vector-length)))
|
||||
|
||||
;; Takes a state and a collection of stacks to take args from. If there are
|
||||
;; enough args on each of the desired stacks, returns a map with keys
|
||||
;; {:state :args}, where :state is the new state and :args is a list of args
|
||||
;; popped from the stacks. If there aren't enough args on the stacks, returns
|
||||
;; :not-enough-args without popping anything
|
||||
(defn get-args-from-stacks
|
||||
[state stacks]
|
||||
(loop [state state
|
||||
stacks (reverse stacks)
|
||||
args '()]
|
||||
(if (empty? stacks)
|
||||
{:state state :args args}
|
||||
(let [current-stack (first stacks)]
|
||||
(if (state/empty-stack? state current-stack)
|
||||
:not-enough-args
|
||||
(recur (state/pop-stack state current-stack)
|
||||
(rest stacks)
|
||||
(conj args (state/peek-stack state current-stack))))))))
|
||||
|
||||
;; 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
|
||||
@ -69,27 +16,13 @@
|
||||
;; without consuming stack values.
|
||||
(defn make-instruction
|
||||
[state function arg-stacks return-stack]
|
||||
(let [popped-args (get-args-from-stacks state arg-stacks)]
|
||||
(let [popped-args (state/get-args-from-stacks state arg-stacks)]
|
||||
(if (= popped-args :not-enough-args)
|
||||
state
|
||||
(let [result (apply function (:args popped-args))
|
||||
new-state (:state popped-args)]
|
||||
(cond
|
||||
(number? result)
|
||||
(state/push-to-stack new-state return-stack (keep-number-reasonable result))
|
||||
;;
|
||||
(and (string? result)
|
||||
(not (reasonable-string-length? result)))
|
||||
(if (= result :ignore-instruction)
|
||||
state
|
||||
;;
|
||||
(and (vector? result)
|
||||
(not (reasonable-vector-length? result)))
|
||||
state
|
||||
;;
|
||||
(= result :ignore-instruction)
|
||||
state
|
||||
;;
|
||||
:else
|
||||
(state/push-to-stack new-state return-stack result))))))
|
||||
|
||||
;; Given a set of stacks, returns all instructions that operate on those stacks
|
||||
@ -99,9 +32,9 @@
|
||||
(doseq [[instruction-name function] @push/instruction-table]
|
||||
(assert
|
||||
(:stacks (meta function))
|
||||
#?(:clj (format
|
||||
"ERROR: Instruction %s does not have :stacks defined in metadata."
|
||||
(name instruction-name))
|
||||
#?(:clj (format
|
||||
"ERROR: Instruction %s does not have :stacks defined in metadata."
|
||||
(name instruction-name))
|
||||
:cljs (gstring/format
|
||||
"ERROR: Instruction %s does not have :stacks defined in metadata."
|
||||
(name instruction-name)))))
|
||||
@ -109,39 +42,45 @@
|
||||
:when (clojure.set/subset? (:stacks (meta function)) stacks)]
|
||||
instruction-name))
|
||||
|
||||
;; If a piece of data is a literal, return its corresponding stack name, e.g.
|
||||
;; :integer. Otherwise, return nil"
|
||||
|
||||
#?(:clj
|
||||
(def cls->type
|
||||
{Boolean :boolean
|
||||
Short :integer
|
||||
Integer :integer
|
||||
Long :integer
|
||||
BigInteger :integer
|
||||
Double :float
|
||||
BigDecimal :float
|
||||
Float :float
|
||||
Character :char
|
||||
String :string}))
|
||||
|
||||
#?(:cljs
|
||||
(def pred->type
|
||||
[[boolean? :boolean]
|
||||
[int? :integer]
|
||||
[float? :float]
|
||||
[string? :string]
|
||||
[char? :char]]))
|
||||
|
||||
(defn get-literal-type
|
||||
"If a piece of data is a literal, return its corresponding stack name
|
||||
e.g. `:integer`. Otherwise, return `nil`."
|
||||
[data]
|
||||
(let [literals [[:boolean (fn [thing] (or (true? thing) (false? thing)))]
|
||||
[:integer integer?]
|
||||
[:float float?]
|
||||
[:string string?]
|
||||
[:char char?]
|
||||
[:vector_boolean (fn [thing] (and (vector? thing)
|
||||
(or (true? (first thing))
|
||||
(false? (first thing)))))]
|
||||
[:vector_float (fn [thing] (and (vector? thing)
|
||||
(float? (first thing))))]
|
||||
[:vector_integer (fn [thing] (and (vector? thing)
|
||||
(integer? (first thing))))]
|
||||
[:vector_string (fn [thing] (and (vector? thing)
|
||||
(string? (first thing))))]
|
||||
[:generic-vector (fn [thing] (= [] thing))]]]
|
||||
(first (for [[stack function] literals
|
||||
:when (function data)]
|
||||
stack))))
|
||||
(or (when (vector? data)
|
||||
(if (empty? data)
|
||||
:generic-vector
|
||||
(keyword (str "vector_" (name (get-literal-type (u/first-non-nil data)))))))
|
||||
#?(:clj (cls->type (type data))
|
||||
:cljs (loop [remaining pred->type]
|
||||
(let [[pred d-type] (first remaining)]
|
||||
(cond
|
||||
(empty? remaining) nil
|
||||
(pred data) d-type
|
||||
:else (recur (rest remaining))))))))
|
||||
|
||||
(defn get-vector-literal-type
|
||||
"Returns the literal stack corresponding to some vector stack."
|
||||
[vector-stack]
|
||||
(get state/vec-stacks vector-stack))
|
||||
|
||||
;; Pretty-print a Push state, for logging or debugging purposes
|
||||
(defn print-state
|
||||
[state]
|
||||
(doseq [stack (keys state/empty-state)]
|
||||
#?(:clj (printf "%-15s = " stack)
|
||||
:cljs (print (gstring/format "%-15s = " stack)))
|
||||
(prn (if (get state stack) (get state stack) '()))
|
||||
(flush)))
|
||||
|
||||
72
src/propeller/push/utils/limits.cljc
Normal file
72
src/propeller/push/utils/limits.cljc
Normal file
@ -0,0 +1,72 @@
|
||||
(ns propeller.push.utils.limits
|
||||
(:require [propeller.utils :as u]))
|
||||
|
||||
;; =============================================================================
|
||||
;; Values used by the Push instructions to keep the stack sizes within
|
||||
;; reasonable limits.
|
||||
;; =============================================================================
|
||||
|
||||
;; Limits the number of items that can be duplicated onto a stack at once.
|
||||
;; We might want to extend this to limit all the different that things may be
|
||||
;; placed on a stack.
|
||||
(def max-stack-items 100)
|
||||
|
||||
;; =============================================================================
|
||||
;; Values used by the Push instructions to keep computed values within
|
||||
;; reasonable size limits.
|
||||
;; =============================================================================
|
||||
|
||||
;; Used as the maximum magnitude of any integer/float
|
||||
(def max-number-magnitude 1.0E6)
|
||||
|
||||
;; Used as the minimum magnitude of any float
|
||||
(def min-number-magnitude 1.0E-6)
|
||||
|
||||
;; Used to ensure that strings don't get too large
|
||||
(def max-string-length 1000)
|
||||
|
||||
;; Used to ensure that vectors don't get too large
|
||||
(def max-vector-length 1000)
|
||||
|
||||
;; Used to ensure that total
|
||||
;; Set as dynamic for testing purposes.
|
||||
(def ^:dynamic max-code-points 100)
|
||||
|
||||
;; Used to ensure that the depth of nesting for Push expressions doesn't get too deep.
|
||||
;; Set as dynamic for testing purposes.
|
||||
(def ^:dynamic max-code-depth 200)
|
||||
|
||||
;; Returns a version of the number n that is within reasonable size bounds
|
||||
(defn limit-number
|
||||
[n]
|
||||
(if (int? n)
|
||||
(cond
|
||||
(> n max-number-magnitude) (long max-number-magnitude)
|
||||
(< n (- max-number-magnitude)) (long (- max-number-magnitude))
|
||||
:else n)
|
||||
(cond
|
||||
(#?(:clj Double/isNaN
|
||||
:cljs js/isNaN) n) 0.0
|
||||
(or (= n #?(:clj Double/POSITIVE_INFINITY
|
||||
:cljs js/Infinity))
|
||||
(> n max-number-magnitude)) max-number-magnitude
|
||||
(or (= n #?(:clj Double/NEGATIVE_INFINITY
|
||||
:cljs js/-Infinity))
|
||||
(< n (- max-number-magnitude))) (- max-number-magnitude)
|
||||
(< (- min-number-magnitude) n min-number-magnitude) 0.0
|
||||
:else n)))
|
||||
|
||||
(defn limit-string
|
||||
[s]
|
||||
(apply str (take max-string-length s)))
|
||||
|
||||
(defn limit-vector
|
||||
[v]
|
||||
(vec (take max-vector-length v)))
|
||||
|
||||
(defn limit-code
|
||||
[code]
|
||||
(if (or (> (u/count-points code) max-code-points)
|
||||
(> (u/depth code) max-code-depth))
|
||||
'() ;; Code that exceeds the limit is discarded.
|
||||
code))
|
||||
@ -1,4 +1,11 @@
|
||||
(ns propeller.utils)
|
||||
(ns propeller.utils
|
||||
(:require [clojure.zip :as zip]))
|
||||
|
||||
(defn first-non-nil
|
||||
"Returns the first non-nil values from the collection, or returns `nil` if
|
||||
the collection is empty or only contains `nil`."
|
||||
[coll]
|
||||
(first (filter some? coll)))
|
||||
|
||||
(defn indexof
|
||||
"Returns the first index of an element in a collection. If the element is not
|
||||
@ -29,3 +36,51 @@
|
||||
(if (fn? instruction)
|
||||
(instruction)
|
||||
instruction)))
|
||||
|
||||
|
||||
(defn count-points
|
||||
"Returns the number of points in tree, where each atom and each pair of parentheses
|
||||
counts as a point."
|
||||
[tree]
|
||||
(loop [remaining tree
|
||||
total 0]
|
||||
(cond (not (seq? remaining))
|
||||
(inc total)
|
||||
;;
|
||||
(empty? remaining)
|
||||
(inc total)
|
||||
;;
|
||||
(not (seq? (first remaining)))
|
||||
(recur (rest remaining)
|
||||
(inc total))
|
||||
;;
|
||||
:else
|
||||
(recur (concat (first remaining)
|
||||
(rest remaining))
|
||||
(inc total)))))
|
||||
|
||||
(defn seq-zip
|
||||
"Returns a zipper for nested sequences, given a root sequence"
|
||||
{:added "1.0"}
|
||||
[root]
|
||||
(zip/zipper seq?
|
||||
seq
|
||||
(fn [node children] (with-meta children (meta node)))
|
||||
root))
|
||||
|
||||
(defn depth
|
||||
"Returns the height of the nested list called tree.
|
||||
Borrowed idea from here: https://stackoverflow.com/a/36865180/2023312
|
||||
Works by looking at the path from each node in the tree to the root, and
|
||||
finding the longest one.
|
||||
Note: does not treat an empty list as having any height."
|
||||
[tree]
|
||||
(loop [zipper (seq-zip tree)
|
||||
height 0]
|
||||
(if (zip/end? zipper)
|
||||
height
|
||||
(recur (zip/next zipper)
|
||||
(-> zipper
|
||||
zip/path
|
||||
count
|
||||
(max height))))))
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -1,475 +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)
|
||||
;(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)
|
||||
|
||||
14
test/propeller/push/state_test.cljc
Normal file
14
test/propeller/push/state_test.cljc
Normal file
@ -0,0 +1,14 @@
|
||||
(ns propeller.push.state-test
|
||||
(:require [clojure.test :as t]
|
||||
[propeller.push.state :as state]
|
||||
[propeller.push.utils.limits :as l]))
|
||||
|
||||
(t/deftest push-to-stack-test
|
||||
(t/is (= (state/push-to-stack {:integer '()} :integer 1)
|
||||
{:integer '(1)}))
|
||||
(t/is (= (state/push-to-stack {:integer '()} :integer 1e100)
|
||||
{:integer (list (long l/max-number-magnitude))})))
|
||||
|
||||
(t/deftest push-to-stack-many-test
|
||||
(t/is (= (state/push-to-stack-many {:string '()} :string ["a" "b" "c"])
|
||||
{:string '("a" "b" "c")})))
|
||||
9
test/propeller/push/utils/helpers_test.cljc
Normal file
9
test/propeller/push/utils/helpers_test.cljc
Normal file
@ -0,0 +1,9 @@
|
||||
(ns propeller.push.utils.helpers-test
|
||||
(:require [clojure.test :as t]
|
||||
[propeller.push.utils.helpers :as h]))
|
||||
|
||||
(t/deftest get-literal-type-test
|
||||
(t/is (= (h/get-literal-type "abc") :string))
|
||||
(t/is (= (h/get-literal-type [1]) :vector_integer))
|
||||
(t/is (= (h/get-literal-type false) :boolean))
|
||||
(t/is (= (h/get-literal-type 0.0) #?(:clj :float :cljs :integer))))
|
||||
29
test/propeller/push/utils/limits_test.cljc
Normal file
29
test/propeller/push/utils/limits_test.cljc
Normal file
@ -0,0 +1,29 @@
|
||||
(ns propeller.push.utils.limits-test
|
||||
(:require [clojure.test :as t]
|
||||
[propeller.push.utils.limits :as l]))
|
||||
|
||||
(t/deftest limit-number-test
|
||||
(t/is (= (l/limit-number (inc l/max-number-magnitude))
|
||||
l/max-number-magnitude))
|
||||
(t/is (l/limit-number 1.0E-10)
|
||||
l/min-number-magnitude))
|
||||
|
||||
(t/deftest limit-string-test
|
||||
(t/is (= (l/limit-string (apply str (repeat (inc l/max-string-length) "!")))
|
||||
(apply str (repeat l/max-string-length "!")))))
|
||||
|
||||
(t/deftest limit-vector-test
|
||||
(t/is (= (l/limit-vector (vec (repeat (inc l/max-vector-length) true)))
|
||||
(vec (repeat l/max-vector-length true)))))
|
||||
|
||||
(t/deftest limit-code-test
|
||||
(binding [l/max-code-points 8]
|
||||
(t/is (= (l/limit-code '(:a (:b (:c) :d :e :f) :g :h))
|
||||
'()))
|
||||
(t/is (= (l/limit-code '(:a :b :c))
|
||||
'(:a :b :c))))
|
||||
(binding [l/max-code-depth 2]
|
||||
(t/is (= (l/limit-code '(:a (:b (:c) :d :e :f) :g :h))
|
||||
'()))
|
||||
(t/is (= (l/limit-code '(:a :b :c))
|
||||
'(:a :b :c)))))
|
||||
8
test/propeller/utils_test.cljc
Normal file
8
test/propeller/utils_test.cljc
Normal file
@ -0,0 +1,8 @@
|
||||
(ns propeller.utils-test
|
||||
(:require [clojure.test :as t]
|
||||
[propeller.utils :as u]))
|
||||
|
||||
(t/deftest count-points-test
|
||||
(t/is (= 6 (u/count-points '(:a :b (:c :d)))))
|
||||
(t/is (= 1 (u/count-points '())))
|
||||
(t/is (= 2 (u/count-points '(:a)))))
|
||||
Loading…
x
Reference in New Issue
Block a user