rowan.a.tl/propeller
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into fix/def-instruction-not-macro

Browse Source
This commit is contained in:
Tom Helmuth 2021-11-02 11:12:26 -04:00
commit 6b39e078ee
44 changed files with 3871 additions and 1281 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
.github/workflows/CI.yaml vendored Normal file
View 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
View File

@ -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
View File

File diff suppressed because it is too large Load Diff

6
package.json
View File

@ -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"
}
}

2
project.clj
View File

@ -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 [])

39
propeller.iml
View File

@ -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>

7
shadow-cljs.edn
View File

@ -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!}}}}}
:modules {:main {:init-fn propeller.main/main!}}}
:test {:extra-paths ["src"]
:target :node-test
:output-to "out/node-tests.js"}}}

22
src/propeller/gp.cljc
View File

@ -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

4
src/propeller/problems/PSB2/basement.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/bouncing_balls.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/bowling.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/camel_case.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/dice_game.cljc
View File

@ -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)))

4
src/propeller/problems/PSB2/fizz_buzz.cljc
View File

@ -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)))

4
src/propeller/problems/PSB2/fuel_cost.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/gcd.cljc
View File

@ -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)))

5
src/propeller/problems/PSB2/luhn.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/middle_character.cljc
View File

@ -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)))

4
src/propeller/problems/PSB2/paired_digits.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/shopping_list.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/snow_day.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/solve_boolean.cljc
View File

@ -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)))

4
src/propeller/problems/PSB2/spin_words.cljc
View File

@ -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)))

5
src/propeller/problems/PSB2/square_digits.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/substitution_cipher.cljc
View File

@ -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)))

3
src/propeller/problems/PSB2/twitter.cljc
View File

@ -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)))

3
src/propeller/problems/simple_regression.cljc
View File

@ -79,4 +79,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)))

3
src/propeller/problems/software/fizz_buzz.cljc
View File

@ -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))

3
src/propeller/problems/software/number_io.cljc
View File

@ -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)))

3
src/propeller/problems/software/smallest.cljc
View File

@ -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)))

3
src/propeller/problems/string_classification.cljc
View File

@ -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)))

3
src/propeller/problems/valiant.cljc
View File

@ -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)))

8
src/propeller/push/instructions/polymorphic.cljc
View File

@ -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)))

55
src/propeller/push/state.cljc
View File

@ -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)))

30
src/propeller/push/utils/globals.cljc
View File

@ -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)

137
src/propeller/push/utils/helpers.cljc
View File

@ -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
@ -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
View 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))

57
src/propeller/utils.cljc
View File

@ -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))))))

1120
test/propeller/push/instructions/string_spec.clj
View File

File diff suppressed because it is too large Load Diff

950
test/propeller/push/instructions/vector_spec.clj
View File

@ -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
View 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
View 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
View 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
View 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)))))