Redesigns limits

src/propeller/push/instructions/polymorphic.cljc

@@ -5,7 +5,7 @@
   (:require [propeller.utils :as utils]
             [propeller.push.state :as state]
             [propeller.push.utils.helpers :refer [make-instruction]]
-            [propeller.push.utils.globals :as globals]
+            [propeller.push.utils.limits :as limit]
             #?(:clj [propeller.push.utils.macros :refer [def-instruction
                                                          generate-instructions]])))
 
@@ -42,7 +42,7 @@
                  (not (state/empty-stack? state :integer))
                  (not (state/empty-stack? state stack))))
       (let [n (min (state/peek-stack state :integer)
-                   (inc (- globals/max-stack-items (state/stack-size state stack))))
+                   (inc (- limit/max-stack-items (state/stack-size state stack))))
             popped-state (state/pop-stack state :integer)
             top-item (state/peek-stack popped-state stack)
             top-item-dup (take (- n 1) (repeat top-item))]
@@ -62,7 +62,7 @@
     (if (state/empty-stack? state :integer)
       state
       (let [n (min (state/peek-stack state :integer)
-                   (- globals/max-stack-items (state/stack-size state stack)))
+                   (- limit/max-stack-items (state/stack-size state stack)))
             popped-state (state/pop-stack state :integer)
             top-items (take n (get popped-state stack))]
         (state/push-to-stack-many popped-state stack top-items)))))
@@ -201,7 +201,7 @@
                  (not (state/empty-stack? state stack))))
       (let [index-raw (state/peek-stack state :integer)
             popped-state (state/pop-stack state :integer)
-            index (max 0 (min index-raw (dec (count (get popped-state stack)))))
+            index (max 0 (min index-raw (dec (state/stack-size popped-state stack))))
             indexed-item (nth (reverse (get popped-state stack)) index)]
         (state/push-to-stack popped-state stack indexed-item))
       state)))

src/propeller/push/state.cljc

