Add string instructions

This commit is contained in:
mcgirjau 2020-07-13 21:24:43 -04:00
parent 3e820407f3
commit 3f5c2fd8a7
10 changed files with 326 additions and 66 deletions

View File

@ -7,7 +7,6 @@
[propeller.push.instructions.code] [propeller.push.instructions.code]
[propeller.push.instructions.input-output] [propeller.push.instructions.input-output]
[propeller.push.instructions.numeric] [propeller.push.instructions.numeric]
[propeller.push.instructions.random]
[propeller.push.instructions.polymorphic] [propeller.push.instructions.polymorphic]
[propeller.push.instructions.string] [propeller.push.instructions.string]
[propeller.push.instructions.vector])) [propeller.push.instructions.vector]))
@ -23,7 +22,7 @@
(print "Best program: ") (prn (genome/plushy->push (:plushy best))) (print "Best program: ") (prn (genome/plushy->push (:plushy best)))
(println "Best total error:" (:total-error best)) (println "Best total error:" (:total-error best))
(println "Best errors:" (:errors best)) (println "Best errors:" (:errors best))
(println "Best behaviors:" (map clojure.string/trim (:behaviors best))) (println "Best behaviors:" (:behaviors best))
(println "Genotypic diversity:" (println "Genotypic diversity:"
(float (/ (count (distinct (map :plushy pop))) (count pop)))) (float (/ (count (distinct (map :plushy pop))) (count pop))))
(println "Average genome length:" (println "Average genome length:"
@ -60,7 +59,9 @@
(println "Test cases failed.")) (println "Test cases failed."))
(#?(:clj shutdown-agents))) (#?(:clj shutdown-agents)))
;; ;;
(>= generation max-generations) nil (>= generation max-generations)
nil
;;
:else (recur (inc generation) :else (recur (inc generation)
(if (:elitism argmap) (if (:elitism argmap)
(conj (repeatedly (dec population-size) (conj (repeatedly (dec population-size)

View File

@ -76,13 +76,15 @@
(:step-limit argmap)) (:step-limit argmap))
:output)) :output))
inputs) inputs)
parsed-outputs (map (fn [output]
(try (read-string output)
(catch Exception e 1000.0)))
outputs)
errors (map (fn [correct-output output] errors (map (fn [correct-output output]
(let [parsed-output (try (read-string output) (min 1000.0 (math/abs (- correct-output output))))
(catch Exception e 1000.0))]
(min 1000.0 (math/abs (- correct-output parsed-output)))))
correct-outputs correct-outputs
outputs)] parsed-outputs)]
(assoc individual (assoc individual
:behaviors outputs :behaviors parsed-outputs
:errors errors :errors errors
:total-error (apply +' errors))))) :total-error (apply +' errors)))))

View File

