;;; Pseudo-arrays

; An “array” is really just a sequence of elements on the stack followed by ; the number of elements, so care must be taken to ensure one knows what kind ; of data is currently being operated on.

import math ; divmod, max, min, pos? import stack ; bury, dig, ncopy, nslide, roll import util ; dec, die!, eq

$amax = 1000

; prints the array A to stdout in the form [e1,e2,…] ; [A] => [] aryprint:

map (:to_s) push ',' :strjoinc
push '[' ochr :print push ']' ochr ret

; places an array of N elements E at the top of the stack ; [N E] => [A] ; ; [3 0] => [0 0 0 3] ; [5 1] => [1 1 1 1 1 5] ; [4 -2] => [-2 -2 -2 -2 4] aryfill: push -1 copy 2 store swap _aryfill_loop:

copy 1 swap $-- dup push 1 :eq jz _aryfill_loop
push -1 mul load ret

; returns the sum of the array A ; [A] => [sum] ; ; [3 1] => [3] ; [4 3 2 1 4] => [10] ; [-10 -5 7 5 10 5] => [7] arysum: reduce (add) ret

; duplicates the array at the top of the stack ; [A] => [A A] ; ; [1 2 3 3] => [1 2 3 3 1 2 3 3] ; [7 50 10 2] => [7 50 10 2 50 10 2] arydup:

dup $++ push -2 copy 1 store
times (@-2 $-- :ncopy) ret

; returns 1 if the arrays A1 and A2 have the same length and ; contain the same elements in the same order, 0 otherwise ; [A1 A2] => [0 | 1] ; ; [1 2 3 3 1 2 3 3] => [1] ; [1 2 3 3 3 2 1 3] => [0] ; [1 2 2 1 2 3 3] => [0] ; [1 2 3 3 1 2 2] => [0] ; [7 10 2 7 10 2] => [1] ; [6 1 9 1] => [0] aryeq: dup $++ :roll copy 1 copy 1 :eq jz _aryeq_difflen ; length mismatch

^-1 times (@-1 :ncopy :eq jz _aryeq_no)
push 1 @-1 :nslide ret

_aryeq_no: push 0 @-1 @-5 sub $– :nslide ret ; ! -5 is magic from times() _aryeq_difflen: add push 0 swap :nslide ret

