From 847372ea1acea7e295423347afaa60d0e033754c Mon Sep 17 00:00:00 2001 From: mcgirjau Date: Mon, 19 Apr 2021 17:28:24 -0400 Subject: [PATCH] Fix polymorphic stack instructions --- src/propeller/push/instructions/bool.cljc | 3 +- .../push/instructions/character.cljc | 8 +- src/propeller/push/instructions/code.cljc | 8 +- .../push/instructions/input_output.cljc | 3 +- src/propeller/push/instructions/numeric.cljc | 52 +++++++----- .../push/instructions/polymorphic.cljc | 44 ++++++---- src/propeller/push/instructions/string.cljc | 1 - src/propeller/push/instructions/vector.cljc | 81 ++++++++++++------- src/propeller/push/utils/macros.cljc | 16 ++-- 9 files changed, 127 insertions(+), 89 deletions(-) diff --git a/src/propeller/push/instructions/bool.cljc b/src/propeller/push/instructions/bool.cljc index 07004f9..85a1ba2 100755 --- a/src/propeller/push/instructions/bool.cljc +++ b/src/propeller/push/instructions/bool.cljc @@ -1,6 +1,5 @@ (ns propeller.push.instructions.bool - #?(:cljs (:require-macros - [propeller.push.utils.macros :refer [def-instruction]])) + #?(:cljs (:require-macros [propeller.push.utils.macros :refer [def-instruction]])) (:require [propeller.push.utils.helpers :refer [make-instruction]] #?(:clj [propeller.push.utils.macros :refer [def-instruction]]))) diff --git a/src/propeller/push/instructions/character.cljc b/src/propeller/push/instructions/character.cljc index d858a5b..2f5d77b 100755 --- a/src/propeller/push/instructions/character.cljc +++ b/src/propeller/push/instructions/character.cljc @@ -1,13 +1,9 @@ (ns propeller.push.instructions.character - #?(:cljs (:require-macros - [propeller.push.utils.macros :refer [def-instruction - generate-instructions]])) + #?(:cljs (:require-macros [propeller.push.utils.macros :refer [def-instruction]])) (:require [propeller.push.state :as state] [propeller.push.utils.helpers :refer [make-instruction]] [propeller.tools.character :as char] - #?(:clj - [propeller.push.utils.macros :refer [def-instruction - generate-instructions]]))) + #?(:clj [propeller.push.utils.macros :refer [def-instruction]]))) ;; ============================================================================= ;; CHAR Instructions diff --git a/src/propeller/push/instructions/code.cljc b/src/propeller/push/instructions/code.cljc index 405fdc9..86e0478 100755 --- a/src/propeller/push/instructions/code.cljc +++ b/src/propeller/push/instructions/code.cljc @@ -1,13 +1,9 @@ (ns propeller.push.instructions.code - #?(:cljs (:require-macros - [propeller.push.utils.macros :refer [def-instruction - generate-instructions]])) + #?(:cljs (:require-macros [propeller.push.utils.macros :refer [def-instruction]])) (:require [propeller.utils :as utils] [propeller.push.state :as state] [propeller.push.utils.helpers :refer [make-instruction]] - #?(:clj - [propeller.push.utils.macros :refer [def-instruction - generate-instructions]]))) + #?(:clj [propeller.push.utils.macros :refer [def-instruction]]))) ;; ============================================================================= ;; CODE Instructions diff --git a/src/propeller/push/instructions/input_output.cljc b/src/propeller/push/instructions/input_output.cljc index 2a622e1..9d52d54 100755 --- a/src/propeller/push/instructions/input_output.cljc +++ b/src/propeller/push/instructions/input_output.cljc @@ -36,7 +36,8 @@ (state/push-to-stack popped-state :output (str current-output \newline))))) (def _print - ^{:stacks [:print]} + ^{:stacks [:print] + :name "_print"} (fn [stack state] (if (state/empty-stack? state stack) state diff --git a/src/propeller/push/instructions/numeric.cljc b/src/propeller/push/instructions/numeric.cljc index 0822081..8e5b6f9 100755 --- a/src/propeller/push/instructions/numeric.cljc +++ b/src/propeller/push/instructions/numeric.cljc @@ -5,8 +5,8 @@ (:require [propeller.push.utils.helpers :refer [make-instruction]] [propeller.tools.math :as math] #?(:cljs [cljs.reader :refer [read-string]] - :clj [propeller.push.utils.macros - :refer [def-instruction generate-instructions]]))) + :clj [propeller.push.utils.macros :refer [def-instruction + generate-instructions]]))) ;; ============================================================================= ;; FLOAT and INTEGER Instructions (polymorphic) @@ -15,34 +15,39 @@ ;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than the top ;; item, and FALSE otherwise (def _gt - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_gt"} (fn [stack state] (make-instruction state > [stack stack] :boolean))) ;; Pushes TRUE onto the BOOLEAN stack if the second item is greater than or ;; equal to the top item, and FALSE otherwise (def _gte - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_gte"} (fn [stack state] (make-instruction state >= [stack stack] :boolean))) ;; Pushes TRUE onto the BOOLEAN stack if the second item is less than the top ;; item, and FALSE otherwise (def _lt - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_lt"} (fn [stack state] (make-instruction state < [stack stack] :boolean))) ;; Pushes TRUE onto the BOOLEAN stack if the second item is less than or equal ;; to the top item, and FALSE otherwise (def _lte - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_lte"} (fn [stack state] (make-instruction state <= [stack stack] :boolean))) ;; Pushes the sum of the top two items onto the same stack (def _add - ^{:stacks #{}} + ^{:stacks #{} + :name "_add"} (fn [stack state] #?(:clj (make-instruction state +' [stack stack] stack) :cljs (make-instruction state + [stack stack] stack)))) @@ -50,14 +55,16 @@ ;; Pushes the difference of the top two items (i.e. the second item minus the ;; top item) onto the same stack (def _subtract - ^{:stacks #{}} + ^{:stacks #{} + :name "_subtract"} (fn [stack state] #?(:clj (make-instruction state -' [stack stack] stack) :cljs (make-instruction state - [stack stack] stack)))) ;; Pushes the product of the top two items onto the same stack (def _mult - ^{:stacks #{}} + ^{:stacks #{} + :name "_mult"} (fn [stack state] #?(:clj (make-instruction state *' [stack stack] stack) :cljs (make-instruction state * [stack stack] stack)))) @@ -65,7 +72,8 @@ ;; Pushes the quotient of the top two items (i.e. the second item divided by the ;; top item) onto the same stack. If the top item is zero, pushes 1 (def _quot - ^{:stacks #{}} + ^{:stacks #{} + :name "_quot"} (fn [stack state] (make-instruction state #(if (zero? %2) 1 (quot %1 %2)) [stack stack] stack))) @@ -74,25 +82,29 @@ ;; quotient, where the quotient has first been truncated towards negative ;; infinity. (def _mod - ^{:stacks #{}} + ^{:stacks #{} + :name "_mod"} (fn [stack state] (make-instruction state #(if (zero? %2) 1 (mod %1 %2)) [stack stack] stack))) ;; Pushes the maximum of the top two items (def _max - ^{:stacks #{}} + ^{:stacks #{} + :name "_max"} (fn [stack state] (make-instruction state max [stack stack] stack))) ;; Pushes the minimum of the top two items (def _min - ^{:stacks #{}} + ^{:stacks #{} + :name "_min"} (fn [stack state] (make-instruction state min [stack stack] stack))) ;; Pushes 1 / 1.0 if the top BOOLEAN is TRUE, or 0 / 0.0 if FALSE (def _from_boolean - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_from_boolean"} (fn [stack state] (make-instruction state #((if (= stack :integer) int float) (if % 1 0)) @@ -101,14 +113,16 @@ ;; Pushes the ASCII value of the top CHAR (def _from_char - ^{:stacks #{:char}} + ^{:stacks #{:char} + :name "_from_char"} (fn [stack state] (make-instruction state (if (= stack :integer) int float) [:char] stack))) ;; Pushes the value of the top STRING, if it can be parsed as a number. ;; Otherwise, acts as a NOOP (def _from_string - ^{:stacks #{:string}} + ^{:stacks #{:string} + :name "_from_string"} (fn [stack state] (make-instruction state #(try ((if (= stack :integer) int float) (read-string %)) @@ -119,13 +133,15 @@ ;; Pushes the increment (i.e. +1) of the top item of the stack (def _inc - ^{:stacks #{}} + ^{:stacks #{} + :name "_inc"} (fn [stack state] (make-instruction state inc [stack] stack))) ;; Pushes the decrement (i.e. -1) of the top item of the stack (def _dec - ^{:stacks #{}} + ^{:stacks #{} + :name "_dec"} (fn [stack state] (make-instruction state dec [stack] stack))) diff --git a/src/propeller/push/instructions/polymorphic.cljc b/src/propeller/push/instructions/polymorphic.cljc index 485a64a..3c0a8aa 100755 --- a/src/propeller/push/instructions/polymorphic.cljc +++ b/src/propeller/push/instructions/polymorphic.cljc @@ -6,9 +6,8 @@ [propeller.push.state :as state] [propeller.push.utils.helpers :refer [make-instruction]] [propeller.push.utils.globals :as globals] - #?(:clj - [propeller.push.utils.macros :refer [def-instruction - generate-instructions]]))) + #?(:clj [propeller.push.utils.macros :refer [def-instruction + generate-instructions]]))) ;; ============================================================================= ;; Polymorphic Instructions @@ -19,7 +18,8 @@ ;; Duplicates the top item of the stack. Does not pop its argument (since that ;; would negate the effect of the duplication) (def _dup - ^{:stacks #{}} + ^{:stacks #{} + :name "_dup"} (fn [stack state] (let [top-item (state/peek-stack state stack)] (if (state/empty-stack? state stack) @@ -33,7 +33,8 @@ ;; of n are treated as 0. The final number of items on the stack is limited to ;; globals/max-stack-items. (def _dup_times - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_dup_times"} (fn [stack state] (if (or (and (= stack :integer) (<= 2 (count (:integer state)))) @@ -55,7 +56,8 @@ ;; fewer than n items are on the stack, the entire stack will be duplicated. ;; The final number of items on the stack is limited to globals/max-stack-items. (def _dup_items - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_dup_items"} (fn [stack state] (if (state/empty-stack? state :integer) state @@ -67,33 +69,38 @@ ;; Pushes TRUE onto the BOOLEAN stack if the stack is empty. Otherwise FALSE (def _empty - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_empty"} (fn [stack state] (state/push-to-stack state :boolean (state/empty-stack? state stack)))) ;; Pushes TRUE onto the BOOLEAN stack if the top two items are equal. ;; Otherwise FALSE (def _eq - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_eq"} (fn [stack state] (make-instruction state = [stack stack] :boolean))) ;; Empties the given stack (def _flush - ^{:stacks #{}} + ^{:stacks #{} + :name "_flush"} (fn [stack state] (assoc state stack '()))) ;; Pops the given stack (def _pop - ^{:stacks #{}} + ^{:stacks #{} + :name "_pop"} (fn [stack state] (state/pop-stack state stack))) ;; Rotates the top three items on the stack (i.e. pulls the third item out and ;; pushes it on top). Equivalent to (yank state stack-type 2) (def _rot - ^{:stacks #{}} + ^{:stacks #{} + :name "_rot"} (fn [stack state] (if (<= 3 (count (get state stack))) (let [top-three (state/peek-stack-many state stack 3) @@ -105,7 +112,8 @@ ;; Inserts the top item deeper into the stack, using the top INTEGER to ;; determine how deep (def _shove - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_shove"} (fn [stack state] (if (or (and (= stack :integer) (<= 2 (count (:integer state)))) @@ -124,14 +132,16 @@ ;; Pushes the given stack's depth onto the INTEGER stack (def _stack_depth - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_stack_depth"} (fn [stack state] (let [stack-depth (count (get state stack))] (state/push-to-stack state :integer stack-depth)))) ;; Swaps the top two items on the stack (def _swap - ^{:stacks #{}} + ^{:stacks #{} + :name "_swap"} (fn [stack state] (if (<= 2 (count (get state stack))) (let [top-two (state/peek-stack-many state stack 2) @@ -142,7 +152,8 @@ ;; Pushes an indexed item from deep in the stack, removing it. The top INTEGER ;; is used to determine how deep to yank from (def _yank - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_yank"} (fn [stack state] (if (or (and (= stack :integer) (<= 2 (count (:integer state)))) @@ -162,7 +173,8 @@ ;; Pushes a copy of an indexed item from deep in the stack, without removing it. ;; The top INTEGER is used to determine how deep to yankdup from (def _yank_dup - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_yank_dup"} (fn [stack state] (if (or (and (= stack :integer) (<= 2 (count (:integer state)))) diff --git a/src/propeller/push/instructions/string.cljc b/src/propeller/push/instructions/string.cljc index 7d88e03..91d1a5a 100755 --- a/src/propeller/push/instructions/string.cljc +++ b/src/propeller/push/instructions/string.cljc @@ -2,7 +2,6 @@ #?(:cljs (:require-macros [propeller.push.utils.macros :refer [def-instruction]])) (:require [clojure.string :as string] - [propeller.utils :as utils] [propeller.push.utils.helpers :refer [make-instruction]] [propeller.push.state :as state] #?(:clj [propeller.push.utils.macros :refer [def-instruction]]))) diff --git a/src/propeller/push/instructions/vector.cljc b/src/propeller/push/instructions/vector.cljc index ccdc980..a8822f2 100755 --- a/src/propeller/push/instructions/vector.cljc +++ b/src/propeller/push/instructions/vector.cljc @@ -1,13 +1,11 @@ (ns propeller.push.instructions.vector - #?(:cljs (:require-macros - [propeller.push.utils.macros :refer [generate-instructions]])) + #?(:cljs (:require-macros [propeller.push.utils.macros :refer [generate-instructions]])) (:require [clojure.string] [propeller.utils :as utils] [propeller.push.state :as state] [propeller.push.utils.helpers :refer [get-vector-literal-type make-instruction]] - #?(:clj - [propeller.push.utils.macros :refer [generate-instructions]]))) + #?(:clj [propeller.push.utils.macros :refer [generate-instructions]]))) ;; ============================================================================= ;; VECTOR Instructions @@ -17,20 +15,23 @@ ;; Pushes the butlast of the top item (def _butlast - ^{:stacks #{}} + ^{:stacks #{} + :name "_butlast"} (fn [stack state] (make-instruction state #(vec (butlast %)) [stack] stack))) ;; Concats and pushes the top two vectors of the stack (def _concat - ^{:stacks #{}} + ^{:stacks #{} + :name "_concat"} (fn [stack state] (make-instruction state #(vec (concat %2 %1)) [stack stack] stack))) ;; 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 #{:elem}} + ^{:stacks #{:elem} + :name "_conj"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(conj %2 %1) [lit-stack stack] stack)))) @@ -39,7 +40,8 @@ ;; contains the top element of the appropriately-typed literal stack. Otherwise, ;; pushes FALSE (def _contains - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_contains"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(contains? (set %2) %1) [lit-stack stack] :boolean)))) @@ -47,7 +49,8 @@ ;; Pushes TRUE onto the BOOLEAN stack if the top element is an empty vector. ;; Otherwise, pushes FALSE (def _emptyvector - ^{:stacks #{:boolean}} + ^{:stacks #{:boolean} + :name "_emptyvector"} (fn [stack state] (make-instruction state empty? [stack] :boolean))) @@ -55,25 +58,28 @@ ;; appropriately-typed literal stack. If the vector is empty, return ;; :ignore-instruction so that nothing is changed on the stacks. (def _first - ^{:stacks #{:elem}} + ^{:stacks #{:elem} + :name "_first"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(if (empty? %) :ignore-instruction (first %)) - [stack] + [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 #{:elem :integer}} + ^{:stacks #{:elem :integer} + :name "_indexof"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer)))) ;; Iterates over the vector using the code on the exec stack (def _iterate - ^{:stacks #{:elem :integer}} + ^{:stacks #{:elem :integer} + :name "_iterate"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (if (or (state/empty-stack? state :exec) @@ -98,18 +104,20 @@ ;; Pushes the last item of the top element of the vector stack onto the ;; approrpiately-typed literal stack (def _last - ^{:stacks #{:elem}} + ^{:stacks #{:elem} + :name "_last"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] - (make-instruction - state - #(if (empty? %) :ignore-instruction (last %)) - [stack] - lit-stack)))) + (make-instruction + state + #(if (empty? %) :ignore-instruction (last %)) + [stack] + lit-stack)))) ;; Pushes the length of the top item onto the INTEGER stack (def _length - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_length"} (fn [stack state] (make-instruction state count [stack] :integer))) @@ -117,7 +125,8 @@ ;; 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 #{:elem :integer}} + ^{:stacks #{:elem :integer} + :name "_nth"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state @@ -131,7 +140,8 @@ ;; the appropriately-typed literal stack within the top element of the vector ;; stack (def _occurrencesof - ^{:stacks #{:elem :integer}} + ^{:stacks #{:elem :integer} + :name "_occurrencesof"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state @@ -141,7 +151,8 @@ ;; Pushes every item of the top element onto the appropriately-typed stack (def _pushall - ^{:stacks #{:elem}} + ^{:stacks #{:elem} + :name "_pushall"} (fn [stack state] (if (state/empty-stack? state stack) state @@ -153,7 +164,8 @@ ;; Removes all occurrences of the top element of the appropriately-typed literal ;; stack from the first element of the vector stack (def _remove - ^{:stacks #{:elem}} + ^{:stacks #{:elem} + :name "_remove"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state @@ -165,7 +177,8 @@ ;; literal stack with the top element of the appropriately-typed literal stack ;; within the top item of the vector stack (def _replace - ^{:stacks #{:elem}} + ^{:stacks #{:elem} + :name "_replace"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state @@ -178,7 +191,8 @@ ;; literal stack with the top element of the appropriately-typed literal stack ;; within the top item of the vector stack (def _replacefirst - ^{:stacks #{:elem}} + ^{:stacks #{:elem} + :name "_replacefirst"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state @@ -192,13 +206,15 @@ ;; Pushes the rest of the top item (def _rest - ^{:stacks #{}} + ^{:stacks #{} + :name "_rest"} (fn [stack state] (make-instruction state #(vec (rest %)) [stack] stack))) ;; Pushes the reverse of the top item (def _reverse - ^{:stacks #{}} + ^{:stacks #{} + :name "_reverse"} (fn [stack state] (make-instruction state #(vec (reverse %)) [stack] stack))) @@ -206,7 +222,8 @@ ;; 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 #{:elem :integer}} + ^{:stacks #{:elem :integer} + :name "_set"} (fn [stack state] (let [lit-stack (get-vector-literal-type stack)] (make-instruction state @@ -220,7 +237,8 @@ ;; Pushes a subvector of the top item, with start and end indices determined by ;; the second and top items of the INTEGER stack respectively (def _subvec - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_subvec"} (fn [stack state] (make-instruction state (fn [start-raw stop-raw vect] @@ -233,7 +251,8 @@ ;; Pushes the first N items of the top element, where N is taken from the top of ;; the INTEGER stack (def _take - ^{:stacks #{:integer}} + ^{:stacks #{:integer} + :name "_take"} (fn [stack state] (make-instruction state #(vec (take %1 %2)) [:integer stack] stack))) diff --git a/src/propeller/push/utils/macros.cljc b/src/propeller/push/utils/macros.cljc index 53a0f5c..f6dd102 100755 --- a/src/propeller/push/utils/macros.cljc +++ b/src/propeller/push/utils/macros.cljc @@ -16,7 +16,8 @@ (replace {:elem (get-vector-literal-type ~stack)}) (cons ~stack) set - (assoc-in (meta ~function) [:stacks]))) + (assoc-in (meta ~function) [:stacks]) + (#(dissoc % :name)))) ;; 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 @@ -26,10 +27,9 @@ ;; 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)) - metadata (make-metadata func stack) - new-func `(with-meta (partial ~func ~stack) ~metadata)]] - `(def-instruction ~instruction-name ~new-func)))) + `(doseq [stack# ~stacks + func# ~functions + :let [instruction-name# (keyword (str (name stack#) (:name (meta func#)))) + metadata# (make-metadata func# stack#) + new-func# (with-meta (partial func# stack#) metadata#)]] + (def-instruction instruction-name# new-func#)))