From 3a0e9560c5a50c999baa755b7b13d7caf9899870 Mon Sep 17 00:00:00 2001 From: erp12 Date: Mon, 4 Oct 2021 11:52:48 -0400 Subject: [PATCH] Redesigns limits --- .../push/instructions/polymorphic.cljc | 8 +- src/propeller/push/state.cljc | 55 ++++++- src/propeller/push/utils/globals.cljc | 30 ---- src/propeller/push/utils/helpers.cljc | 143 +++++------------- src/propeller/push/utils/limits.cljc | 72 +++++++++ src/propeller/utils.cljc | 57 ++++++- test/propeller/push/state_test.cljc | 14 ++ test/propeller/push/utils/helpers_test.cljc | 9 ++ test/propeller/push/utils/limits_test.cljc | 29 ++++ test/propeller/utils_test.cljc | 8 + 10 files changed, 283 insertions(+), 142 deletions(-) delete mode 100644 src/propeller/push/utils/globals.cljc create mode 100644 src/propeller/push/utils/limits.cljc create mode 100644 test/propeller/push/state_test.cljc create mode 100644 test/propeller/push/utils/helpers_test.cljc create mode 100644 test/propeller/push/utils/limits_test.cljc create mode 100644 test/propeller/utils_test.cljc diff --git a/src/propeller/push/instructions/polymorphic.cljc b/src/propeller/push/instructions/polymorphic.cljc index 100992f..4635cc4 100755 --- a/src/propeller/push/instructions/polymorphic.cljc +++ b/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))) diff --git a/src/propeller/push/state.cljc b/src/propeller/push/state.cljc index 647509c..921e2eb 100755 --- a/src/propeller/push/state.cljc +++ b/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)] - (update state stack into (reverse items-no-nil)))) + items-no-nil (filter #(not (nil? %)) items) + 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))) diff --git a/src/propeller/push/utils/globals.cljc b/src/propeller/push/utils/globals.cljc deleted file mode 100644 index 93477e2..0000000 --- a/src/propeller/push/utils/globals.cljc +++ /dev/null @@ -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) \ No newline at end of file diff --git a/src/propeller/push/utils/helpers.cljc b/src/propeller/push/utils/helpers.cljc index 55ae2e6..8de76be 100755 --- a/src/propeller/push/utils/helpers.cljc +++ b/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 - (number? result) - (state/push-to-stack new-state return-stack (keep-number-reasonable result)) - ;; - (and (string? result) - (not (reasonable-string-length? result))) + (if (= result :ignore-instruction) 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 - "ERROR: Instruction %s does not have :stacks defined in metadata." - (name instruction-name)) + #?(:clj (format + "ERROR: Instruction %s does not have :stacks defined in metadata." + (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)))] - [:integer integer?] - [:float float?] - [:string string?] - [:char char?] - [:vector_boolean (fn [thing] (and (vector? thing) - (or (true? (first thing)) - (false? (first thing)))))] - [:vector_float (fn [thing] (and (vector? thing) - (float? (first thing))))] - [:vector_integer (fn [thing] (and (vector? thing) - (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)))) + (or (when (vector? data) + (if (empty? data) + :generic-vector + (keyword (str "vector_" (name (get-literal-type (u/first-non-nil data))))))) + #?(:clj (cls->type (type data)) + :cljs (loop [remaining pred->type] + (let [[pred d-type] (first remaining)] + (cond + (empty? remaining) nil + (pred data) d-type + :else (recur (rest remaining)))))))) (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))) diff --git a/src/propeller/push/utils/limits.cljc b/src/propeller/push/utils/limits.cljc new file mode 100644 index 0000000..1e4c7c4 --- /dev/null +++ b/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)) diff --git a/src/propeller/utils.cljc b/src/propeller/utils.cljc index 4e378a9..5f0b231 100755 --- a/src/propeller/utils.cljc +++ b/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)))))) diff --git a/test/propeller/push/state_test.cljc b/test/propeller/push/state_test.cljc new file mode 100644 index 0000000..7d1fdc5 --- /dev/null +++ b/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")}))) diff --git a/test/propeller/push/utils/helpers_test.cljc b/test/propeller/push/utils/helpers_test.cljc new file mode 100644 index 0000000..097a4d6 --- /dev/null +++ b/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)))) diff --git a/test/propeller/push/utils/limits_test.cljc b/test/propeller/push/utils/limits_test.cljc new file mode 100644 index 0000000..99cacce --- /dev/null +++ b/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))))) diff --git a/test/propeller/utils_test.cljc b/test/propeller/utils_test.cljc new file mode 100644 index 0000000..e952249 --- /dev/null +++ b/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)))))