Redesigns limits
This commit is contained in:
erp12
parent
bdf278af8f
commit
3a0e9560c5
@ -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)))
|
||||
|
||||
@ -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)))
|
||||
|
||||
@ -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)
|
||||
@ -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
|
||||
@ -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)))
|
||||
|
||||
72
src/propeller/push/utils/limits.cljc
Normal file
72
src/propeller/push/utils/limits.cljc
Normal file
@ -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))
|
||||
@ -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))))))
|
||||
|
||||
14
test/propeller/push/state_test.cljc
Normal file
14
test/propeller/push/state_test.cljc
Normal file
@ -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")})))
|
||||
9
test/propeller/push/utils/helpers_test.cljc
Normal file
9
test/propeller/push/utils/helpers_test.cljc
Normal file
@ -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))))
|
||||
29
test/propeller/push/utils/limits_test.cljc
Normal file
29
test/propeller/push/utils/limits_test.cljc
Normal file
@ -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)))))
|
||||
8
test/propeller/utils_test.cljc
Normal file
8
test/propeller/utils_test.cljc
Normal file
@ -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)))))
|
||||
Loading…
x
Reference in New Issue
Block a user