Merge pull request #13 from mcgirjau/polymorphic-fix

Fix polymorphic stack instructions

src/propeller/push/instructions/bool.cljc

@@ -1,6 +1,5 @@
 (ns propeller.push.instructions.bool
-  #?(:cljs (:require-macros
+  #?(:cljs (:require-macros [propeller.push.utils.macros :refer [def-instruction]]))
-             [propeller.push.utils.macros :refer [def-instruction]]))
   (:require [propeller.push.utils.helpers :refer [make-instruction]]
             #?(:clj [propeller.push.utils.macros :refer [def-instruction]])))
 

src/propeller/push/instructions/character.cljc

@@ -1,13 +1,9 @@
 (ns propeller.push.instructions.character
-  #?(:cljs (:require-macros
+  #?(:cljs (:require-macros [propeller.push.utils.macros :refer [def-instruction]]))
-             [propeller.push.utils.macros :refer [def-instruction
-                                                  generate-instructions]]))
   (:require [propeller.push.state :as state]
             [propeller.push.utils.helpers :refer [make-instruction]]
             [propeller.tools.character :as char]
-            #?(:clj
+            #?(:clj [propeller.push.utils.macros :refer [def-instruction]])))
-               [propeller.push.utils.macros :refer [def-instruction
-                                                    generate-instructions]])))
 
 ;; =============================================================================
 ;; CHAR Instructions

src/propeller/push/instructions/code.cljc

@@ -1,13 +1,9 @@
 (ns propeller.push.instructions.code
-  #?(:cljs (:require-macros
+  #?(:cljs (:require-macros [propeller.push.utils.macros :refer [def-instruction]]))
-             [propeller.push.utils.macros :refer [def-instruction
-                                                  generate-instructions]]))
   (:require [propeller.utils :as utils]
             [propeller.push.state :as state]
             [propeller.push.utils.helpers :refer [make-instruction]]
-            #?(:clj
+            #?(:clj [propeller.push.utils.macros :refer [def-instruction]])))
-               [propeller.push.utils.macros :refer [def-instruction
-                                                    generate-instructions]])))
 
 ;; =============================================================================
 ;; CODE Instructions

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

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
+               :clj [propeller.push.utils.macros :refer [def-instruction
-                     :refer [def-instruction generate-instructions]])))
+                                                         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)))
 

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
+            #?(:clj [propeller.push.utils.macros :refer [def-instruction
-               [propeller.push.utils.macros :refer [def-instruction
+                                                         generate-instructions]])))
-                                                    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))))

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

src/propeller/push/instructions/vector.cljc

@@ -1,13 +1,11 @@
 (ns propeller.push.instructions.vector
-  #?(:cljs (:require-macros
+  #?(:cljs (:require-macros [propeller.push.utils.macros :refer [generate-instructions]]))
-             [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
+            #?(:clj [propeller.push.utils.macros :refer [generate-instructions]])))
-               [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 
+      (make-instruction
-       state 
+        state
-       #(if (empty? %) :ignore-instruction (last %)) 
+        #(if (empty? %) :ignore-instruction (last %))
-       [stack] 
+        [stack]
-       lit-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)))
 

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
+  `(doseq [stack# ~stacks
-     ~@(for [stack stacks
+           func# ~functions
-             func functions
+           :let [instruction-name# (keyword (str (name stack#) (:name (meta func#))))
-             :let [instruction-name (keyword (str (name stack) func))
+                 metadata# (make-metadata func# stack#)
-                   metadata (make-metadata func stack)
+                 new-func# (with-meta (partial func# stack#) metadata#)]]
-                   new-func `(with-meta (partial ~func ~stack) ~metadata)]]
+     (def-instruction instruction-name# new-func#)))
-         `(def-instruction ~instruction-name ~new-func))))