; places the element E at the end of the array A, increasing its length by 1 ; [A E] => [A'] ; ; [3 2 1 3 7] => [3 2 1 7 4] ; [4 2 2 0] => [4 2 0 3] ; [6 1 9] => [6 9 2] ; [7 5 8 2 4] => [7 5 8 4 3] arypush: swap $++ ret

; removes the element at the end of the array A, decreasing its length by 1 ; [A] => [A'] ; ; [10 1] => [0] ; [1 2 3 4 4] => [1 2 3 3] ; [7 10 20 30 3] => [7 10 20 2] arypop: slide 1 $– ret

; removes the element at the beginning of the array A, decreasing its length by 1 ; [A] => [A'] ; ; [10 1] => [0] ; [1 2 3 4 4] => [2 3 4 3] ; [7 10 20 30 3] => [7 20 30 2] aryshift: dup :dig $– ret

; places the element E at the beginning of the array A, increasing its length by 1 ; [A E] => [A'] ; ; [3 2 1 3 7] => [7 3 2 1 4] ; [4 2 0 3 9] => [9 4 2 0 4] ; [11 2 2 10] => [10 11 2 3] ; [7 2 8 2 0] => [7 0 2 8 3] aryunshift: swap dup times (dup $++ :roll swap) $++ ret

; inserts the element E into array A at index I, increasing its length by 1 ; [A I E] => [A'] ; ; [9 5 2 3 1 4] => [9 4 5 2 4] ; [1 1 0 7] => [7 1 2] ; [3 1 1 7] => [3 7 2] ; [7 5 2 1 6] => [7 6 5 3] aryinsert: swap copy 2 swap sub $++ :bury $++ ret

; removes the element at index I in array A, decreasing its length by 1 ; [A I] => [A'] ; ; [6 0 9 3 1] => [6 9 2] ; [7 5 3 1 4 0] => [5 3 1 3] ; [1 3 5 7 4 3] => [1 3 5 3] aryremove: copy 1 swap sub :roll pop $– ret

; returns the concatenation of arrays A and B ; [A B] => [A+B] ; ; [1 2 3 3 4 5 6 3] => [1 2 3 4 5 6 6] ; [7 10 2 5 4 3 3] => [7 10 5 4 3 5] arycat: dup $++ :roll add ret

;;;

arypack:

:arydup reduce (:max) $++ ^-1
$-- times (@-1 mul add)
push $amax mul @-1 add
push $amax mul @-10 add ret

aryunpack:

push $amax :divmod ^-2
push $amax :divmod ^-1
@-2 times (@-1 :divmod swap)
push 2 sub load ret

arylen: push $amax mod ret

; returns the index I of element E in array A (or -1 if not found) ; [A E] => [I] ; ; [1 2 3 4 4 2] => [1] ; [1 2 3 4 4 4] => [3] ; [1 2 3 4 4 5] => [-1] aryindex: copy 1 ; two copies of length, one gets decremented, index is diff _aryindex_loop: dup jn _aryindex_notfound

dup push 2 add :roll copy 2 :eq jz _aryindex_no
copy 2 copy 1 sub swap $++ :nslide ret

_aryindex_no: $– jump _aryindex_loop _aryindex_notfound: slide 1 ret

; returns the element E at index I in array A (or dies on out of bounds) ; [A I] => [E] ; ; [1 2 3 4 4 0] => [1] ; [1 2 3 4 4 2] => [3] ; [1 2 3 4 4 -1] => [4] negative index counts from the end aryat:

dup jn _aryat_neg
copy 1 swap sub dup :pos? jz _aryat_oob
:roll swap $-- :nslide ret

_aryat_neg: copy 1 add dup jn _aryat_oob jump aryat _aryat_oob: push “(aryat) index out of bounds!” :die!

; swaps the elements at indices I and J in array A ; [A I J] => [A'] ; ; [6 0 8 7 4 1 3] => [6 7 8 0 4] ; [4 3 2 1 4 0 2] => [2 3 4 1 4] ; [3 2 1 3 1 1] => [3 2 1 3] aryswap: copy 1 copy 1 sub jz _aryswap_noop

^-7 ^-6
:arydup @-6 :aryat ^-8
:arydup @-7 :aryat ^-9
@-6 :aryremove
@-7 $-- :aryremove
@-6 @-9 :aryinsert
@-7 @-8 :aryinsert ret

_aryswap_noop: pop pop ret

; returns the minimum and maximum elements of array A ; [A] => [min max] ; ; [4 3 2 1 4] => [1 4] ; [6 8 -3 4 0 5] => [-3 8] ; [7 1] => [7 7] minmax:

:arydup reduce (:max) ^-1
reduce (:min) @-1 ret

;;; TODO: make sort not atrociously inefficient

sort: push -3 copy 1 store ; preserve length _sort_loop:

:arydup reduce (:min)
push -1 copy 1 store copy 1 $++ :bury ; stash minimum element
:arydup @-1 :aryindex
copy 1 swap sub :dig $-- ; remove minimum element from array
push 0 copy 1 sub jn _sort_loop
push 3 sub load ret

; returns 0 if any of the elements in array A is ; strictly less than the one before it, 1 otherwise ; [A] => [0 | 1] ; ; [1 2 3 3] => [1] ; [3 2 1 3] => [0] ; [1 1 2 2 4] => [1] ; [1 2 3 4 3 5] => [0] sorted?: $– _sorted_loop:

copy 1 copy 3 sub jn _sorted_no
$-- dup jz _sorted_yes
slide 1 jump _sorted_loop

_sorted_no: $++ push 0 swap :nslide ret _sorted_yes: push 1 slide 3 ret

; reverses the array A ; [A] => [A'] ; ; [1 2 3 3] => [3 2 1 3] ; [7 1] => [7 1] ; [5 4 3 2 1 5] => [1 2 3 4 5 5] aryrev:

push -10 :aryheap push -10
@-9 times (dup load swap $--)
pop @-9 ret

; returns the array A replicated N times ; ! N must be greater than 1 ; [A N] => [A'] ; ; [3 2 1 3 4] => [3 2 1 3 2 1 3 2 1 3 2 1 12] aryrep: push -1 swap push -3 copy 1 store store _aryrep_loop:

push -1 dup :dec load jz _aryrep_done
:arydup jump _aryrep_loop

_aryrep_done: @-3 $– times (:arycat) ret