@@ -1,4 +1,6 @@
-(ns propeller.push.state)
+(ns propeller.push.state
+  (:require [propeller.push.utils.limits :as l]
+            #?(:cljs [goog.string :as gstring])))
 
 ;; Empty push state - all available stacks are empty
 (defonce empty-state {:boolean        '()
@@ -26,6 +28,16 @@
                      :vector_integer :integer
                      :vector_string  :string})
 
+(defonce stack-limiter {:exec           l/limit-code
+                        :code           l/limit-code
+                        :integer        #(long (l/limit-number %))
+                        :float          l/limit-number
+                        :string         l/limit-string
+                        :vector_boolean l/limit-string
+                        :vector_float   #(mapv l/limit-number (l/limit-vector %))
+                        :vector_integer #(mapv (fn [i] (int (l/limit-number i))) (l/limit-vector %))
+                        :vector_string  #(mapv (fn [s] (l/limit-string s)) (l/limit-vector %))})
+
 (def example-state {:exec    '()
                     :integer '(1 2 3 4 5 6 7)
                     :string  '("abc")
@@ -68,14 +80,47 @@
 ;; Pushes an item onto the stack
 (defn push-to-stack
   [state stack item]
-  (if (nil? item)
+  (if (or (nil? item)
+          (>= (stack-size state stack) l/max-stack-items))
     state
-    (update state stack conj item)))
+    (let [limiter (get stack-limiter stack identity)]
+      (update state stack conj (limiter item)))))
 
 ;; Pushes a collection of items onto the stack, as a chunk (i.e. leaving them in
 ;; the order they are in)
 (defn push-to-stack-many
   [state stack items]
   (let [items (if (coll? items) items (list items))
-        items-no-nil (filter #(not (nil? %)) items)]
+        items-no-nil (filter #(not (nil? %)) items)
-    (update state stack into (reverse items-no-nil))))
+        items-to-push (take (- l/max-stack-items (stack-size state stack)) items-no-nil)
+        limit (get stack-limiter stack identity)]
+    (update state stack into (map limit (reverse items-to-push)))))
+
+;; Takes a state and a collection of stacks to take args from. If there are
+;; enough args on each of the desired stacks, returns a map with keys
+;; {:state :args}, where :state is the new state and :args is a list of args
+;; popped from the stacks. If there aren't enough args on the stacks, returns
+;; :not-enough-args without popping anything
+(defn get-args-from-stacks
+  [state stacks]
+  (loop [state state
+         stacks (reverse stacks)
+         args '()]
+    (if (empty? stacks)
+      {:state state :args args}
+      (let [current-stack (first stacks)]
+        (if (empty-stack? state current-stack)
+          :not-enough-args
+          (recur (pop-stack state current-stack)
+                 (rest stacks)
+                 (conj args (peek-stack state current-stack))))))))
+
+
+;; Pretty-print a Push state, for logging or debugging purposes
+(defn print-state
+  [state]
+  (doseq [stack (keys empty-state)]
+    #?(:clj  (printf "%-15s = " stack)
+       :cljs (print (gstring/format "%-15s = " stack)))
+    (prn (if (get state stack) (get state stack) '()))
+    (flush)))

src/propeller/push/utils/globals.cljc

@@ -1,30 +0,0 @@
-(ns propeller.push.utils.globals)
-
-;; =============================================================================
-;; Values used by the Push instructions to keep the stack sizes within
-;; reasonable limits.
-;; =============================================================================
-
-;; Limits the number of items that can be duplicated onto a stack at once.
-;; We might want to extend this to limit all the different that things may be
-;; placed on a stack.
-(def max-stack-items 100)
-
-
-
-;; =============================================================================
-;; Values used by the Push instructions to keep computed values within
-;; reasonable size limits.
-;; =============================================================================
-
-;; Used by keep-number-reasonable as the maximum magnitude of any integer/float
-(def max-number-magnitude 1.0E6)
-
-;; Used by keep-number-reasonable as the minimum magnitude of any float
-(def min-number-magnitude 1.0E-6)
-
-;; Used by reasonable-string-length? to ensure that strings don't get too large
-(def max-string-length 1000)
-
-;; Used by keep-vector-reasonable to ensure that vectors don't get too large
-(def max-vector-length 1000)

src/propeller/push/utils/helpers.cljc

@@ -2,63 +2,10 @@
   (:require [clojure.set]
             [propeller.push.core :as push]
             [propeller.push.state :as state]
-            [propeller.push.utils.globals :as globals]
+            [propeller.utils :as u]
             #?(:cljs [goog.string :as gstring])
             #?(:cljs [goog.string.format])))
 
-;; Returns a version of the number n that is within reasonable size bounds
-(defn keep-number-reasonable
-  [n]
-  (cond
-    (integer? n)
-    (cond
-      (> n globals/max-number-magnitude) (long globals/max-number-magnitude)
-      (< n (- globals/max-number-magnitude)) (long (- globals/max-number-magnitude))
-      :else n)
-    :else
-    (cond
-      (#?(:clj Double/isNaN
-          :cljs js/isNaN) n) 0.0
-      (or (= n #?(:clj Double/POSITIVE_INFINITY
-                  :cljs js/Infinity))
-          (> n globals/max-number-magnitude)) globals/max-number-magnitude
-      (or (= n #?(:clj Double/NEGATIVE_INFINITY
-                  :cljs js/-Infinity))
-          (< n (- globals/max-number-magnitude))) (- globals/max-number-magnitude)
-      (< (- globals/min-number-magnitude) n globals/min-number-magnitude) 0.0
-      :else n)))
-
-;; Returns true if the string is of a reasonable size
-(defn reasonable-string-length?
-  [string]
-  (let [length (count string)]
-    (<= length globals/max-string-length)))
-
-;; Returns true if the vector is of a reasonable size
-(defn reasonable-vector-length?
-  [vector]
-  (let [length (count vector)]
-    (<= length globals/max-vector-length)))
-
-;; Takes a state and a collection of stacks to take args from. If there are
-;; enough args on each of the desired stacks, returns a map with keys
-;; {:state :args}, where :state is the new state and :args is a list of args
-;; popped from the stacks. If there aren't enough args on the stacks, returns
-;; :not-enough-args without popping anything
-(defn get-args-from-stacks
-  [state stacks]
-  (loop [state state
-         stacks (reverse stacks)
-         args '()]
-    (if (empty? stacks)
-      {:state state :args args}
-      (let [current-stack (first stacks)]
-        (if (state/empty-stack? state current-stack)
-          :not-enough-args
-          (recur (state/pop-stack state current-stack)
-                 (rest stacks)
-                 (conj args (state/peek-stack state current-stack))))))))
-
 ;; A utility function for making Push instructions. Takes a state, a function
 ;; to apply to the args, the stacks to take the args from, and the stack to
 ;; return the result to. Applies the function to the args (popped from the
@@ -69,27 +16,13 @@
 ;; without consuming stack values.
 (defn make-instruction
   [state function arg-stacks return-stack]
-  (let [popped-args (get-args-from-stacks state arg-stacks)]
+  (let [popped-args (state/get-args-from-stacks state arg-stacks)]
     (if (= popped-args :not-enough-args)
       state
       (let [result (apply function (:args popped-args))
             new-state (:state popped-args)]
-        (cond
+        (if (= result :ignore-instruction)
-          (number? result)
-          (state/push-to-stack new-state return-stack (keep-number-reasonable result))
-          ;;
-          (and (string? result)
-               (not (reasonable-string-length? result)))
           state
-          ;;
-          (and (vector? result)
-               (not (reasonable-vector-length? result)))
-          state
-          ;;
-          (= result :ignore-instruction)
-          state
-          ;;
-          :else
           (state/push-to-stack new-state return-stack result))))))
 
 ;; Given a set of stacks, returns all instructions that operate on those stacks
@@ -99,9 +32,9 @@
   (doseq [[instruction-name function] @push/instruction-table]
     (assert
       (:stacks (meta function))
-      #?(:clj (format
+      #?(:clj  (format
-                "ERROR: Instruction %s does not have :stacks defined in metadata."
+                 "ERROR: Instruction %s does not have :stacks defined in metadata."
-                (name instruction-name))
+                 (name instruction-name))
          :cljs (gstring/format
                  "ERROR: Instruction %s does not have :stacks defined in metadata."
                  (name instruction-name)))))
@@ -109,39 +42,45 @@
         :when (clojure.set/subset? (:stacks (meta function)) stacks)]
     instruction-name))
 
-;; If a piece of data is a literal, return its corresponding stack name, e.g.
+
-;; :integer. Otherwise, return nil"
+#?(:clj
+   (def cls->type
+     {Boolean    :boolean
+      Short      :integer
+      Integer    :integer
+      Long       :integer
+      BigInteger :integer
+      Double     :float
+      BigDecimal :float
+      Float      :float
+      Character  :char
+      String     :string}))
+
+#?(:cljs
+   (def pred->type
+     [[boolean? :boolean]
+      [int? :integer]
+      [float? :float]
+      [string? :string]
+      [char? :char]]))
+
 (defn get-literal-type
+  "If a piece of data is a literal, return its corresponding stack name
+   e.g. `:integer`. Otherwise, return `nil`."
   [data]
-  (let [literals [[:boolean        (fn [thing] (or (true? thing) (false? thing)))]
+  (or (when (vector? data)
-                  [:integer        integer?]
+        (if (empty? data)
-                  [:float          float?]
+          :generic-vector
-                  [:string         string?]
+          (keyword (str "vector_" (name (get-literal-type (u/first-non-nil data)))))))
-                  [:char           char?]
+      #?(:clj  (cls->type (type data))
-                  [:vector_boolean (fn [thing] (and (vector? thing)
+         :cljs (loop [remaining pred->type]
-                                                   (or (true? (first thing))
+                 (let [[pred d-type] (first remaining)]
-                                                       (false? (first thing)))))]
+                   (cond
-                  [:vector_float   (fn [thing] (and (vector? thing)
+                     (empty? remaining) nil
-                                                   (float? (first thing))))]
+                     (pred data) d-type
-                  [:vector_integer (fn [thing] (and (vector? thing)
+                     :else (recur (rest remaining))))))))
-                                                   (integer? (first thing))))]
-                  [:vector_string  (fn [thing] (and (vector? thing)
-                                                   (string? (first thing))))]
-                  [:generic-vector (fn [thing] (= [] thing))]]]
-    (first (for [[stack function] literals
-                 :when (function data)]
-             stack))))
 
 (defn get-vector-literal-type
   "Returns the literal stack corresponding to some vector stack."
   [vector-stack]
   (get state/vec-stacks vector-stack))
