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

Cleanup and metadata fix

Browse Source
This commit is contained in:
mcgirjau 2020-07-13 17:04:05 -04:00
parent 7ce624d4ba
commit 3e820407f3
19 changed files with 176 additions and 178 deletions

4
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

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

2
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]))

2
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]))

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

7
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
;; =============================================================================

13
src/propeller/push/instructions/chara.cljc → 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))))))

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

7
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

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

26
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

6
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]]))

7
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

62
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

4
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."

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

48
src/propeller/push/utils.cljc → 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)]

31
src/propeller/push/utils/macros.cljc Normal file

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

5
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."