Carp/core/Array.carp
2021-10-22 06:59:40 +02:00

498 lines
16 KiB
Plaintext
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(defmacro for [settings :rest body] ;; settings = variable, from, to, <step>
(if (> (length body) 1)
(macro-error "Warning: the body of the 'for' loop can only contain one expression")
(let [variable (car settings)
from (cadr settings)
to (caddr settings)
step (if (> (length settings) 3) (cadddr settings) 1)
comp (if (> (length settings) 4)
(cadddr (cdr settings))
(if (< step (- step step)) '> '<))
]
`(let [%variable %from]
(while (%comp %variable %to)
(do
%(cond
(= (length body) 0) ()
(list? body) (car body)
body)
(set! %variable (+ %variable %step))))))))
(doc Array "is the indexable collection data structure.
Its literal uses brackets, so an array of integers would look like this:
`[1 2 3]`. It provides both a functional and an imperative API, and is one of
the core data structures of Carp. It is heap-allocated, for a stack-allocated
variant you might want to check out [`StaticArray`](./StaticArray.html).")
(defmodule Array
(doc reduce "will reduce an array `xs` into a single value using a function `f` that takes the reduction thus far and the next value. The initial reduction value is `x`.
As an example, consider this definition of `sum` based on `reduce`:
```
(defn sum [x]
(reduce &(fn [x y] (+ x @y)) 0 x))
```
It will sum the previous sum with each new value, starting at `0`.")
(defn reduce [f x xs]
(let [total x]
(do
(for [i 0 (length xs)]
(set! total (~f total (unsafe-nth xs i))))
total)))
(doc scan "Similar to `Array.reduce`, but instead returns an array with the starting element,
and then all intermediate values.
For example, a scan using `Int.+` over the array [1 1 1 1 1] (starting at 0) will return [0 1 2 3 4 5].")
(defn scan [f x xs]
(let [n (length xs)
ys (allocate (inc n))]
(do
(aset-uninitialized! &ys 0 @&x)
(for [i 1 (inc n)]
(aset-uninitialized! &ys i (~f (unsafe-nth &ys (dec i)) (unsafe-nth xs (dec i)))))
ys)))
(doc endo-scan "Like `Array.scan`, but uses the first element of the array as the starting value.
Also does not create a new array, but reuses the initial one instead (by taking ownership over `xs`.)
For example, an endo-scan using `Int.+` over the array [1 1 1 1 1] will return [1 2 3 4 5]")
(defn endo-scan [f xs]
(let [n (length &xs)]
(do
(for [i 1 n]
(aset! &xs i (~f (unsafe-nth &xs (dec i)) (unsafe-nth &xs i))))
xs)))
(doc empty? "checks whether the array `a` is empty.")
(defn empty? [a]
(= (Array.length a) 0))
(implements empty? Array.empty?)
(doc any? "checks whether any of the elements in `a` match the function `f`.")
(defn any? [f a]
(let-do [res false]
(for [i 0 (length a)]
(when (~f (unsafe-nth a i))
(do
(set! res true)
(break))))
res))
(doc all? "checks whether all of the elements in `a` match the function `f`.")
(defn all? [f a]
(let-do [res true]
(for [i 0 (length a)]
(when (not (~f (unsafe-nth a i)))
(do
(set! res false)
(break))))
res))
(doc find "finds an element in `a` that matches the function `f` and wraps it in a `Just`.
If it doesnt find an element, `Nothing` will be returned.")
(defn find [f a]
(let-do [res (Maybe.Nothing)]
(for [i 0 (length a)]
(when (~f (unsafe-nth a i))
(do
(set! res (Maybe.Just @(unsafe-nth a i)))
(break))))
res))
(doc find-index "finds the index of the first element in `a` that matches the function `f` and wraps it in a `Just`.
If it doesnt find an index, `Nothing` will be returned.")
(defn find-index [f a]
(let-do [ret (Maybe.Nothing)]
(for [i 0 (length a)]
(when (~f (unsafe-nth a i))
(do
(set! ret (Maybe.Just i))
(break))))
ret))
(doc unsafe-first "takes the first element of an array.
Generates a runtime error if the array is empty.")
(defn unsafe-first [a]
(Array.unsafe-nth a 0))
(doc first "takes the first element of an array and returns a `Just`.
Returns `Nothing` if the array is empty.")
(defn first [a]
(if (empty? a)
(Maybe.Nothing)
(Maybe.Just @(Array.unsafe-nth a 0))))
(doc unsafe-last "takes the last element of an array.
Generates a runtime error if the array is empty.")
(defn unsafe-last [a]
(Array.unsafe-nth a (Int.dec (Array.length a))))
(doc last "takes the last element of an array and returns a `Just`.
Returns `Nothing` if the array is empty.")
(defn last [a]
(if (empty? a)
(Maybe.Nothing)
(Maybe.Just @(Array.unsafe-nth a (Int.dec (Array.length a))))))
(doc = "compares two arrays.")
(defn = [a b]
(if (/= (length a) (length b))
false
(let-do [eq true]
(for [i 0 (length a)]
(when (/= (unsafe-nth a i) (unsafe-nth b i))
(do
(set! eq false)
(break))))
eq)))
(implements = Array.=)
(doc maximum "gets the maximum in an array (elements must support `<`) and wraps it in a `Just`.
If the array is empty, it returns `Nothing`.")
(defn maximum [xs]
(if (empty? xs)
(Maybe.Nothing)
(let-do [result (unsafe-nth xs 0)
n (length xs)]
(for [i 1 n]
(let [x (unsafe-nth xs i)]
(when (< result x)
(set! result x))))
(Maybe.Just @result))))
(doc minimum "gets the minimum in an array (elements must support `>`) and wraps it in a `Just`.
If the array is empty, returns `Nothing`")
(defn minimum [xs]
(if (empty? xs)
(Maybe.Nothing)
(let-do [result (unsafe-nth xs 0)
n (length xs)]
(for [i 1 n]
(let [x (unsafe-nth xs i)]
(when (> result x)
(set! result x))))
(Maybe.Just @result))))
(doc sum "sums an array (elements must support `+` and `zero`).")
(defn sum [xs]
(Array.reduce &(fn [x y] (+ x @y)) (zero) xs))
(doc slice "gets a subarray from `start-index` to `end-index`.")
(defn slice [xs start-index end-index]
(let-do [result []]
(for [i start-index end-index]
(set! result (push-back result @(unsafe-nth xs i))))
result))
(implements slice Array.slice)
(doc prefix "gets a prefix array to `end-index`.")
(defn prefix [xs end-index]
(slice xs 0 end-index))
(doc suffix "gets a suffix array from `start-index`.")
(defn suffix [xs start-index]
(slice xs start-index (length xs)))
(doc rest "gets all but the first element from the array.")
(defn rest [xs]
(suffix xs 1))
(doc reverse "reverses an array.")
(defn reverse [a]
(let-do [i 0
j (Int.dec (length &a))]
(while (Int.< i j)
(let-do [tmp @(unsafe-nth &a i)]
(aset! &a i @(unsafe-nth &a j))
(set! i (Int.inc i))
(aset! &a j tmp)
(set! j (Int.dec j))))
a))
(doc index-of "gets the index of element `e` in an array and wraps it on a `Just`.
If the element is not found, returns `Nothing`")
(defn index-of [a e]
(let-do [idx (Maybe.Nothing)]
(for [i 0 (length a)]
(when (= (unsafe-nth a i) e)
(do
(set! idx (Maybe.Just i))
(break))))
idx))
(doc element-count "counts the occurrences of element `e` in an array.")
(defn element-count [a e]
(let-do [c 0]
(for [i 0 (length a)]
(when (= e (unsafe-nth a i)) (set! c (Int.inc c))))
c))
(doc predicate-count "counts the number of elements satisfying the predicate function `pred` in an array.")
(defn predicate-count [a pred]
(let-do [c 0]
(for [i 0 (length a)]
(when (~pred (unsafe-nth a i))
(set! c (Int.inc c))))
c))
(doc unsafe-nth-value "returns the value at index `i` of an array `a` (just like [unsafe-nth](#unsafe-nth)) but does not take its reference, and does *not* copy the value. Should only be used for optimizations and when you know what you're doing, circumvents the borrow checker!")
(deftemplate unsafe-nth-value (Fn [(Ref (Array a)) Int] a)
"$a $NAME(Array *a, int i)"
"$DECL { return (($a*)a->data)[i]; }")
(doc aupdate "transmutes (i.e. updates) the element at index `i` of an array `a` using the function `f`.")
(defn aupdate [a i f]
(do
(aset-uninitialized! &a i (~f (unsafe-nth-value &a i)))
a))
(doc aupdate! "transmutes (i.e. updates) the element at index `i` of an array `a` using the function `f` in place.")
(defn aupdate! [a i f]
(aset-uninitialized! a i (~f (unsafe-nth-value a i))))
(doc swap "swaps the indices `i` and `j` of an array `a`.")
(defn swap [a i j]
(let [x @(unsafe-nth &a i)
y @(unsafe-nth &a j)]
(aset (aset a i y) j x)))
(doc swap! "swaps the indices `i` and `j` of an array `a` in place.")
(defn swap! [a i j]
(let-do [x @(unsafe-nth a i)
y @(unsafe-nth a j)]
(aset! a i y)
(aset! a j x)))
(doc repeat "repeats the function `f` `n` times and stores the results in an array.")
(defn repeat [n f]
(let-do [a (allocate n)]
(for [i 0 n] (aset-uninitialized! &a i (~f)))
a))
(doc repeat-indexed "repeats function `f` `n` times and stores the results in an array.
This is similar to [`repeat`](#repeat), but the function `f` will be supplied with the index of the element.")
(defn repeat-indexed [n f]
(let-do [a (allocate n)]
(for [i 0 n] (aset-uninitialized! &a i (f i)))
a))
(doc replicate "repeats element `e` `n` times and stores the results in an array.")
(defn replicate [n e]
(let-do [a (allocate n)]
(for [i 0 n] (aset-uninitialized! &a i @e))
a))
(doc copy-map "maps over an array `a` using the function `f`.
This function copies the array. If you dont want that, use [`endo-map`](#endo-map).")
(defn copy-map [f a]
(let-do [na (allocate (length a))]
(for [i 0 (length a)]
(aset-uninitialized! &na i (~f (unsafe-nth a i))))
na))
(doc unreduce "creates an array by producing values using `step` until they
no longer satisfy `test`. The initial value is `start`.
Example:
```
; if we didnt have Array.range, we could define it like this:
(defn range [start end step]
(unreduce start &(fn [x] (< x (+ step end))) &(fn [x] (+ x step)))
)
```")
(defn unreduce [start test step]
(let-do [elem start
acc []]
(while-do (~test elem)
(push-back! &acc elem)
(set! elem (~step elem)))
acc))
(doc zip "maps over two arrays using a function `f` that takes two arguments. It will produces a new array with the length of the shorter input.
The trailing elements of the longer array will be discarded.")
(defn zip [f a b]
(let-do [l (min (length a) (length b))
na (allocate l)]
(for [i 0 l]
(aset-uninitialized! &na i (~f (unsafe-nth a i) (unsafe-nth b i))))
na))
(doc sum-length "returns the sum of lengths from a nested array `xs`.")
(defn sum-length [xs]
(let-do [sum 0
lxs (Array.length xs)]
(for [i 0 lxs]
(set! sum (+ sum (Array.length (Array.unsafe-nth xs i)))))
sum))
(doc zero "returns the empty array.")
(defn zero [] [])
(implements zero Array.zero)
(doc concat "returns a new array which is the concatenation of the provided nested array `xs`.")
(defn concat [xs]
;; This is using a StringBuilder pattern to only perform one allocation and
;; to only copy each of the incoming Array(s) once.
;; This currently performs wasted Array.length calls, as we call it for each
;; Array once here and once in sum-length.
(let-do [j 0
lxs (Array.length xs)
result (Array.allocate (sum-length xs))]
(for [i 0 lxs]
(let-do [arr (Array.unsafe-nth xs i)
len (Array.length arr)]
(for [k 0 len]
(aset-uninitialized! &result (+ j k) @(Array.unsafe-nth arr k)))
(set! j (+ j len))))
result))
(doc enumerated "creates a new array of `Pair`s where the first position is the index and the second position is the element from the original array `xs`.")
(defn enumerated [xs]
(let-do [arr (allocate (length xs))]
(for [i 0 (length xs)]
(aset-uninitialized!
&arr
i
(Pair.init-from-refs &i (unsafe-nth xs i))))
arr))
(doc nth "gets a reference to the `n`th element from an array `arr` wrapped on a `Maybe`.
If the `index` is out of bounds, return `Maybe.Nothing`")
(defn nth [xs index]
(if (and (>= index 0) (< index (length xs)))
(Maybe.Just @(unsafe-nth xs index)) ; the copy will go away with lifetimes
(Maybe.Nothing)))
(doc remove "removes all occurrences of the element `el` in the array `arr`, in place.")
(defn remove [el arr]
(endo-filter &(fn [x] (not (= el x)))
arr))
(doc remove-nth "removes element at index `idx` from the array `arr`.")
(defn remove-nth [i arr]
(do
;;(assert (<= 0 i))
;;(assert (< i (Array.length &arr)))
(for [j i (Int.dec (Array.length &arr))]
(aset! &arr j @(unsafe-nth &arr (inc j))))
(pop-back arr)))
(doc copy-filter "filters the elements in an array.
It will create a copy. If you want to avoid that, consider using [`endo-filter`](#endo-filter) instead.")
(defn copy-filter [f a] (endo-filter f @a))
(doc contains? "checks wether an element exists in the array.")
(defn contains? [arr el]
(let-do [result false]
(for [i 0 (Array.length arr)]
(when (= el (Array.unsafe-nth arr i))
(do
(set! result true)
(break))))
result))
(doc partition
"Partitions an array `arr` into an array of arrays of length `n`
sequentially filled with the `arr`'s original values.
This function will fill partitions until `arr` is exhuasted.
If `n` is greater than or equal to the length of `arr`, the result of this
function is an array containing a single array of length `n`.
For example:
```clojure
(Array.partition &[1 2 3 4] 2)
=> [[1 2] [3 4]]
(Array.partition &[1 2 3 4] 3)
=> [[1 2 3] [4]]
(Array.partition &[1 2 3 4] 6)
=> [[1 2 3 4]]
```")
(sig partition (Fn [(Ref (Array a) b) Int] (Array (Array a))))
(defn partition [arr n]
(let-do [x 0
y 0
a []]
;; We use while since we're doing custom incrementation of x
;; dealing with the extra increment implicitly called by for is messier
(while (< x (Array.length arr))
(do
(set! y (+ x n))
(when (> y (Array.length arr))
(set! y (Array.length arr)))
(set! a (push-back a (Array.slice arr x y)))
(set! x y)))
a))
(doc from-static "Turns a `StaticArray` into an `Array`. Copies elements.")
(defn from-static [sarr]
(let-do [darr (allocate (StaticArray.length sarr))]
(for [i 0 (StaticArray.length sarr)]
(aset-uninitialized! &darr i @(StaticArray.unsafe-nth sarr i)))
darr))
(doc map-reduce "reduces an array `a` by invoking the function `f` on each
element, while keeping an accumulator and a list.
Returns a `Pair` where the first element is the mapped array and the second one
is the final accumulator.
The function `f` receives two arguments: the first one is the accumulator, and
the second one is the element. `f` must return `(Pair accumulator result)`.
Example:
```
(map-reduce &(fn [acc x] (Pair.init (+ @x @acc) (* @x 2))) 0 &[1 2 3])
; => (Pair 6 [2 4 6])
```")
(defn map-reduce [f acc a]
(reduce
&(fn [a el]
(let [l (Pair.b &a)
acc (Pair.a &a)
p (~f acc el)]
(Pair.init @(Pair.a &p) (Array.push-back @l @(Pair.b &p)))))
(Pair.init acc [])
a))
)
(defmacro doall [f xs]
`(for [i 0 (Array.length &%xs)]
(%f (Array.unsafe-nth &%xs i))))
(defndynamic foreach-internal [var xs expr]
(let [xsym (gensym-with 'xs)
len (gensym-with 'len)
i (gensym-with 'i)]
`(let [%xsym %xs
%len (Array.length %xsym)]
(for [%i 0 %len]
(let [%var (Array.unsafe-nth %xsym %i)]
%expr)))))
(defmacro foreach [binding expr]
(if (array? binding)
(foreach-internal (car binding) (cadr binding) expr)
(macro-error "Binding has to be an array.")))