-
-;; Pretty-print a Push state, for logging or debugging purposes
-(defn print-state
-  [state]
-  (doseq [stack (keys state/empty-state)]
-    #?(:clj (printf "%-15s = " stack)
-       :cljs (print (gstring/format "%-15s = " stack)))
-    (prn (if (get state stack) (get state stack) '()))
-    (flush)))

src/propeller/push/utils/limits.cljc

@@ -0,0 +1,72 @@
+(ns propeller.push.utils.limits
+  (:require [propeller.utils :as u]))
+
+;; =============================================================================
+;; Values used by the Push instructions to keep the stack sizes within
+;; reasonable limits.
+;; =============================================================================
+
+;; Limits the number of items that can be duplicated onto a stack at once.
+;; We might want to extend this to limit all the different that things may be
+;; placed on a stack.
+(def max-stack-items 100)
+
+;; =============================================================================
+;; Values used by the Push instructions to keep computed values within
+;; reasonable size limits.
+;; =============================================================================
+
+;; Used as the maximum magnitude of any integer/float
+(def max-number-magnitude 1.0E6)
+
+;; Used as the minimum magnitude of any float
+(def min-number-magnitude 1.0E-6)
+
+;; Used to ensure that strings don't get too large
+(def max-string-length 1000)
+
+;; Used to ensure that vectors don't get too large
+(def max-vector-length 1000)
+
+;; Used to ensure that total
+;; Set as dynamic for testing purposes.
+(def ^:dynamic max-code-points 100)
+
+;; Used to ensure that the depth of nesting for Push expressions doesn't get too deep.
+;; Set as dynamic for testing purposes.
+(def ^:dynamic max-code-depth 200)
+
+;; Returns a version of the number n that is within reasonable size bounds
+(defn limit-number
+  [n]
+  (if (int? n)
+    (cond
+      (> n max-number-magnitude) (long max-number-magnitude)
+      (< n (- max-number-magnitude)) (long (- max-number-magnitude))
+      :else n)
+    (cond
+      (#?(:clj Double/isNaN
+          :cljs js/isNaN) n) 0.0
+      (or (= n #?(:clj Double/POSITIVE_INFINITY
+                  :cljs js/Infinity))
+          (> n max-number-magnitude)) max-number-magnitude
+      (or (= n #?(:clj Double/NEGATIVE_INFINITY
+                  :cljs js/-Infinity))
+          (< n (- max-number-magnitude))) (- max-number-magnitude)
+      (< (- min-number-magnitude) n min-number-magnitude) 0.0
+      :else n)))
+
+(defn limit-string
+  [s]
+  (apply str (take max-string-length s)))
+
+(defn limit-vector
+  [v]
+  (vec (take max-vector-length v)))
+
+(defn limit-code
+  [code]
+  (if (or (> (u/count-points code) max-code-points)
+          (> (u/depth code) max-code-depth))
+    '() ;; Code that exceeds the limit is discarded.
+    code))