@ -55,14 +55,14 @@
;; Pushes FALSE if the top FLOAT is 0.0, and TRUE otherwise ;; Pushes FALSE if the top FLOAT is 0.0, and TRUE otherwise
(def-instruction (def-instruction
:boolean_fromfloat :boolean_from_float
^{:stacks #{:boolean :float}} ^{:stacks #{:boolean :float}}
(fn [state] (fn [state]
(make-instruction state #(not (zero? %)) [:float] :boolean))) (make-instruction state #(not (zero? %)) [:float] :boolean)))
;; Pushes FALSE if the top INTEGER is 0, and TRUE otherwise ;; Pushes FALSE if the top INTEGER is 0, and TRUE otherwise
(def-instruction (def-instruction
:boolean_frominteger :boolean_from_integer
^{:stacks #{:boolean :integer}} ^{:stacks #{:boolean :integer}}
(fn [state] (fn [state]
(make-instruction state #(not (zero? %)) [:integer] :boolean))) (make-instruction state #(not (zero? %)) [:integer] :boolean)))

View File

@ -11,14 +11,14 @@
;; Pushes TRUE onto the BOOLEAN stack if the popped character is a letter ;; Pushes TRUE onto the BOOLEAN stack if the popped character is a letter
(def-instruction (def-instruction
:char_isletter :char_is_letter
^{:stacks #{:boolean :char}} ^{:stacks #{:boolean :char}}
(fn [state] (fn [state]
(make-instruction state char/is-letter [:char] :boolean))) (make-instruction state char/is-letter [:char] :boolean)))
;; Pushes TRUE onto the BOOLEAN stack if the popped character is a digit ;; Pushes TRUE onto the BOOLEAN stack if the popped character is a digit
(def-instruction (def-instruction
:char_isdigit :char_is_digit
^{:stacks #{:boolean :char}} ^{:stacks #{:boolean :char}}
(fn [state] (fn [state]
(make-instruction state char/is-digit [:char] :boolean))) (make-instruction state char/is-digit [:char] :boolean)))
@ -26,7 +26,7 @@
;; Pushes TRUE onto the BOOLEAN stack if the popped character is whitespace ;; Pushes TRUE onto the BOOLEAN stack if the popped character is whitespace
;; (newline, space, or tab) ;; (newline, space, or tab)
(def-instruction (def-instruction
:char_iswhitespace :char_is_whitespace
^{:stacks #{:boolean :char}} ^{:stacks #{:boolean :char}}
(fn [state] (fn [state]
(make-instruction state char/is-whitespace [:char] :boolean))) (make-instruction state char/is-whitespace [:char] :boolean)))
@ -36,7 +36,7 @@
;; 128 will be reduced modulo 128. For instance, 248.45 will result in x being ;; 128 will be reduced modulo 128. For instance, 248.45 will result in x being
;; pushed. ;; pushed.
(def-instruction (def-instruction
:char_fromfloat :char_from_float
^{:stacks #{:char :float}} ^{:stacks #{:char :float}}
(fn [state] (fn [state]
(make-instruction state #(char (mod (long %) 128)) [:float] :char))) (make-instruction state #(char (mod (long %) 128)) [:float] :char)))
@ -45,7 +45,7 @@
;; value onto the CHAR stack. Integers larger than 128 will be reduced modulo ;; value onto the CHAR stack. Integers larger than 128 will be reduced modulo
;; 128. For instance, 248 will result in x being pushed ;; 128. For instance, 248 will result in x being pushed
(def-instruction (def-instruction
:char_frominteger :char_from_integer
^{:stacks #{:char :integer}} ^{:stacks #{:char :integer}}
(fn [state] (fn [state]
(make-instruction state #(char (mod % 128)) [:integer] :char))) (make-instruction state #(char (mod % 128)) [:integer] :char)))
@ -54,7 +54,7 @@
;; onto the CHAR stack, in order. For instance, "hello" will result in the ;; onto the CHAR stack, in order. For instance, "hello" will result in the
;; top of the CHAR stack being \h \e \l \l \o ;; top of the CHAR stack being \h \e \l \l \o
(def-instruction (def-instruction
:char_allfromstring :char_all_from_string
^{:stacks #{:char :string}} ^{:stacks #{:char :string}}
(fn [state] (fn [state]
(if (state/empty-stack? state :string) (if (state/empty-stack? state :string)

View File

@ -5,16 +5,6 @@
[propeller.push.utils.macros :refer [def-instruction [propeller.push.utils.macros :refer [def-instruction
generate-instructions]])) generate-instructions]]))
;; =============================================================================
;; Polymorphic Instructions
;; =============================================================================
(def _noop
^{:stacks #{}}
(fn [stack state] state))
(generate-instructions [:exec :code] [_noop])
;; ============================================================================= ;; =============================================================================
;; CODE Instructions ;; CODE Instructions
;; ============================================================================= ;; =============================================================================
@ -46,7 +36,7 @@
;; is pushed onto the EXEC stack for subsequent execution. If the integers are ;; is pushed onto the EXEC stack for subsequent execution. If the integers are
;; not equal, then the current index will still be pushed onto the INTEGER stack ;; not equal, then the current index will still be pushed onto the INTEGER stack
;; but two items will be pushed onto the EXEC stack - first a recursive call to ;; but two items will be pushed onto the EXEC stack - first a recursive call to
;; :exec_do*range (with the same code and destination index, but with a current ;; :exec_do_range (with the same code and destination index, but with a current
;; index that has been either incremented or decremented by 1 to be closer to ;; index that has been either incremented or decremented by 1 to be closer to
;; the destination index) and then the body code. Note that the range is ;; the destination index) and then the body code. Note that the range is
;; inclusive of both endpoints; a call with integer arguments 3 and 5 will cause ;; inclusive of both endpoints; a call with integer arguments 3 and 5 will cause
@ -54,7 +44,7 @@
;; 4, and 5. Note also that one can specify a loop that "counts down" by ;; 4, and 5. Note also that one can specify a loop that "counts down" by
;; providing a destination index that is less than the specified current index. ;; providing a destination index that is less than the specified current index.
(def-instruction (def-instruction
:exec_do*range :exec_do_range
^{:stacks #{:exec :integer}} ^{:stacks #{:exec :integer}}
(fn [state] (fn [state]
(if (or (state/empty-stack? state :exec) (if (or (state/empty-stack? state :exec)
@ -76,7 +66,7 @@
:exec :exec
(list (+' current-index increment) (list (+' current-index increment)
destination-index destination-index
:exec_do*range :exec_do_range
to-do)))] to-do)))]
(state/push-to-stack (state/push-to-stack
(state/push-to-stack continuation :integer current-index) :exec to-do))))) (state/push-to-stack continuation :integer current-index) :exec to-do)))))
@ -86,7 +76,7 @@
;; total number of iterations) onto the INTEGER stack prior to each execution ;; total number of iterations) onto the INTEGER stack prior to each execution
;; of the loop body. If the top INTEGER argument is <= 0, this becomes a NOOP ;; of the loop body. If the top INTEGER argument is <= 0, this becomes a NOOP
(def-instruction (def-instruction
:exec_do*count :exec_do_count
^{:stacks #{:exec :integer}} ^{:stacks #{:exec :integer}}
(fn [state] (fn [state]
(if (or (state/empty-stack? state :integer) (if (or (state/empty-stack? state :integer)
@ -98,12 +88,12 @@
popped-state (state/pop-stack (state/pop-stack state :exec) :integer)] popped-state (state/pop-stack (state/pop-stack state :exec) :integer)]
(state/push-to-stack popped-state :exec (list 0 (state/push-to-stack popped-state :exec (list 0
(dec index) (dec index)
:exec_do*range :exec_do_range
to-do)))))) to-do))))))
;; Like :exec_do*count, but does not push the loop counter onto the INTEGER stack ;; Like :exec_do_count, but does not push the loop counter onto the INTEGER stack
(def-instruction (def-instruction
:exec_do*times :exec_do_times
^{:stacks #{:exec :integer}} ^{:stacks #{:exec :integer}}
(fn [state] (fn [state]
(if (or (state/empty-stack? state :integer) (if (or (state/empty-stack? state :integer)
@ -116,7 +106,7 @@
popped-state (state/pop-stack (state/pop-stack state :exec) :integer)] popped-state (state/pop-stack (state/pop-stack state :exec) :integer)]
(state/push-to-stack popped-state :exec (list 0 (state/push-to-stack popped-state :exec (list 0
(dec index) (dec index)
:exec_do*range :exec_do_range
to-do-with-pop)))))) to-do-with-pop))))))
;; If the top BOOLEAN is TRUE, removes the the second item on the EXEC stack, ;; If the top BOOLEAN is TRUE, removes the the second item on the EXEC stack,
@ -159,7 +149,7 @@
;; the BOOLEAN stack is true. Differs from :exec_while in that it executes ;; the BOOLEAN stack is true. Differs from :exec_while in that it executes
;; the top instruction at least once ;; the top instruction at least once
(def-instruction (def-instruction
:exec_do*while :exec_do_while
^{:stacks #{:boolean :exec}} ^{:stacks #{:boolean :exec}}
(fn [state] (fn [state]
(if (state/empty-stack? state :exec) (if (state/empty-stack? state :exec)

View File

@ -84,7 +84,7 @@
(make-instruction state min [stack stack] stack))) (make-instruction state min [stack stack] stack)))
;; Pushes 1 / 1.0 if the top BOOLEAN is TRUE, or 0 / 0.0 if FALSE ;; Pushes 1 / 1.0 if the top BOOLEAN is TRUE, or 0 / 0.0 if FALSE
(def _fromboolean (def _from_boolean
^{:stacks #{:boolean}} ^{:stacks #{:boolean}}
(fn [stack state] (fn [stack state]
(make-instruction state (make-instruction state
@ -93,14 +93,14 @@
stack))) stack)))
;; Pushes the ASCII value of the top CHAR ;; Pushes the ASCII value of the top CHAR
(def _fromchar (def _from_char
^{:stacks #{:char}} ^{:stacks #{:char}}
(fn [stack state] (fn [stack state]
(make-instruction state (if (= stack :integer) int float) [:char] stack))) (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. ;; Pushes the value of the top STRING, if it can be parsed as a number.
;; Otherwise, acts as a NOOP ;; Otherwise, acts as a NOOP
(def _fromstring (def _from_string
^{:stacks #{:string}} ^{:stacks #{:string}}
(fn [stack state] (fn [stack state]
(make-instruction state (make-instruction state
@ -125,7 +125,7 @@
(generate-instructions (generate-instructions
[:float :integer] [:float :integer]
[_gt _gte _lt _lte _add _subtract _mult _quot _mod _max _min _inc _dec [_gt _gte _lt _lte _add _subtract _mult _quot _mod _max _min _inc _dec
_fromboolean _fromchar _fromstring]) _from_boolean _from_char _from_string])
;; ============================================================================= ;; =============================================================================
;; FLOAT Instructions only ;; FLOAT Instructions only
@ -154,7 +154,7 @@
;; Pushes the floating point version of the top INTEGER ;; Pushes the floating point version of the top INTEGER
(def-instruction (def-instruction
:float_frominteger :float_from_integer
^{:stacks #{:float :integer}} ^{:stacks #{:float :integer}}
(fn [state] (fn [state]
(make-instruction state float [:integer] :float))) (make-instruction state float [:integer] :float)))
@ -165,7 +165,7 @@
;; Pushes the result of truncating the top FLOAT towards negative infinity ;; Pushes the result of truncating the top FLOAT towards negative infinity
(def-instruction (def-instruction
:integer_fromfloat :integer_from_float
^{:stacks #{:float :integer}} ^{:stacks #{:float :integer}}
(fn [state] (fn [state]
(make-instruction state int [:float] :integer))) (make-instruction state int [:float] :integer)))

View File

@ -26,7 +26,7 @@
;; number n is determined by the top INTEGER. For n = 0, equivalent to POP. ;; number n is determined by the top INTEGER. For n = 0, equivalent to POP.
;; For n = 1, equivalent to NOOP. For n = 2, equivalent to DUP. Negative values ;; For n = 1, equivalent to NOOP. For n = 2, equivalent to DUP. Negative values
;; of n are treated as 0 ;; of n are treated as 0
(def _duptimes (def _dup_times
^{:stacks #{:integer}} ^{:stacks #{:integer}}
(fn [stack state] (fn [stack state]
(if (or (and (= stack :integer) (if (or (and (= stack :integer)
@ -46,7 +46,7 @@
;; Duplicates the top n items on the stack, one time each. The number n is ;; Duplicates the top n items on the stack, one time each. The number n is
;; determined by the top INTEGER. If n <= 0, no items will be duplicated. If ;; determined by the top INTEGER. If n <= 0, no items will be duplicated. If
;; fewer than n items are on the stack, the entire stack will be duplicated. ;; fewer than n items are on the stack, the entire stack will be duplicated.
(def _dupitems (def _dup_items
^{:stacks #{:integer}} ^{:stacks #{:integer}}
(fn [stack state] (fn [stack state]
(if (state/empty-stack? state :integer) (if (state/empty-stack? state :integer)
@ -114,7 +114,7 @@
state))) state)))
;; Pushes the given stack's depth onto the INTEGER stack ;; Pushes the given stack's depth onto the INTEGER stack
(def _stackdepth (def _stack_depth
^{:stacks #{:integer}} ^{:stacks #{:integer}}
(fn [stack state] (fn [stack state]
(let [stack-depth (count (get state stack))] (let [stack-depth (count (get state stack))]
@ -152,7 +152,7 @@
;; Pushes a copy of an indexed item from deep in the stack, without removing it. ;; 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 ;; The top INTEGER is used to determine how deep to yankdup from
(def _yankdup (def _yank_dup
^{:stacks #{:integer}} ^{:stacks #{:integer}}
(fn [stack state] (fn [stack state]
(if (or (and (= stack :integer) (if (or (and (= stack :integer)
@ -171,5 +171,5 @@
(generate-instructions (generate-instructions
[:boolean :char :code :exec :float :integer :string [:boolean :char :code :exec :float :integer :string
:vector_boolean :vector_float :vector_integer :vector_string] :vector_boolean :vector_float :vector_integer :vector_string]
[_dup _duptimes _dupitems _empty _eq _flush _pop _rot _shove [_dup _dup_times _dup_items _empty _eq _flush _pop _rot _shove
_stackdepth _swap _yank _yankdup]) _stack_depth _swap _yank _yank_dup])

View File

@ -1,7 +0,0 @@
(ns propeller.push.instructions.random
(:require [propeller.push.state :as state]
[propeller.push.utils.helpers :refer [make-instruction]]
[propeller.push.utils.macros :refer [def-instruction
generate-instructions]]))

View File

@ -1,47 +1,297 @@
(ns propeller.push.instructions.string (ns propeller.push.instructions.string
(:require [propeller.push.utils.helpers :refer [make-instruction]] (:require [clojure.string :as string]
[propeller.push.utils.macros :refer [def-instruction]])) [propeller.utils :as utils]
[propeller.push.utils.helpers :refer [make-instruction]]
[propeller.push.utils.macros :refer [def-instruction]]
[propeller.push.state :as state]))
;; ============================================================================= ;; =============================================================================
;; STRING Instructions ;; STRING Instructions
;; ============================================================================= ;; =============================================================================
;; Pushes the butlast of the top STRING (i.e. the string without its last letter)
(def-instruction (def-instruction
:string_= :string_butlast
^{:stacks #{:boolean :string}} ^{:stacks #{:string}}
(fn [state] (fn [state]
(make-instruction state = [:string :string] :boolean))) (make-instruction state #(apply str (butlast %)) [:string] :string)))
;; Pushes the concatenation of the top two STRINGs (second + first)
(def-instruction (def-instruction
:string_concat :string_concat
^{:stacks #{:string}} ^{:stacks #{:string}}
(fn [state] (fn [state]
(make-instruction state #(apply str (concat %1 %2)) [:string :string] :string))) (make-instruction state str [:string :string] :string)))
;; Pushes the concatenation of the top STRING and the top CHAR (STRING + CHAR)
(def-instruction
:string_conj_char
^{:stacks #{:char :string}}
(fn [state]
(make-instruction state str [:string :char] :string)))
;; Pushes TRUE if the top STRING is a substring of the second STRING, and FALSE
;; otherwise
(def-instruction
:string_contains
^{:stacks #{:boolean :string}}
(fn [state]
(make-instruction state string/includes? [:string :string] :boolean)))
;; Pushes TRUE if the top CHAR is contained in the top STRING, and FALSE
;; otherwise
(def-instruction
:string_contains_char
^{:stacks #{:boolean :char :string}}
(fn [state]
(make-instruction state #(string/includes? %2 (str %1)) [:char :string] :boolean)))
;; Pushes the top STRING with n characters dropped, where n is taken from the
;; top of the INTEGER stack
(def-instruction (def-instruction
:string_drop :string_drop
^{:stacks #{:integer :string}} ^{:stacks #{:integer :string}}
(fn [state] (fn [state]
(make-instruction state #(apply str (drop %1 %2)) [:integer :string] :string))) (make-instruction state #(apply str (drop %1 %2)) [:integer :string] :string)))
;; Pushes TRUE if the top STRING is the empty string
(def-instruction (def-instruction
:string_includes? :string_empty_string
^{:stacks #{:string}}
(fn [state]
(make-instruction state empty? [:string] :boolean)))
;; Pushes the first CHAR of the top STRING
(def-instruction
:string_first
^{:stacks #{:char :string}}
(fn [state]
(make-instruction state first [:string] :char)))
;; Pushes the STRING version of the top BOOLEAN, e.g. "true"
(def-instruction
:string_from_boolean
^{:stacks #{:boolean :string}} ^{:stacks #{:boolean :string}}
(fn [state] (fn [state]
(make-instruction state clojure.string/includes? [:string :string] :boolean))) (make-instruction state str [:boolean] :string)))
;; Pushes the STRING version of the top CHAR, e.g. "a"
(def-instruction
:string_from_char
^{:stacks #{:char :string}}
(fn [state]
(make-instruction state str [:char] :string)))
;; Pushes the STRING version of the top FLOAT e.g. "2.05"
(def-instruction
:string_from_float
^{:stacks #{:float :string}}
(fn [state]
(make-instruction state str [:float] :string)))
;; Pushes the STRING version of the top INTEGER, e.g. "3"
(def-instruction
:string_from_integer
^{:stacks #{:integer :string}}
(fn [state]
(make-instruction state str [:integer] :string)))
;; Pushes the index of the top CHAR in the top STRING onto the INTEGER stack.
;; If the top CHAR is not present in the top string, acts as a NOOP
(def-instruction
:string_indexof_char
^{:stacks #{:char :integer :string}}
(fn [state]
(make-instruction state string/index-of [:string :char] :integer)))
;; Iterates over the top STRING using code on the EXEC stack
(def-instruction
:string_iterate
^{:stacks #{:char :exec :string}}
(fn [state]
(if (or (empty? (:string state))
(empty? (:exec state)))
state
(let [top-item (state/peek-stack state :string)
popped-state (state/pop-stack state :string)]
(cond
(empty? top-item)
(state/pop-stack popped-state :exec)
;;
(empty? (rest top-item))
(state/push-to-stack popped-state :char (first top-item))
;;
:else
(-> popped-state
(state/push-to-stack :exec :string_iterate)
(state/push-to-stack :exec (apply str (rest top-item)))
(state/push-to-stack :exec (state/peek-stack state :exec))
(state/push-to-stack :char (first top-item))))))))
;; Pushes the last CHAR of the top STRING
(def-instruction
:string_last
^{:stacks #{:char :string}}
(fn [state]
(make-instruction state last [:string] :char)))
;; Pushes the length of the top STRING onto the INTEGER stack
(def-instruction (def-instruction
:string_length :string_length
^{:stacks #{:integer :string}} ^{:stacks #{:integer :string}}
(fn [state] (fn [state]
(make-instruction state count [:string] :integer))) (make-instruction state count [:string] :integer)))
;; Pushes the nth CHAR of the top STRING, where n is taken from the top of the
;; INTEGER stack. If n exceeds the length of the string, it is reduced modulo
;; the length of the string
(def-instruction
:string_nth
^{:stacks #{:char :integer :string}}
(fn [state]
(make-instruction state #(nth %2 (mod %1 (count %2))) [:integer :string] :char)))
;; Pushes the number of times the top CHAR occurs in the top STRING onto the
;; INTEGER stack
(def-instruction
:string_occurencesof_char
^{:stacks #{:char :integer :string}}
(fn [state]
(make-instruction state
(fn [char string]
(count (filter #(= char %) string)))
[:char :string]
:integer)))
;; Splits the top string into substrings of length 1 (i.e. into its component
;; characters) and pushes them back onto the STRING stack in the same order
(def-instruction
:string_parse_to_chars
^{:stacks #{:string}}
(fn [state]
(if (state/empty-stack? state :string)
state
(let [top-string (state/peek-stack state :string)
char-list (string/split top-string #"")
popped-state (state/pop-stack state :string)]
(state/push-to-stack-many popped-state :string char-list)))))
;; Pushes the top STRING, with all occurrences of the top CHAR removed
(def-instruction
:string_remove_char
^{:stacks #{:char :string}}
(fn [state]
(make-instruction state
(fn [char string]
(apply str (filter #(not= char %) string)))
[:char :string]
:string)))
;; Pushes the third topmost STRING on stack, with all occurences of the second
;; topmost STRING replaced by the top STRING
(def-instruction
:string_replace
^{:stacks #{:string}}
(fn [state]
(make-instruction state
#(string/replace %1 %2 %3)
[:string :string :string]
:string)))
;; Pushes the top STRING, with all occurences of the second topmost CHAR
;; replaced with the top CHAR
(def-instruction
:string_replace_char
^{:stacks #{:char :string}}
(fn [state]
(make-instruction state
#(string/replace %3 %1 %2)
[:char :char :string]
:string)))
;; Pushes the third topmost STRING on stack, with the first occurence of the
;; second topmost STRING replaced by the top STRING
(def-instruction
:string_replace_first
^{:stacks #{:string}}
(fn [state]
(make-instruction state
#(string/replace-first %1 %2 %3)
[:string :string :string]
:string)))
;; Pushes the top STRING, with the first occurence of the second topmost CHAR
;; replaced with the top CHAR
(def-instruction
:string_replace_first_char
^{:stacks #{:char :string}}
(fn [state]
(make-instruction state
#(string/replace-first %3 %1 %2)
[:char :char :string]
:string)))
;; Pushes the rest of the top STRING (i.e. the string without its first letter)
(def-instruction
:string_rest
^{:stacks #{:string}}
(fn [state]
(make-instruction state #(apply str (rest %)) [:string] :string)))
;; Pushes the reverse of the top STRING
(def-instruction (def-instruction
:string_reverse :string_reverse
^{:stacks #{:string}} ^{:stacks #{:string}}
(fn [state] (fn [state]
(make-instruction state #(apply str (reverse %)) [:string] :string))) (make-instruction state #(apply str (reverse %)) [:string] :string)))
;; Pushes the top STRING, with the letter at index n (where n is taken from the
;; INTEGER stack) replaced with the top CHAR. If n is out of bounds, it is
;; reduced modulo the length of the string
(def-instruction
:string_set_char
^{:stacks #{:char :integer :string}}
(fn [state]
(make-instruction state
#(let [index (mod %2 (count %3))
beginning (take index %3)
end (drop (inc index) %3)]
(apply str (concat beginning (list %1) end)))
[:char :integer :string]
:string)))
;; Splits the top STRING on whitespace, and pushes back the resulting components
;; in the same order
(def-instruction
:string_split
^{:stacks #{:string}}
(fn [state]
(if (state/empty-stack? state :string)
state
(let [top-item (state/peek-stack state :string)
top-item-trimmed (string/trim top-item)
string-list (string/split top-item-trimmed #"\s+")
popped-state (state/pop-stack state :string)]
(state/push-to-stack-many popped-state :string string-list)))))
;; Pushes the substring of the top STRING, with beginning and end indices
;; determined by the second topmost and topmost INTEGERs respectively. If an
;; index is out of bounds, the beginning/end of the string is used instead
(def-instruction
:string_substr
^{:stacks #{:integer :string}}
(fn [state]
(make-instruction state
(fn [start stop string]
(let [length (count string)
start (min length (max 0 start))
stop (min length (max start stop))]
(subs string start stop)))
[:integer :integer :string]
:string)))
;; Pushes the substring of the top STRING consisting of its first n letters,
;; where n is determined by the top INTEGER
(def-instruction (def-instruction
:string_take :string_take
^{:stacks #{:integer :string}} ^{:stacks #{:integer :string}}

View File

@ -64,6 +64,30 @@
(let [lit-stack (get-vector-literal-type stack)] (let [lit-stack (get-vector-literal-type stack)]
(make-instruction state #(utils/indexof %1 %2) [lit-stack stack] :integer)))) (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}}
(fn [stack state]
(let [lit-stack (get-vector-literal-type stack)]
(if (or (state/empty-stack? state :exec)
(state/empty-stack? state stack))
state
(let [vect (state/peek-stack state stack)
popped-state (state/pop-stack state stack)]
(cond
(empty? vect)
(state/pop-stack popped-state :exec)
;;
(empty? (rest vect))
(state/push-to-stack popped-state lit-stack (first vect))
;;
:else
(-> popped-state
(state/push-to-stack :exec (keyword (str (name stack) "_iterate")))
(state/push-to-stack :exec (vec (rest vect)))
(state/push-to-stack :exec (state/peek-stack state :exec))
(state/push-to-stack lit-stack (first vect)))))))))
;; Pushes the last item of the top element of the vector stack onto the ;; Pushes the last item of the top element of the vector stack onto the
;; approrpiately-typed literal stack ;; approrpiately-typed literal stack
(def _last (def _last
@ -195,9 +219,9 @@
(fn [stack state] (fn [stack state]
(make-instruction state #(vec (take %1 %2)) [:integer stack] stack))) (make-instruction state #(vec (take %1 %2)) [:integer stack] stack)))
;; 4 types x 20 functions = 80 instructions ;; 4 types x 21 functions = 84 instructions
(generate-instructions (generate-instructions
[:vector_boolean :vector_float :vector_integer :vector_string] [:vector_boolean :vector_float :vector_integer :vector_string]
[_butlast _concat _conj _contains _emptyvector _first _indexof _last [_butlast _concat _conj _contains _emptyvector _first _indexof _iterate
_length _nth _occurrencesof _pushall _remove _replace _replacefirst _last _length _nth _occurrencesof _pushall _remove _replace _replacefirst
_rest _reverse _set _subvec _take]) _rest _reverse _set _subvec _take])