123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790(**************************************************************************)(* *)(* OCaml *)(* *)(* Gabriel Scherer, projet Partout, INRIA Paris-Saclay *)(* *)(* Copyright 2022 Institut National de Recherche en Informatique et *)(* en Automatique. *)(* *)(* All rights reserved. This file is distributed under the terms of *)(* the GNU Lesser General Public License version 2.1, with the *)(* special exception on linking described in the file LICENSE. *)(* *)(**************************************************************************)type'at={mutablelength:int;mutablearr:'aslotarray;}(* {2 The type ['a t]}
A dynamic array is represented using a backing array [arr] and
a [length]. It behaves as an array of size [length] -- the indices
from [0] to [length - 1] included contain user-provided values and
can be [get] and [set] -- but the length may also change in the
future by adding or removing elements at the end.
We use the following concepts;
- capacity: the length of the backing array:
[Array.length arr]
- live space: the portion of the backing array with
indices from [0] to [length - 1] included.
- empty space: the portion of the backing array
from [length] to the end of the backing array.
{2 The type ['a slot]}
We should not keep a user-provided value in the empty space, as
this could extend its lifetime and may result in memory leaks of
arbitrary size. Functions that remove elements from the dynamic
array, such as [pop_last] or [truncate], must really erase the
element from the backing array.
This constraint makes it difficult to represent an dynamic array of
elements of type ['a] with a backing array of type ['a array]: what
valid value of type ['a] would we use in the empty space? Typical
choices include:
- accepting scenarios where we actually leak user-provided values
(but this can blowup memory usage in some cases, and is hard to debug)
- requiring a "dummy" value at creation of the dynamic array
or in the parts of the API that grow the empty space
(but users find this very inconvenient)
- using arcane Obj.magic tricks
(but experts don't agree on which tricks are safe to use and/or
should be used here)
- using a backing array of ['a option] values, using [None]
in the empty space
(but this gives a noticeably less efficient memory representation)
In the present implementation, we use the ['a option] approach,
with a twist. With ['a option], calling [set a i x] must reallocate
a new [Some x] block:
{[
let set a i x =
if i < 0 || i >= a.length then error "out of bounds";
a.arr.(i) <- Some x
]}
Instead we use the type ['a slot] below,
which behaves as an option whose [Some] constructor
(called [Elem] here) has a _mutable_ argument.
*)and'aslot=|Empty|Elemof{mutablev:'a}(*
This gives an allocation-free implementation of [set] that calls
[Array.get] (instead of [Array.set]) on the backing array and then
mutates the [v] parameter. In pseudo-code:
{[
let set a i x =
if i < 0 || i >= a.length then error "out of bounds";
match a.arr.(i) with
| Empty -> error "invalid state: missing element"
| Elem s -> s.v <- x
]}
With this approach, accessing an element still pays the cost of an
extra indirection (compared to approaches that do not box elements
in the backing array), but only operations that add new elements at
the end of the array pay extra allocations.
There are some situations where ['a option] is better: it makes
[pop_last_opt] more efficient as the underlying option can be
returned directly, and it also lets us use [Array.blit] to
implement [append]. We believe that optimizing [get] and [set] is
more important for dynamic arrays.
{2 Invariants and valid states}
We enforce the invariant that [length >= 0] at all times.
we rely on this invariant for optimization.
The following conditions define what we call a "valid" dynarray:
- valid length: [length <= Array.length arr]
- no missing element in the live space:
forall i, [0 <= i < length] implies [arr.(i) <> Empty]
- no element in the empty space:
forall i, [length <= i < Array.length arr] implies [arr.(i) = Empty]
Unfortunately, we cannot easily enforce validity as an invariant in
presence of concurrent updates. We can thus observe dynarrays in
"invalid states". Our implementation may raise exceptions or return
incorrect results on observing invalid states, but of course it
must preserve memory safety.
*)moduleError=structlet[@inlinenever]index_out_of_boundsf~i~length=iflength=0thenPrintf.ksprintfinvalid_arg"Dynarray.%s: index %d out of bounds (empty dynarray)"fielsePrintf.ksprintfinvalid_arg"Dynarray.%s: index %d out of bounds (0..%d)"fi(length-1)let[@inlinenever]negative_length_requestedfn=Printf.ksprintfinvalid_arg"Dynarray.%s: negative length %d requested"fnlet[@inlinenever]negative_capacity_requestedfn=Printf.ksprintfinvalid_arg"Dynarray.%s: negative capacity %d requested"fnlet[@inlinenever]requested_length_out_of_boundsfrequested_length=Printf.ksprintfinvalid_arg"Dynarray.%s: cannot grow to requested length %d (max_array_length is %d)"frequested_lengthSys.max_array_length(* When observing an invalid state ([missing_element],
[invalid_length]), we do not give the name of the calling function
in the error message, as the error is related to invalid operations
performed earlier, and not to the callsite of the function
itself. *)letinvalid_state_description="Invalid dynarray (unsynchronized concurrent length change)"let[@inlinenever]missing_element~i~length=Printf.ksprintfinvalid_arg"%s: missing element at position %d < length %d"invalid_state_descriptionilengthlet[@inlinenever]invalid_length~length~capacity=Printf.ksprintfinvalid_arg"%s: length %d > capacity %d"invalid_state_descriptionlengthcapacitylet[@inlinenever]length_change_during_iterationf~expected~observed=Printf.ksprintfinvalid_arg"Dynarray.%s: a length change from %d to %d occurred during iteration"fexpectedobserved(* When an [Empty] element is observed unexpectedly at index [i],
it may be either an out-of-bounds access or an invalid-state situation
depending on whether [i <= length]. *)let[@inlinenever]unexpected_empty_elementf~i~length=ifi<lengththenmissing_element~i~lengthelseindex_out_of_boundsf~i~lengthlet[@inlinenever]empty_dynarrayf=Printf.ksprintfinvalid_arg"Dynarray.%s: empty array"fend(* Detecting iterator invalidation.
See {!iter} below for a detailed usage example.
*)letcheck_same_lengthfa~length=letlength_a=a.lengthiniflength<>length_athenError.length_change_during_iterationf~expected:length~observed:length_a(** Careful unsafe access. *)(* Postcondition on non-exceptional return:
[length <= Array.length arr] *)let[@inlinealways]check_valid_lengthlengtharr=letcapacity=Array.lengtharriniflength>capacitythenError.invalid_length~length~capacity(* Precondition: [0 <= i < length <= Array.length arr]
This precondition is typically guaranteed by knowing
[0 <= i < length] and calling [check_valid_length length arr].*)let[@inlinealways]unsafe_getarr~i~length=matchArray.unsafe_getarriwith|Empty->Error.missing_element~i~length|Elem{v}->v(** {1:dynarrays Dynamic arrays} *)letcreate()={length=0;arr=[||];}letmakenx=ifn<0thenError.negative_length_requested"make"n;{length=n;arr=Array.initn(fun_->Elem{v=x});}letinitnf=ifn<0thenError.negative_length_requested"init"n;{length=n;arr=Array.initn(funi->Elem{v=fi});}letgetai=(* This implementation will propagate an [Invalid_argument] exception
from array lookup if the index is out of the backing array,
instead of using our own [Error.index_out_of_bounds]. This is
allowed by our specification, and more efficient -- no need to
check that [length a <= capacity a] in the fast path. *)matcha.arr.(i)with|Elems->s.v|Empty->Error.unexpected_empty_element"get"~i~length:a.lengthletsetaix=(* See {!get} comment on the use of checked array
access without our own bound checking. *)matcha.arr.(i)with|Elems->s.v<-x|Empty->Error.unexpected_empty_element"set"~i~length:a.lengthletlengtha=a.lengthletis_emptya=(a.length=0)letcopy{length;arr}=check_valid_lengthlengtharr;(* use [length] as the new capacity to make
this an O(length) operation. *){length;arr=Array.initlength(funi->letv=unsafe_getarr~i~lengthinElem{v});}letget_lasta=let{arr;length}=aincheck_valid_lengthlengtharr;(* We know [length <= capacity a]. *)iflength=0thenError.empty_dynarray"get_last";(* We know [length > 0]. *)unsafe_getarr~i:(length-1)~lengthletfind_lasta=let{arr;length}=aincheck_valid_lengthlengtharr;(* We know [length <= capacity a]. *)iflength=0thenNoneelse(* We know [length > 0]. *)Some(unsafe_getarr~i:(length-1)~length)(** {1:removing Removing elements} *)letpop_lasta=let{arr;length}=aincheck_valid_lengthlengtharr;(* We know [length <= capacity a]. *)iflength=0thenraiseNot_found;letlast=length-1in(* We know [length > 0] so [last >= 0]. *)matchArray.unsafe_getarrlastwith|Empty->Error.missing_element~i:last~length|Elems->Array.unsafe_setarrlastEmpty;a.length<-last;s.vletpop_last_opta=matchpop_lastawith|exceptionNot_found->None|x->Somexletremove_lasta=letlast=lengtha-1iniflast>=0thenbegina.length<-last;a.arr.(last)<-Empty;endlettruncatean=ifn<0thenError.negative_length_requested"truncate"n;let{arr;length}=ainiflength<=nthen()elsebegina.length<-n;Array.fillarrn(length-n)Empty;endletcleara=truncatea0(** {1:capacity Backing array and capacity} *)letcapacitya=Array.lengtha.arrletnext_capacityn=letn'=(* For large values of n, we use 1.5 as our growth factor.
For smaller values of n, we grow more aggressively to avoid
reallocating too much when accumulating elements into an empty
array.
The constants "512 words" and "8 words" below are taken from
https://github.com/facebook/folly/blob/
c06c0f41d91daf1a6a5f3fc1cd465302ac260459/folly/FBVector.h#L1128-L1157
*)ifn<=512thenn*2elsen+n/2in(* jump directly from 0 to 8 *)min(max8n')Sys.max_array_lengthletensure_capacityacapacity_request=letarr=a.arrinletcur_capacity=Array.lengtharrinifcapacity_request<0thenError.negative_capacity_requested"ensure_capacity"capacity_requestelseifcur_capacity>=capacity_requestthen(* This is the fast path, the code up to here must do as little as
possible. (This is why we don't use [let {arr; length} = a] as
usual, the length is not needed in the fast path.)*)()elsebeginifcapacity_request>Sys.max_array_lengththenError.requested_length_out_of_bounds"ensure_capacity"capacity_request;letnew_capacity=(* We use either the next exponential-growth strategy,
or the requested strategy, whichever is bigger.
Compared to only using the exponential-growth strategy, this
lets us use less memory by avoiding any overshoot whenever
the capacity request is noticeably larger than the current
capacity.
Compared to only using the requested capacity, this avoids
losing the amortized guarantee: we allocated "exponentially
or more", so the amortization holds. In particular, notice
that repeated calls to [ensure_capacity a (length a + 1)]
will have amortized-linear rather than quadratic complexity.
*)max(next_capacitycur_capacity)capacity_requestinletnew_arr=Array.makenew_capacityEmptyinArray.blitarr0new_arr0a.length;a.arr<-new_arr;(* postcondition: *)assert(0<=capacity_request);assert(capacity_request<=Array.lengthnew_arr);endletensure_extra_capacityaextra_capacity_request=ensure_capacitya(lengtha+extra_capacity_request)letfit_capacitya=ifcapacitya=a.lengththen()elsea.arr<-Array.suba.arr0a.lengthletset_capacityan=ifn<0thenError.negative_capacity_requested"set_capacity"n;letarr=a.arrinletcur_capacity=Array.lengtharrinifn<cur_capacitythenbegina.length<-mina.lengthn;a.arr<-Array.subarr0n;endelseifn>cur_capacitythenbeginletnew_arr=Array.makenEmptyinArray.blitarr0new_arr0a.length;a.arr<-new_arr;endletreseta=a.length<-0;a.arr<-[||](** {1:adding Adding elements} *)(* We chose an implementation of [add_last a x] that behaves correctly
in presence of asynchronous / re-entrant code execution around
allocations and poll points: if another thread or a callback gets
executed on allocation, we add the element at the new end of the
dynamic array.
(We do not give the same guarantees in presence of concurrent
parallel updates, which are much more expensive to protect
against.)
*)(* [add_last_if_room a elem] only writes the slot if there is room, and
returns [false] otherwise. *)let[@inline]add_last_if_roomaelem=let{arr;length}=ain(* we know [0 <= length] *)iflength>=Array.lengtharrthenfalseelsebegin(* we know [0 <= length < Array.length arr] *)a.length<-length+1;Array.unsafe_setarrlengthelem;trueendletadd_lastax=letelem=Elem{v=x}inifadd_last_if_roomaelemthen()elsebegin(* slow path *)letrecgrow_and_addaelem=ensure_extra_capacitya1;ifnot(add_last_if_roomaelem)thengrow_and_addaelemingrow_and_addaelemendletrecappend_listali=matchliwith|[]->()|x::xs->add_lastax;append_listaxsletappend_iteraiterb=iter(funx->add_lastax)bletappend_seqaseq=Seq.iter(funx->add_lastax)seq(* append_array: same [..._if_room] and loop logic as [add_last]. *)letappend_array_if_roomab=let{arr;length=length_a}=ainletlength_b=Array.lengthbiniflength_a+length_b>Array.lengtharrthenfalseelsebegina.length<-length_a+length_b;(* Note: we intentionally update the length *before* filling the
elements. This "reserve before fill" approach provides better
behavior than "fill then notify" in presence of reentrant
modifications (which may occur below, on a poll point in the loop or
the [Elem] allocation):
- If some code asynchronously adds new elements after this
length update, they will go after the space we just reserved,
and in particular no addition will be lost. If instead we
updated the length after the loop, any asynchronous addition
during the loop could be erased or erase one of our additions,
silently, without warning the user.
- If some code asynchronously iterates on the dynarray, or
removes elements, or otherwise tries to access the
reserved-but-not-yet-filled space, it will get a clean "missing
element" error. This is worse than with the fill-then-notify
approach where the new elements would only become visible
(to iterators, for removal, etc.) alltogether at the end of
loop.
To summarise, "reserve before fill" is better on add-add races,
and "fill then notify" is better on add-remove or add-iterate
races. But the key difference is the failure mode:
reserve-before fails on add-remove or add-iterate races with
a clean error, while notify-after fails on add-add races with
silently disappearing data. *)fori=0tolength_b-1doletx=Array.unsafe_getbiinArray.unsafe_setarr(length_a+i)(Elem{v=x})done;trueendletappend_arrayab=ifappend_array_if_roomabthen()elsebegin(* slow path *)letrecgrow_and_appendab=ensure_extra_capacitya(Array.lengthb);ifnot(append_array_if_roomab)thengrow_and_appendabingrow_and_appendabend(* append: same [..._if_room] and loop logic as [add_last],
same reserve-before-fill logic as [append_array]. *)(* It is a programming error to mutate the length of [b] during a call
to [append a b]. To detect this mistake we keep track of the length
of [b] throughout the computation and check it that does not
change.
*)letappend_if_roomab~length_b=let{arr=arr_a;length=length_a}=ainiflength_a+length_b>Array.lengtharr_athenfalseelsebegina.length<-length_a+length_b;letarr_b=b.arrincheck_valid_lengthlength_barr_b;fori=0tolength_b-1doletx=unsafe_getarr_b~i~length:length_binArray.unsafe_setarr_a(length_a+i)(Elem{v=x})done;check_same_length"append"b~length:length_b;trueendletappendab=letlength_b=lengthbinifappend_if_roomab~length_bthen()elsebegin(* slow path *)letrecgrow_and_appendab~length_b=ensure_extra_capacityalength_b;(* Eliding the [check_same_length] call below would be wrong in
the case where [a] and [b] are aliases of each other, we
would get into an infinite loop instead of failing.
We could push the call to [append_if_room] itself, but we
prefer to keep it in the slow path. *)check_same_length"append"b~length:length_b;ifnot(append_if_roomab~length_b)thengrow_and_appendab~length_bingrow_and_appendab~length_bend(** {1:iteration Iteration} *)(* The implementation choice that we made for iterators is the one
that maximizes efficiency by avoiding repeated bound checking: we
check the length of the dynamic array once at the beginning, and
then only operate on that portion of the dynarray, ignoring
elements added in the meantime.
The specification states that it is a programming error to mutate
the length of the array during iteration. We check for this and
raise an error on size change.
Note that we may still miss some transient state changes that cancel
each other and leave the length unchanged at the next check.
*)letiter_fka=let{arr;length}=ain(* [check_valid_length length arr] is used for memory safety, it
guarantees that the backing array has capacity at least [length],
allowing unsafe array access.
[check_same_length] is used for correctness, it lets the function
fail more often if we discover the programming error of mutating
the length during iteration.
We could, naively, call [check_same_length] at each iteration of
the loop (before or after, or both). However, notice that this is
not necessary to detect the removal of elements from [a]: if
elements have been removed by the time the [for] loop reaches
them, then [unsafe_get] will itself fail with an [Invalid_argument]
exception. We only need to detect the addition of new elements to
[a] during iteration, and for this it is enough to call
[check_same_length] once at the end.
Calling [check_same_length] more often could catch more
programming errors, but the only errors that we miss with this
optimization are those that keep the array size constant --
additions and deletions that cancel each other. We consider this
an acceptable tradeoff.
*)check_valid_lengthlengtharr;fori=0tolength-1dok(unsafe_getarr~i~length);done;check_same_lengthfa~lengthletiterka=iter_"iter"kaletiterika=let{arr;length}=aincheck_valid_lengthlengtharr;fori=0tolength-1doki(unsafe_getarr~i~length);done;check_same_length"iteri"a~lengthletmapfa=let{arr;length}=aincheck_valid_lengthlengtharr;letres={length;arr=Array.initlength(funi->Elem{v=f(unsafe_getarr~i~length)});}incheck_same_length"map"a~length;resletmapifa=let{arr;length}=aincheck_valid_lengthlengtharr;letres={length;arr=Array.initlength(funi->Elem{v=fi(unsafe_getarr~i~length)});}incheck_same_length"mapi"a~length;resletfold_leftfacca=let{arr;length}=aincheck_valid_lengthlengtharr;letr=refaccinfori=0tolength-1doletv=unsafe_getarr~i~lengthinr:=f!rv;done;check_same_length"fold_left"a~length;!rletfold_rightfaacc=let{arr;length}=aincheck_valid_lengthlengtharr;letr=refaccinfori=length-1downto0doletv=unsafe_getarr~i~lengthinr:=fv!r;done;check_same_length"fold_right"a~length;!rletexistspa=let{arr;length}=aincheck_valid_lengthlengtharr;letrecloopparrilength=ifi=lengththenfalseelsep(unsafe_getarr~i~length)||loopparr(i+1)lengthinletres=loopparr0lengthincheck_same_length"exists"a~length;resletfor_allpa=let{arr;length}=aincheck_valid_lengthlengtharr;letrecloopparrilength=ifi=lengththentrueelsep(unsafe_getarr~i~length)&&loopparr(i+1)lengthinletres=loopparr0lengthincheck_same_length"for_all"a~length;resletfilterfa=letb=create()initer_"filter"(funx->iffxthenadd_lastbx)a;bletfilter_mapfa=letb=create()initer_"filter_map"(funx->matchfxwith|None->()|Somey->add_lastby)a;b(** {1:conversions Conversions to other data structures} *)(* The eager [to_*] conversion functions behave similarly to iterators
in presence of updates during computation. The [*_reentrant]
functions obey their more permissive specification, which tolerates
any concurrent update. *)letof_arraya=letlength=Array.lengthain{length;arr=Array.initlength(funi->Elem{v=Array.unsafe_getai});}letto_arraya=let{arr;length}=aincheck_valid_lengthlengtharr;letres=Array.initlength(funi->unsafe_getarr~i~length)incheck_same_length"to_array"a~length;resletof_listli=leta=create()inList.iter(funx->add_lastax)li;aletto_lista=let{arr;length}=aincheck_valid_lengthlengtharr;letl=ref[]infori=length-1downto0dol:=unsafe_getarr~i~length::!ldone;check_same_length"to_list"a~length;!lletof_seqseq=letinit=create()inappend_seqinitseq;initletto_seqa=let{arr;length}=aincheck_valid_lengthlengtharr;letrecauxi=fun()->check_same_length"to_seq"a~length;ifi>=lengththenSeq.Nilelsebeginletv=unsafe_getarr~i~lengthinSeq.Cons(v,aux(i+1))endinaux0letto_seq_reentranta=letrecauxi=fun()->ifi>=lengthathenSeq.Nilelsebeginletv=getaiinSeq.Cons(v,aux(i+1))endinaux0letto_seq_reva=let{arr;length}=aincheck_valid_lengthlengtharr;letrecauxi=fun()->check_same_length"to_seq_rev"a~length;ifi<0thenSeq.Nilelsebeginletv=unsafe_getarr~i~lengthinSeq.Cons(v,aux(i-1))endinaux(length-1)letto_seq_rev_reentranta=letrecauxi=fun()->ifi<0thenSeq.Nilelseifi>=lengthathen(* If some elements have been removed in the meantime, we skip
those elements and continue with the new end of the array. *)aux(lengtha-1)()elsebeginletv=getaiinSeq.Cons(v,aux(i-1))endinaux(lengtha-1)