src/propeller/utils.cljc

@@ -1,4 +1,11 @@
-(ns propeller.utils)
+(ns propeller.utils
+  (:require [clojure.zip :as zip]))
+
+(defn first-non-nil
+  "Returns the first non-nil values from the collection, or returns `nil` if
+  the collection is empty or only contains `nil`."
+  [coll]
+  (first (filter some? coll)))
 
 (defn indexof
   "Returns the first index of an element in a collection. If the element is not
@@ -29,3 +36,51 @@
     (if (fn? instruction)
       (instruction)
       instruction)))
+
+
+(defn count-points
+  "Returns the number of points in tree, where each atom and each pair of parentheses
+   counts as a point."
+  [tree]
+  (loop [remaining tree
+         total 0]
+    (cond (not (seq? remaining))
+          (inc total)
+          ;;
+          (empty? remaining)
+          (inc total)
+          ;;
+          (not (seq? (first remaining)))
+          (recur (rest remaining)
+                 (inc total))
+          ;;
+          :else
+          (recur (concat (first remaining)
+                         (rest remaining))
+                 (inc total)))))
+
+(defn seq-zip
+  "Returns a zipper for nested sequences, given a root sequence"
+  {:added "1.0"}
+  [root]
+  (zip/zipper seq?
+              seq
+              (fn [node children] (with-meta children (meta node)))
+              root))
+
+(defn depth
+  "Returns the height of the nested list called tree.
+  Borrowed idea from here: https://stackoverflow.com/a/36865180/2023312
+  Works by looking at the path from each node in the tree to the root, and
+  finding the longest one.
+  Note: does not treat an empty list as having any height."
+  [tree]
+  (loop [zipper (seq-zip tree)
+         height 0]
+    (if (zip/end? zipper)
+      height
+      (recur (zip/next zipper)
+             (-> zipper
+                 zip/path
+                 count
+                 (max height))))))

