mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
* chore: Re-format Haskell code * fix: Unify aupdate and aupdate! with other update functions * fix: Re-add comment * fix: Also make StaticArray.aupdate! adhere to the normal update signature * fix: Failing test
468 lines
15 KiB
Plaintext
468 lines
15 KiB
Plaintext
(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))))))))
|
||
|
||
(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 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 doesn’t 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 doesn’t 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 don’t 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 didn’t 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.")))
|