From 3e820407f36f8e08fc3a98c0c215a1235c389c14 Mon Sep 17 00:00:00 2001 From: mcgirjau Date: Mon, 13 Jul 2020 17:04:05 -0400 Subject: [PATCH] Cleanup and metadata fix --- src/propeller/core.cljc | 4 +- src/propeller/gp.cljc | 10 ++- .../problems/software/number_io.cljc | 2 +- src/propeller/problems/software/smallest.cljc | 2 +- src/propeller/push/core.cljc | 13 +-- src/propeller/push/instructions/bool.cljc | 7 +- .../{chara.cljc => character.cljc} | 13 ++- src/propeller/push/instructions/code.cljc | 17 ++-- .../push/instructions/input_output.cljc | 7 +- src/propeller/push/instructions/numeric.cljc | 11 +-- .../push/instructions/polymorphic.cljc | 26 +++--- src/propeller/push/instructions/random.cljc | 6 +- src/propeller/push/instructions/string.cljc | 7 +- src/propeller/push/instructions/vector.cljc | 62 +++++++-------- src/propeller/push/interpreter.cljc | 4 +- src/propeller/push/state.cljc | 79 ++++++++----------- .../push/{utils.cljc => utils/helpers.cljc} | 48 ++++++----- src/propeller/push/utils/macros.cljc | 31 ++++++++ src/propeller/utils.cljc | 5 -- 19 files changed, 176 insertions(+), 178 deletions(-) rename src/propeller/push/instructions/{chara.cljc => character.cljc} (82%) rename src/propeller/push/{utils.cljc => utils/helpers.cljc} (68%) create mode 100644 src/propeller/push/utils/macros.cljc diff --git a/src/propeller/core.cljc b/src/propeller/core.cljc index 9489fac..d88ecc1 100644 --- a/src/propeller/core.cljc +++ b/src/propeller/core.cljc @@ -13,8 +13,8 @@ (gp/gp (update-in (merge - {:instructions smallest/instructions - :error-function smallest/error-function + {:instructions number-io/instructions + :error-function number-io/error-function :max-generations 500 :population-size 500 :max-initial-plushy-size 100 diff --git a/src/propeller/gp.cljc b/src/propeller/gp.cljc index 158365f..aa398a2 100644 --- a/src/propeller/gp.cljc +++ b/src/propeller/gp.cljc @@ -2,9 +2,8 @@ (:require [clojure.string] [propeller.genome :as genome] [propeller.variation :as variation] - [propeller.push.core :as push] [propeller.push.instructions.bool] - [propeller.push.instructions.chara] + [propeller.push.instructions.character] [propeller.push.instructions.code] [propeller.push.instructions.input-output] [propeller.push.instructions.numeric] @@ -46,7 +45,9 @@ instructions max-initial-plushy-size)))] (let [evaluated-pop (sort-by :total-error - (map (partial error-function argmap) population)) + (#?(:clj pmap + :cljs map) + (partial error-function argmap) population)) best-individual (first evaluated-pop)] (report evaluated-pop generation) (cond @@ -56,7 +57,8 @@ (print "Checking program on test cases... ") (if (zero? (:total-error (error-function argmap best-individual :test))) (println "Test cases passed.") - (println "Test cases failed."))) + (println "Test cases failed.")) + (#?(:clj shutdown-agents))) ;; (>= generation max-generations) nil :else (recur (inc generation) diff --git a/src/propeller/problems/software/number_io.cljc b/src/propeller/problems/software/number_io.cljc index ddb1e90..0b052ba 100644 --- a/src/propeller/problems/software/number_io.cljc +++ b/src/propeller/problems/software/number_io.cljc @@ -2,7 +2,7 @@ (:require [propeller.genome :as genome] [propeller.push.interpreter :as interpreter] [propeller.push.state :as state] - [propeller.push.utils :refer [get-stack-instructions]] + [propeller.push.utils.helpers :refer [get-stack-instructions]] [propeller.utils :as utils] [propeller.push.state :as state] [propeller.tools.math :as math])) diff --git a/src/propeller/problems/software/smallest.cljc b/src/propeller/problems/software/smallest.cljc index 7c91feb..9641cfa 100644 --- a/src/propeller/problems/software/smallest.cljc +++ b/src/propeller/problems/software/smallest.cljc @@ -2,7 +2,7 @@ (:require [propeller.genome :as genome] [propeller.push.interpreter :as interpreter] [propeller.push.state :as state] - [propeller.push.utils :refer [get-stack-instructions]] + [propeller.push.utils.helpers :refer [get-stack-instructions]] [propeller.utils :as utils] [propeller.push.state :as state])) diff --git a/src/propeller/push/core.cljc b/src/propeller/push/core.cljc index 624c1d9..2cba929 100644 --- a/src/propeller/push/core.cljc +++ b/src/propeller/push/core.cljc @@ -1,16 +1,7 @@ (ns propeller.push.core) -;; ============================================================================= -;; PushGP Instructions -;; -;; Instructions are represented as keywords, and stored in an atom. -;; -;; Instructions must all be either functions that take one Push state and -;; return another, or constant literals. -;; -;; TMH: ERCs? -;; ============================================================================= - +;; PushGP instructions are represented as keywords, and stored in an atom. They +;; can be either constant literals or functions that take and return a Push state (def instruction-table (atom (hash-map))) ;; Number of blocks opened by instructions (default = 0) diff --git a/src/propeller/push/instructions/bool.cljc b/src/propeller/push/instructions/bool.cljc index a44551d..065710d 100644 --- a/src/propeller/push/instructions/bool.cljc +++ b/src/propeller/push/instructions/bool.cljc @@ -1,8 +1,7 @@ (ns propeller.push.instructions.bool - #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction - make-instruction]])) - (:require #?(:clj [propeller.push.utils :refer [def-instruction - make-instruction]]))) + (:require [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction]])) + ;; ============================================================================= ;; BOOLEAN Instructions ;; ============================================================================= diff --git a/src/propeller/push/instructions/chara.cljc b/src/propeller/push/instructions/character.cljc similarity index 82% rename from src/propeller/push/instructions/chara.cljc rename to src/propeller/push/instructions/character.cljc index 9133035..d9a5860 100644 --- a/src/propeller/push/instructions/chara.cljc +++ b/src/propeller/push/instructions/character.cljc @@ -1,10 +1,9 @@ -(ns propeller.push.instructions.chara - #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction - make-instruction]])) +(ns propeller.push.instructions.character (:require [propeller.push.state :as state] - [propeller.tools.character :as char] - #?(:clj [propeller.push.utils :refer [def-instruction - make-instruction]]))) + [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction + generate-instructions]] + [propeller.tools.character :as char])) ;; ============================================================================= ;; CHAR Instructions @@ -62,4 +61,4 @@ state (let [top-string (state/peek-stack state :string) popped-state (state/pop-stack state :string)] - (state/push-to-stack-multiple popped-state :char (map char top-string)))))) + (state/push-to-stack-many popped-state :char (map char top-string)))))) diff --git a/src/propeller/push/instructions/code.cljc b/src/propeller/push/instructions/code.cljc index 7cf513d..57b2217 100644 --- a/src/propeller/push/instructions/code.cljc +++ b/src/propeller/push/instructions/code.cljc @@ -1,12 +1,9 @@ (ns propeller.push.instructions.code - #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]])) (:require [propeller.utils :as utils] [propeller.push.state :as state] - #?(:clj [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]]))) + [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction + generate-instructions]])) ;; ============================================================================= ;; Polymorphic Instructions @@ -188,10 +185,10 @@ (fn [state] (if (< (count (:exec state)) 3) state - (let [[a b c] (state/peek-stack-multiple state :exec 3) - popped-state (state/pop-stack-multiple state :exec 3) + (let [[a b c] (state/peek-stack-many state :exec 3) + popped-state (state/pop-stack-many state :exec 3) to-push-back (list a c (list b c))] - (state/push-to-stack-multiple popped-state :exec to-push-back))))) + (state/push-to-stack-many popped-state :exec to-push-back))))) ;; The "Y combinator" - inserts beneath the top item of the EXEC stack a new ;; item of the form "(:exec_y TOP_ITEM)" @@ -204,4 +201,4 @@ (let [top-item (state/peek-stack state :exec) popped-state (state/pop-stack state :exec) to-push-back (list top-item (list :exec_y top-item))] - (state/push-to-stack-multiple popped-state :exec to-push-back))))) + (state/push-to-stack-many popped-state :exec to-push-back))))) diff --git a/src/propeller/push/instructions/input_output.cljc b/src/propeller/push/instructions/input_output.cljc index 4753829..ed9b6b5 100644 --- a/src/propeller/push/instructions/input_output.cljc +++ b/src/propeller/push/instructions/input_output.cljc @@ -1,9 +1,8 @@ (ns propeller.push.instructions.input-output - #?(:cljs (:require-macros [propeller.push.utils :refer - [def-instruction generate-instructions]])) (:require [propeller.push.state :as state] - #?(:clj [propeller.push.utils :refer [def-instruction - generate-instructions]]))) + [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction + generate-instructions]])) ;; ============================================================================= ;; INPUT Instructions diff --git a/src/propeller/push/instructions/numeric.cljc b/src/propeller/push/instructions/numeric.cljc index 784be70..b6f5337 100644 --- a/src/propeller/push/instructions/numeric.cljc +++ b/src/propeller/push/instructions/numeric.cljc @@ -1,11 +1,8 @@ (ns propeller.push.instructions.numeric - #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]])) - (:require [propeller.tools.math :as math] - #?(:clj [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]]))) + (:require [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction + generate-instructions]] + [propeller.tools.math :as math])) ;; ============================================================================= ;; FLOAT and INTEGER Instructions (polymorphic) diff --git a/src/propeller/push/instructions/polymorphic.cljc b/src/propeller/push/instructions/polymorphic.cljc index 9301f5e..77332df 100644 --- a/src/propeller/push/instructions/polymorphic.cljc +++ b/src/propeller/push/instructions/polymorphic.cljc @@ -1,16 +1,14 @@ (ns propeller.push.instructions.polymorphic - #?(:cljs (:require-macros [propeller.push.utils :refer [generate-instructions - make-instruction]])) (:require [propeller.utils :as utils] [propeller.push.state :as state] - #?(:clj [propeller.push.utils :refer [generate-instructions - make-instruction]]))) + [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction + generate-instructions]])) ;; ============================================================================= ;; Polymorphic Instructions ;; -;; (for all stacks, with the exception of non-data ones like auxiliary, input, -;; and output) +;; (for all stacks, with the exception of non-data ones like input and output) ;; ============================================================================= ;; Duplicates the top item of the stack. Does not pop its argument (since that @@ -41,7 +39,7 @@ top-item (state/peek-stack popped-state stack) top-item-dup (take (- n 1) (repeat top-item))] (cond - (< 0 n) (state/push-to-stack-multiple popped-state stack top-item-dup) + (< 0 n) (state/push-to-stack-many popped-state stack top-item-dup) :else (state/pop-stack popped-state stack))) state))) @@ -56,7 +54,7 @@ (let [n (state/peek-stack state :integer) popped-state (state/pop-stack state :integer) top-items (take n (get popped-state stack))] - (state/push-to-stack-multiple popped-state stack top-items))))) + (state/push-to-stack-many popped-state stack top-items))))) ;; Pushes TRUE onto the BOOLEAN stack if the stack is empty. Otherwise FALSE (def _empty @@ -89,10 +87,10 @@ ^{:stacks #{}} (fn [stack state] (if (<= 3 (count (get state stack))) - (let [top-three (state/peek-stack-multiple state stack 3) - popped-state (state/pop-stack-multiple state stack 3) + (let [top-three (state/peek-stack-many state stack 3) + popped-state (state/pop-stack-many state stack 3) top-three-rot (take 3 (conj top-three (last top-three)))] - (state/push-to-stack-multiple popped-state stack top-three-rot)) + (state/push-to-stack-many popped-state stack top-three-rot)) state))) ;; Inserts the top item deeper into the stack, using the top INTEGER to @@ -127,9 +125,9 @@ ^{:stacks #{}} (fn [stack state] (if (<= 2 (count (get state stack))) - (let [top-two (state/peek-stack-multiple state stack 2) - popped-state (state/pop-stack-multiple state stack 2)] - (state/push-to-stack-multiple popped-state stack (reverse top-two))) + (let [top-two (state/peek-stack-many state stack 2) + popped-state (state/pop-stack-many state stack 2)] + (state/push-to-stack-many popped-state stack (reverse top-two))) state))) ;; Pushes an indexed item from deep in the stack, removing it. The top INTEGER diff --git a/src/propeller/push/instructions/random.cljc b/src/propeller/push/instructions/random.cljc index 8fb64da..5b9829d 100644 --- a/src/propeller/push/instructions/random.cljc +++ b/src/propeller/push/instructions/random.cljc @@ -1,5 +1,7 @@ (ns propeller.push.instructions.random - #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction]])) - #?(:clj (:require [propeller.push.utils :refer [def-instruction]]))) + (:require [propeller.push.state :as state] + [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction + generate-instructions]])) diff --git a/src/propeller/push/instructions/string.cljc b/src/propeller/push/instructions/string.cljc index c2b92d2..dbbc054 100644 --- a/src/propeller/push/instructions/string.cljc +++ b/src/propeller/push/instructions/string.cljc @@ -1,9 +1,6 @@ (ns propeller.push.instructions.string - #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction - make-instruction]])) - - (:require #?(:clj [propeller.push.utils :refer [def-instruction - make-instruction]]))) + (:require [propeller.push.utils.helpers :refer [make-instruction]] + [propeller.push.utils.macros :refer [def-instruction]])) ;; ============================================================================= ;; STRING Instructions diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index 6f7c50b..4a23536 100644 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -1,16 +1,15 @@ (ns propeller.push.instructions.vector - #?(:cljs (:require-macros [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]])) (:require [clojure.string] [propeller.utils :as utils] [propeller.push.state :as state] - #?(:clj [propeller.push.utils :refer [def-instruction - generate-instructions - make-instruction]]))) + [propeller.push.utils.helpers :refer [get-vector-literal-type + make-instruction]] + [propeller.push.utils.macros :refer [generate-instructions]])) ;; ============================================================================= ;; VECTOR Instructions +;; +;; (common for all vector element subtypes: BOOLEAN, FLOAT, INTEGER, and STRING) ;; ============================================================================= ;; Pushes the butlast of the top item @@ -28,9 +27,9 @@ ;; Conj's the top item of the appropriately-typed literal stack onto the vector ;; stack (e.g. pop the top INTEGER and conj it onto the top VECTOR_INTEGER) (def _conj - ^{:stacks #{}} + ^{:stacks #{:elem}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(conj %2 %1) [lit-stack stack] stack)))) ;; Pushes TRUE onto the BOOLEAN stack if the top element of the vector stack @@ -39,7 +38,7 @@ (def _contains ^{:stacks #{:boolean}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean)))) ;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector. @@ -52,25 +51,25 @@ ;; Pushes the first item of the top element of the vector stack onto the ;; approrpiately-typed literal stack (def _first - ^{:stacks #{}} + ^{:stacks #{:elem}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state first [stack] lit-stack)))) ;; Pushes onto the INTEGER stack the index of the top element of the ;; appropriately-typed literal stack within the top element of the vector stack (def _indexof - ^{:stacks #{:integer}} + ^{:stacks #{:elem :integer}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer)))) ;; Pushes the last item of the top element of the vector stack onto the ;; approrpiately-typed literal stack (def _last - ^{:stacks #{}} + ^{:stacks #{:elem}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state last [stack] lit-stack)))) ;; Pushes the length of the top item onto the INTEGER stack @@ -83,9 +82,9 @@ ;; approrpiately-typed literal stack, where N is taken from the INTEGER stack. ;; To insure the index is within bounds, N is taken mod the vector length (def _nth - ^{:stacks #{:integer}} + ^{:stacks #{:elem :integer}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(get %2 (mod %1 (count %2))) [:integer stack] @@ -95,9 +94,9 @@ ;; the appropriately-typed literal stack within the top element of the vector ;; stack (def _occurrencesof - ^{:stacks #{:integer}} + ^{:stacks #{:elem :integer}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state (fn [lit vect] (count (filter #(= lit %) vect))) [lit-stack stack] @@ -105,21 +104,21 @@ ;; Pushes every item of the top element onto the appropriately-typed stack (def _pushall - ^{:stacks #{}} + ^{:stacks #{:elem}} (fn [stack state] (if (state/empty-stack? state stack) state - (let [lit-stack (utils/get-vector-literal-type stack) + (let [lit-stack (get-vector-literal-type stack) top-vector (state/peek-stack state stack) popped-state (state/pop-stack state stack)] - (state/push-to-stack-multiple popped-state lit-stack top-vector))))) + (state/push-to-stack-many popped-state lit-stack top-vector))))) ;; Removes all occurrences of the top element of the appropriately-typed literal ;; stack from the first element of the vector stack (def _remove - ^{:stacks #{}} + ^{:stacks #{:elem}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state (fn [lit vect] (vec (filter #(not= lit %) vect))) [lit-stack stack] @@ -129,9 +128,9 @@ ;; literal stack with the top element of the appropriately-typed literal stack ;; within the top item of the vector stack (def _replace - ^{:stacks #{}} + ^{:stacks #{:elem}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state (fn [lit1 lit2 vect] (replace {lit1 lit2} vect)) @@ -142,9 +141,9 @@ ;; literal stack with the top element of the appropriately-typed literal stack ;; within the top item of the vector stack (def _replacefirst - ^{:stacks #{}} + ^{:stacks #{:elem}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state (fn [lit1 lit2 vect] (assoc vect (utils/indexof lit1 vect) lit2)) @@ -167,9 +166,9 @@ ;; with the top item from the appropriately-typed literal stack. To insure the ;; index is within bounds, N is taken mod the vector length (def _set - ^{:stacks #{:integer}} + ^{:stacks #{:elem :integer}} (fn [stack state] - (let [lit-stack (utils/get-vector-literal-type stack)] + (let [lit-stack (get-vector-literal-type stack)] (make-instruction state (fn [lit n vect] (assoc vect (mod n (count vect)) lit)) @@ -202,6 +201,3 @@ [_butlast _concat _conj _contains _emptyvector _first _indexof _last _length _nth _occurrencesof _pushall _remove _replace _replacefirst _rest _reverse _set _subvec _take]) - -;; Manually add extra metadata for _conj - diff --git a/src/propeller/push/interpreter.cljc b/src/propeller/push/interpreter.cljc index d8504ca..4aa9d24 100644 --- a/src/propeller/push/interpreter.cljc +++ b/src/propeller/push/interpreter.cljc @@ -1,8 +1,8 @@ (ns propeller.push.interpreter (:require [propeller.push.core :as push] [propeller.push.state :as state] - [propeller.push.utils :refer [get-literal-type]] - [propeller.push.instructions.input-output :as io])) + [propeller.push.instructions.input-output :as io] + [propeller.push.utils.helpers :refer [get-literal-type]])) (defn interpret-one-step "Takes a Push state and executes the next instruction on the exec stack." diff --git a/src/propeller/push/state.cljc b/src/propeller/push/state.cljc index a53b64d..5026dec 100644 --- a/src/propeller/push/state.cljc +++ b/src/propeller/push/state.cljc @@ -1,8 +1,7 @@ (ns propeller.push.state) ;; Empty push state - all available stacks are empty -(defonce empty-state {:auxiliary '() - :boolean '() +(defonce empty-state {:boolean '() :char '() :code '() :exec '() @@ -16,71 +15,61 @@ :vector_integer '() :vector_string '()}) -(def example-push-state - {:exec '() - :integer '(1 2 3 4 5 6 7) - :string '("abc") - :input {:in1 4}}) +;; All stack types available in a Push state +(defonce stacks (set (keys empty-state))) +;; All vector stack types available in a Push state, with their corresponding +;; element types +(defonce vec-stacks {:vector_boolean :boolean + :vector_float :float + :vector_integer :integer + :vector_string :string}) + +(def example-state {:exec '() + :integer '(1 2 3 4 5 6 7) + :string '("abc") + :input {:in1 4}}) + +;; Returns true if the stack is empty (defn empty-stack? - "Returns true if the stack is empty." [state stack] (empty? (get state stack))) +;; Returns the top item on the stack (defn peek-stack - "Returns the top item on a stack." [state stack] - (let [working-stack (get state stack)] - (if (empty? working-stack) - :no-stack-item - (first working-stack)))) + (if-let [top-item (first (get state stack))] + top-item + :no-stack-item)) -(defn peek-stack-multiple - "Returns the top n items on a stack. If there are less than n items on the - stack, returns the entire stack." +;; Returns the top n items on the stack, as a chunk. If there are less than n +;; items on the stack, returns the entire stack +(defn peek-stack-many [state stack n] (take n (get state stack))) +;; Removes the top item of stack (defn pop-stack - "Removes the top item of stack." [state stack] (update state stack rest)) -(defn pop-stack-multiple - "Removes the top n items of a stack. If there are less than n items on the - stack, pops the entire stack." +;; Pops the top n items of the stack. If there are less than n items on the +;; stack, pops the entire stack +(defn pop-stack-many [state stack n] (update state stack #(drop n %))) +;; Pushes an item onto the stack (defn push-to-stack - "Pushes an item onto a stack." [state stack item] (if (nil? item) state (update state stack conj item))) -(defn push-to-stack-multiple - "Pushes a list of items onto a stack, leaving them in the order they are in." +;; 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-list (if (coll? items) items (list items)) - items-list-no-nil (filter #(not (nil? %)) items-list)] - (update state stack into (reverse items-list-no-nil)))) - -(defn get-args-from-stacks - "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." - [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)))))))) + (let [items (if (coll? items) items (list items)) + items-no-nil (filter #(not (nil? %)) items)] + (update state stack into (reverse items-no-nil)))) diff --git a/src/propeller/push/utils.cljc b/src/propeller/push/utils/helpers.cljc similarity index 68% rename from src/propeller/push/utils.cljc rename to src/propeller/push/utils/helpers.cljc index f1582e1..1feb201 100644 --- a/src/propeller/push/utils.cljc +++ b/src/propeller/push/utils/helpers.cljc @@ -1,11 +1,26 @@ -(ns propeller.push.utils +(ns propeller.push.utils.helpers (:require [clojure.set] [propeller.push.core :as push] [propeller.push.state :as state])) -(defmacro def-instruction - [instruction definition] - `(swap! push/instruction-table assoc '~instruction ~definition)) +;; 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 @@ -13,29 +28,15 @@ ;; given stacks), and pushes the result onto the return-stack (defn make-instruction [state function arg-stacks return-stack] - (let [popped-args (state/get-args-from-stacks state arg-stacks)] + (let [popped-args (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)] (state/push-to-stack new-state return-stack result))))) -;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix -;; function strings, e.g. [_add, _mult, _eq], automates the generation of all -;; possible combination instructions, which here would be :float_add, :float_mult, -;; :float_eq, :integer_add, :integer_mult, and :integer_eq, also transferring -;; and updating the generic function's stack-type metadata -(defmacro generate-instructions [stacks functions] - `(do ~@(for [stack stacks - func functions - :let [instruction-name (keyword (str (name stack) func)) - metadata `(update-in (meta ~func) [:stacks] #(conj % ~stack)) - new-func `(with-meta (partial ~func ~stack) ~metadata)]] - `(def-instruction ~instruction-name ~new-func)))) - ;; Given a set of stacks, returns all instructions that operate on those stacks -;; only. This won't include random or parenthesis-altering instructions unless -;; :random or :parentheses respectively are in the stacks set +;; only. Won't include random instructions unless :random is in the set as well (defn get-stack-instructions [stacks] (doseq [[instruction-name function] @push/instruction-table] @@ -70,7 +71,12 @@ :when (function data)] stack)))) -;; Pretty-prints a Push state, for logging or debugging purposes +(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)] diff --git a/src/propeller/push/utils/macros.cljc b/src/propeller/push/utils/macros.cljc new file mode 100644 index 0000000..d9045af --- /dev/null +++ b/src/propeller/push/utils/macros.cljc @@ -0,0 +1,31 @@ +(ns propeller.push.utils.macros + (:require [propeller.push.core :as push] + [propeller.push.state :as state] + [propeller.push.utils.helpers :refer [get-vector-literal-type]])) + +;; Defines a Push instruction as a keyword-function pair, and adds it to the +;; instruction table +(defmacro def-instruction + [instruction definition] + `(swap! push/instruction-table assoc '~instruction ~definition)) + +;; Given a sequence of stacks, e.g. [:float :integer], and a sequence of suffix +;; function strings, e.g. [_add, _mult, _eq], automates the generation of all +;; possible combination instructions, which here would be :float_add, :float_mult, +;; :float_eq, :integer_add, :integer_mult, and :integer_eq, also transferring +;; and updating the generic function's stack-type metadata. For some vector +;; instructions, the placeholder :elem will be replaced with the stack of the +;; corresponding element type (e.g. for :vector_integer, with :integer) +(defmacro generate-instructions [stacks functions] + `(do ~@(for [stack stacks + func functions + :let [instruction-name (keyword (str (name stack) func)) + old-stack-data `(:stacks (meta ~func)) + vec-stack-data `(set + (replace + {:elem (get-vector-literal-type ~stack)} + ~old-stack-data)) + new-stack-data `(conj ~vec-stack-data ~stack) + metadata `(assoc-in (meta ~func) [:stacks] ~new-stack-data) + new-func `(with-meta (partial ~func ~stack) ~metadata)]] + `(def-instruction ~instruction-name ~new-func)))) diff --git a/src/propeller/utils.cljc b/src/propeller/utils.cljc index 492ec20..4e378a9 100644 --- a/src/propeller/utils.cljc +++ b/src/propeller/utils.cljc @@ -1,10 +1,5 @@ (ns propeller.utils) -(defn get-vector-literal-type - "Returns the literal stack corresponding to some vector stack." - [vector-stack] - (keyword (clojure.string/replace (str vector-stack) ":vector_" ""))) - (defn indexof "Returns the first index of an element in a collection. If the element is not present in the collection, returns -1."