test/propeller/push/state_test.cljc

@@ -0,0 +1,14 @@
+(ns propeller.push.state-test
+  (:require [clojure.test :as t]
+            [propeller.push.state :as state]
+            [propeller.push.utils.limits :as l]))
+
+(t/deftest push-to-stack-test
+  (t/is (= (state/push-to-stack {:integer '()} :integer 1)
+           {:integer '(1)}))
+  (t/is (= (state/push-to-stack {:integer '()} :integer 1e100)
+           {:integer (list (long l/max-number-magnitude))})))
+
+(t/deftest push-to-stack-many-test
+  (t/is (= (state/push-to-stack-many {:string '()} :string ["a" "b" "c"])
+           {:string '("a" "b" "c")})))

test/propeller/push/utils/helpers_test.cljc

@@ -0,0 +1,9 @@
+(ns propeller.push.utils.helpers-test
+  (:require [clojure.test :as t]
+            [propeller.push.utils.helpers :as h]))
+
+(t/deftest get-literal-type-test
+  (t/is (= (h/get-literal-type "abc") :string))
+  (t/is (= (h/get-literal-type [1]) :vector_integer))
+  (t/is (= (h/get-literal-type false) :boolean))
+  (t/is (= (h/get-literal-type 0.0) #?(:clj :float :cljs :integer))))

test/propeller/push/utils/limits_test.cljc

@@ -0,0 +1,29 @@
+(ns propeller.push.utils.limits-test
+  (:require [clojure.test :as t]
+            [propeller.push.utils.limits :as l]))
+
+(t/deftest limit-number-test
+  (t/is (= (l/limit-number (inc l/max-number-magnitude))
+           l/max-number-magnitude))
+  (t/is (l/limit-number 1.0E-10)
+        l/min-number-magnitude))
+
+(t/deftest limit-string-test
+  (t/is (= (l/limit-string (apply str (repeat (inc l/max-string-length) "!")))
+           (apply str (repeat l/max-string-length "!")))))
+
+(t/deftest limit-vector-test
+  (t/is (= (l/limit-vector (vec (repeat (inc l/max-vector-length) true)))
+           (vec (repeat l/max-vector-length true)))))
+
+(t/deftest limit-code-test
+  (binding [l/max-code-points 8]
+    (t/is (= (l/limit-code '(:a (:b (:c) :d :e :f) :g :h))
+             '()))
+    (t/is (= (l/limit-code '(:a :b :c))
+             '(:a :b :c))))
+  (binding [l/max-code-depth 2]
+    (t/is (= (l/limit-code '(:a (:b (:c) :d :e :f) :g :h))
+             '()))
+    (t/is (= (l/limit-code '(:a :b :c))
+             '(:a :b :c)))))

test/propeller/utils_test.cljc

@@ -0,0 +1,8 @@
+(ns propeller.utils-test
+  (:require [clojure.test :as t]
+            [propeller.utils :as u]))
+
+(t/deftest count-points-test
+  (t/is (= 6 (u/count-points '(:a :b (:c :d)))))
+  (t/is (= 1 (u/count-points '())))
+  (t/is (= 2 (u/count-points '(:a)))))