Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file doubly_linked.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979open!ImportincludeDoubly_linked_intf(* INVARIANT: This exception is raised if a list is mutated during a pending iteration.
This invariant is guaranteed by the Header and Elt modules in conjunction. All
downstream code in this module need not be concerned with this invariant.
*)exceptionAttempt_to_mutate_list_during_iterationletphys_equal=(==)moduleHeader:sigtypetvalcreate:unit->tvallength:t->intvalequal:t->t->boolvalincr_length:by:int->t->unitvalcheck_no_pending_iterations:t->unit(* Unfortunate, but by specializing [with_iteration] for different arities, a large
amount of allocation during folds and iterations is avoided.
The original type of [with_iteration] was
[val with_iteration : t -> (unit -> 'a) -> 'a]
The difference between
{[
let x = e in
let f () = g x in
f ()
]}
and
{[
let x = e in
let f x = g x in
f x
]}
is that in the first case the closure for [f] contains a pointer to [x],
and in the second case it doesn't. A closure without pointers to enclosing
environment is implemented as a naked function pointer, so we don't
allocate at all.
For the same reason we make sure not to call [Result.try_with (fun () -> ...)]
inside [with_iteration] and do an explicit match statement instead. *)valwith_iteration_2:t->'a->'b->('a->'b->'c)->'cvalwith_iteration_3:t->'a->'b->'c->('a->'b->'c->'d)->'dvalwith_iteration_4:t->'a->'b->'c->'d->('a->'b->'c->'d->'e)->'evalmerge:t->t->[`Same_already|`Merged]end=structtypes={mutablelength:int;mutablepending_iterations:int}typet=sUnion_find.tletcreate()=Union_find.create{length=1;pending_iterations=0}letequal(t1:t)t2=Union_find.same_classt1t2letlengtht=(Union_find.gett).lengthletunion_find_get__check_no_pending_iterationst=lets=Union_find.gettinifs.pending_iterations>0thenraiseAttempt_to_mutate_list_during_iterationelses;;letcheck_no_pending_iterationst=ignore(union_find_get__check_no_pending_iterationst:s);;letincr_length~by:nt=lets=union_find_get__check_no_pending_iterationstins.length<-s.length+n;;(* Care is taken not to allocate in [with_iteration_*], since it is called every second
by [every_second] in [writer0.ml] *)letincr_pending_iterss=s.pending_iterations<-s.pending_iterations+1letdecr_pending_iterss=s.pending_iterations<-s.pending_iterations-1letwith_iteration_2tabf=lets=Union_find.gettinincr_pending_iterss;matchfabwith|exceptionexn->decr_pending_iterss;raiseexn|r->decr_pending_iterss;r;;letwith_iteration_3tabcf=lets=Union_find.gettinincr_pending_iterss;matchfabcwith|exceptionexn->decr_pending_iterss;raiseexn|r->decr_pending_iterss;r;;letwith_iteration_4tabcdf=lets=Union_find.gettinincr_pending_iterss;matchfabcdwith|exceptionexn->decr_pending_iterss;raiseexn|r->decr_pending_iterss;r;;letmerge(t1:t)t2=ifUnion_find.same_classt1t2then`Same_alreadyelse(letn1=(union_find_get__check_no_pending_iterationst1).lengthinletn2=(union_find_get__check_no_pending_iterationst2).lengthinwith_iteration_4t1t1t2n1n2(funt1t2n1n2->with_iteration_4t2t1t2n1n2(funt1t2n1n2->Union_find.uniont1t2;Union_find.sett1{length=n1+n2;pending_iterations=0}));`Merged);;endmoduleElt:sigtype'at[@@derivingsexp_of]valheader:'at->Header.tvalequal:'at->'at->boolvalcreate:'a->'atvalvalue:'at->'avalset:'at->'a->unitvalunlink:'at->unitvalsplit_or_splice_before:'at->'at->unitvalsplit_or_splice_after:'at->'at->unitvalinsert_after:'at->'a->'atvalinsert_before:'at->'a->'atvalunlink_before:'at->'atvalnext:'at->'atvalprev:'at->'atend=structtype'at={mutablevalue:'a;mutableprev:'at;mutablenext:'at;mutableheader:Header.t}letequal=phys_equalletnextt=t.nextletprevt=t.prevletheadert=t.headerletcreate_auxvheader=letrect={value=v;prev=t;next=t;header}int;;letis_singletont=equaltt.prevletsexp_of_tsexp_of_at=sexp_of_at.valueletcreatev=create_auxv(Header.create())letvaluet=t.valueletsettv=t.value<-v(*
[split_or_splice] is sufficient as the lone primitive for
accomplishing all pointer updates on cyclic loops of list nodes.
It takes two "gaps" between adjacent linked list nodes. If the gaps
point into the same list, the result is that it will be split into
two lists afterwards. If the gaps point into different lists, the
result is that they will be spliced together into one list afterwards.
{v
Before After
-----+ +----- -----+ +-----
A | <--> | B A | <--- ---> | B
-----+ +----- -----+ \ / +-----
X
-----+ +----- -----+ / \ +-----
C | <--> | D C | <--- ---> | D
-----+ +----- -----+ +-----
v} *)letunsafe_split_or_splice~prev1:a~next1:b~prev2:c~next2:d=a.next<-d;d.prev<-a;c.next<-b;b.prev<-c;;letunsafe_split_or_splice_aftert1t2=unsafe_split_or_splice~next1:t1.next~prev1:t1.next.prev~next2:t2.next~prev2:t2.next.prev;;letunsafe_split_or_splice_beforet1t2=unsafe_split_or_splice~prev1:t1.prev~next1:t1.prev.next~prev2:t2.prev~next2:t2.prev.next;;letcheck_two_nodes_no_pending_iterationst1t2=Header.check_no_pending_iterationst1.header;ifnot(Header.equalt1.headert2.header)thenHeader.check_no_pending_iterationst2.header;;(* We redefine safe versions for export *)letsplit_or_splice_aftert1t2=check_two_nodes_no_pending_iterationst1t2;unsafe_split_or_splice_aftert1t2;;letsplit_or_splice_beforet1t2=check_two_nodes_no_pending_iterationst1t2;unsafe_split_or_splice_beforet1t2;;letinsert_beforetv=Header.incr_lengtht.header~by:1;letnode=create_auxvt.headerinunsafe_split_or_splice_beforetnode;node;;letinsert_aftertv=Header.incr_lengtht.header~by:1;letnode=create_auxvt.headerinunsafe_split_or_splice_aftertnode;node;;letdummy_header=Header.create()letunlink_beforet=letnode=t.previnifis_singletonnodethennodeelse(Header.incr_lengtht.header~by:(-1);unsafe_split_or_splice_beforetnode;node.header<-dummy_header;node);;letunlink_aftert=letnode=t.nextinifis_singletonnodethennodeelse(Header.incr_lengtht.header~by:(-1);unsafe_split_or_splice_aftertnode;node.header<-dummy_header;node);;letunlinkt=ignore(unlink_aftert.prev:_t)endtype'at='aElt.toptionrefletinvariantinvariant_at=match!twith|None->()|Somehead->letheader=Elt.headerheadinletrecloopnelt=letnext_elt=Elt.nexteltinletprev_elt=Elt.preveltinassert(Elt.equalelt(Elt.prevnext_elt));assert(Elt.equalelt(Elt.nextprev_elt));assert(Header.equal(Elt.headerelt)header);invariant_a(Elt.valueelt);ifElt.equalnext_eltheadthennelseloop(n+1)next_eltinletlen=loop1headinassert(len=Header.lengthheader);;letcreate(typea)():at=refNoneletequal(t:_t)t'=phys_equaltt'letof_list=function|[]->create()|x::xs->letfirst=Elt.createxinlet_last=List.foldxs~init:first~f:Elt.insert_afterinref(Somefirst);;letof_array=function|[||]->create()|arr->letfirst=Elt.createarr.(0)inletreclooparrelti=ifi<Array.lengtharrthenlooparr(Elt.insert_aftereltarr.(i))(i+1)inlooparrfirst1;ref(Somefirst);;letmapt~f=match!twith|None->create()|Somefirst->letnew_first=Elt.create(f(Elt.valuefirst))inHeader.with_iteration_3(Elt.headerfirst)fnew_firstfirst(funfnew_firstfirst->letrecloopfaccfirstelt=letacc=Elt.insert_afteracc(f(Elt.valueelt))inletnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopfaccfirstnextin(* unroll and skip first elt *)letnext=Elt.nextfirstinifnot(phys_equalnextfirst)thenloopfnew_firstfirstnext);ref(Somenew_first);;letmapit~f=match!twith|None->create()|Somefirst->letnew_first=Elt.create(f0(Elt.valuefirst))inHeader.with_iteration_3(Elt.headerfirst)fnew_firstfirst(funfnew_firstfirst->letrecloopfiaccfirstelt=letacc=Elt.insert_afteracc(fi(Elt.valueelt))inletnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopf(i+1)accfirstnextin(* unroll and skip first elt *)letnext=Elt.nextfirstinifnot(phys_equalnextfirst)thenloopf1new_firstfirstnext);ref(Somenew_first);;letfold_eltt~init~f=match!twith|None->init|Somefirst->Header.with_iteration_3(Elt.headerfirst)finitfirst(funfinitfirst->letrecloopfaccfirstelt=letacc=facceltinletnext=Elt.nexteltinifphys_equalnextfirstthenaccelseloopfaccfirstnextinloopfinitfirstfirst);;letfoldi_eltt~init~f=match!twith|None->init|Somefirst->Header.with_iteration_3(Elt.headerfirst)finitfirst(funfinitfirst->letrecloopfiaccfirstelt=letacc=fiacceltinletnext=Elt.nexteltinifphys_equalnextfirstthenaccelseloopf(i+1)accfirstnextinloopf0initfirstfirst);;letfold_elt_1t~init~fa=match!twith|None->init|Somefirst->Header.with_iteration_4(Elt.headerfirst)fainitfirst(funfainitfirst->letrecloopfaaccfirstelt=letacc=faacceltinletnext=Elt.nexteltinifphys_equalnextfirstthenaccelseloopfaaccfirstnextinloopfainitfirstfirst);;letfoldi_elt_1t~init~fa=match!twith|None->init|Somefirst->Header.with_iteration_4(Elt.headerfirst)fainitfirst(funfainitfirst->letrecloopfiaaccfirstelt=letacc=fiaacceltinletnext=Elt.nexteltinifphys_equalnextfirstthenaccelseloopf(i+1)aaccfirstnextinloopf0ainitfirstfirst);;letiter_eltt~f=fold_elt_1t~init:()~f:(funf()elt->felt)fletiteri_eltt~f=foldi_eltt~init:()~f:(funi()elt->fielt)openWith_returnletfind_eltt~f=with_return(funr->fold_elt_1tf~init:()~f:(funf()elt->iff(Elt.valueelt)thenr.return(Someelt));None);;letfindi_eltt~f=with_return(funr->foldi_elt_1tf~init:()~f:(funif()elt->iffi(Elt.valueelt)thenr.return(Some(i,elt)));None);;(* this function is lambda lifted for performance, to make direct recursive calls instead
of calls through its closure. It also avoids the initial closure allocation. *)letreciter_loopfirstfelt=f(Elt.valueelt);letnext=Elt.nexteltinifnot(phys_equalnextfirst)theniter_loopfirstfnext;;letitert~f=match!twith|None->()|Somefirst->Header.with_iteration_2(Elt.headerfirst)firstf(funfirstf->iter_loopfirstffirst);;letlengtht=match!twith|None->0|Somefirst->Header.length(Elt.headerfirst);;letreciteri_loopfirstfielt=fi(Elt.valueelt);letnext=Elt.nexteltinifnot(phys_equalnextfirst)theniteri_loopfirstf(i+1)next;;letiterit~f=match!twith|None->()|Somefirst->Header.with_iteration_2(Elt.headerfirst)firstf(funfirstf->iteri_loopfirstf0first);;letfoldit~init~f=foldi_elt_1t~initf~f:(funifaccelt->fiacc(Elt.valueelt));;moduleC=Container.Make(structtypenonrec'at='atletfoldt~init~f=fold_elt_1t~initf~f:(funfaccelt->facc(Elt.valueelt))letiter=`Customiterletlength=`Customlengthend)letcount=C.countletsum=C.sumletexists=C.existsletfind=C.findletfind_map=C.find_mapletfold=C.foldletfor_all=C.for_allletmem=C.memletto_array=C.to_arrayletmin_elt=C.min_eltletmax_elt=C.max_eltletfold_result=C.fold_resultletfold_until=C.fold_untilletunchecked_itert~f=match!twith|None->()|Somefirst->letreclooptfelt=f(Elt.valueelt);letnext=Elt.nexteltinmatch!twith(* the first element of the bag may have been changed by [f] *)|None->()|Somefirst->ifnot(phys_equalfirstnext)thenlooptfnextinlooptffirst;;letis_emptyt=Option.is_none!t(* more efficient than what Container.Make returns *)letfold_rightt~init~f=match!twith|None->init|Somefirst->Header.with_iteration_3(Elt.headerfirst)finitfirst(funfinitfirst->letrecloopfaccelt=letprev=Elt.preveltinletacc=f(Elt.valueprev)accinifphys_equalprevfirstthenaccelseloopfaccprevinloopfinitfirst);;letfold_right_eltt~init~f=match!twith|None->init|Somefirst->Header.with_iteration_3(Elt.headerfirst)finitfirst(funfinitfirst->letrecloopfaccelt=letprev=Elt.preveltinletacc=fprevaccinifphys_equalprevfirstthenaccelseloopfaccprevinloopfinitfirst);;letto_listt=fold_rightt~init:[]~f:(funxtl->x::tl)letsexp_of_tsexp_of_at=List.sexp_of_tsexp_of_a(to_listt)lett_of_sexpa_of_sexps=of_list(List.t_of_sexpa_of_sexps)letcopyt=of_list(to_listt)letcleart=t:=Noneletcomparecompare_eltt1t2=match!t1,!t2with|None,None->0|None,_->-1|_,None->1|Somef1,Somef2->Header.with_iteration_3(Elt.headerf1)compare_eltf1f2(funcompare_eltf1f2->Header.with_iteration_3(Elt.headerf2)compare_eltf1f2(funcompare_eltf1f2->letrecloopcompare_eltelt1f1elt2f2=letcompare_result=compare_elt(Elt.valueelt1)(Elt.valueelt2)inifcompare_result<>0thencompare_resultelse(letnext1=Elt.nextelt1inletnext2=Elt.nextelt2inmatchphys_equalnext1f1,phys_equalnext2f2with|true,true->0|true,false->-1|false,true->1|false,false->loopcompare_eltnext1f1next2f2)inloopcompare_eltf1f1f2f2));;exceptionTransfer_src_and_dst_are_same_listlettransfer~src~dst=ifphys_equalsrcdstthenraiseTransfer_src_and_dst_are_same_list;match!srcwith|None->()|Somesrc_head->(match!dstwith|None->dst:=Somesrc_head;clearsrc|Somedst_head->(matchHeader.merge(Elt.headersrc_head)(Elt.headerdst_head)with|`Same_already->raiseTransfer_src_and_dst_are_same_list|`Merged->Elt.split_or_splice_beforedst_headsrc_head;clearsrc));;letmap_inplacet~f=iter_eltt~f:(funelt->Elt.setelt(f(Elt.valueelt)))letmapi_inplacet~f=iteri_eltt~f:(funielt->Elt.setelt(fi(Elt.valueelt)))letremove_listtto_remove=List.iterto_remove~f:(funelt->(match!twith|None->()|Somehead->ifElt.equalheadeltthen(letnext_elt=Elt.nexteltint:=ifElt.equalheadnext_eltthenNoneelseSomenext_elt));Elt.unlinkelt);;letfilter_inplacet~f=letto_remove=List.rev(fold_eltt~init:[]~f:(funeltselt->iff(Elt.valueelt)theneltselseelt::elts))inremove_listtto_remove;;letfilteri_inplacet~f=letto_remove=List.rev(foldi_eltt~init:[]~f:(funieltselt->iffi(Elt.valueelt)theneltselseelt::elts))inremove_listtto_remove;;letfilter_map_inplacet~f=letto_remove=List.rev(fold_eltt~init:[]~f:(funeltselt->matchf(Elt.valueelt)with|None->elt::elts|Somevalue->Elt.seteltvalue;elts))inremove_listtto_remove;;letfilter_mapi_inplacet~f=letto_remove=List.rev(foldi_eltt~init:[]~f:(funieltselt->matchfi(Elt.valueelt)with|None->elt::elts|Somevalue->Elt.seteltvalue;elts))inremove_listtto_remove;;exceptionElt_does_not_belong_to_listletfirst_eltt=!tletlast_eltt=Option.map~f:Elt.prev!tletfirstt=Option.map~f:Elt.value(first_eltt)letlastt=Option.map~f:Elt.value(last_eltt)letis_firsttelt=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifHeader.equal(Elt.headerfirst)(Elt.headerelt)thenElt.equaleltfirstelseraiseElt_does_not_belong_to_list;;letis_lasttelt=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifHeader.equal(Elt.headerfirst)(Elt.headerelt)then(letlast=Elt.prevfirstinElt.equaleltlast)elseraiseElt_does_not_belong_to_list;;letmem_elttelt=match!twith|None->false|Somefirst->Header.equal(Elt.headerfirst)(Elt.headerelt);;letprevtelt=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifElt.equaleltfirstthenNoneelseifHeader.equal(Elt.headerfirst)(Elt.headerelt)thenSome(Elt.prevelt)elseraiseElt_does_not_belong_to_list;;letnexttelt=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->letlast=Elt.prevfirstinifElt.equaleltlastthenNoneelseifHeader.equal(Elt.headerfirst)(Elt.headerelt)thenSome(Elt.nextelt)elseraiseElt_does_not_belong_to_list;;letinsert_afterteltv=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifHeader.equal(Elt.headerfirst)(Elt.headerelt)thenElt.insert_aftereltvelseraiseElt_does_not_belong_to_list;;letinsert_beforeteltv=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifElt.equaleltfirstthen(letnew_elt=Elt.insert_beforefirstvint:=Somenew_elt;new_elt)elseifHeader.equal(Elt.headerfirst)(Elt.headerelt)thenElt.insert_beforeeltvelseraiseElt_does_not_belong_to_list;;letinsert_emptytv=letnew_elt=Elt.createvint:=Somenew_elt;new_elt;;letinsert_lasttv=match!twith|None->insert_emptytv|Somefirst->Elt.insert_beforefirstv;;letinsert_firsttv=match!twith|None->insert_emptytv|Somefirst->letnew_elt=Elt.insert_beforefirstvint:=Somenew_elt;new_elt;;letremove_lastt=match!twith|None->None|Somefirst->letlast=Elt.unlink_beforefirstinifElt.equalfirstlastthent:=None;Some(Elt.valuelast);;letremove_firstt=match!twith|None->None|Somefirst->letsecond=Elt.nextfirstinElt.unlinkfirst;t:=ifElt.equalfirstsecondthenNoneelseSomesecond;Some(Elt.valuefirst);;letremovetelt=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifElt.equaleltfirstthenignore(remove_firstt:_option)elseifHeader.equal(Elt.headerfirst)(Elt.headerelt)thenElt.unlinkeltelseraiseElt_does_not_belong_to_list;;letfiltert~f=letnew_t=create()in(match!twith|None->()|Somefirst->Header.with_iteration_3(Elt.headerfirst)fnew_tfirst(funfnew_tfirst->letrecloopfnew_tfirstelt=iff(Elt.valueelt)theninsert_lastnew_t(Elt.valueelt)|>(ignore:_Elt.t->unit);letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopfnew_tfirstnextinloopfnew_tfirstfirst));new_t;;letfilterit~f=letnew_t=create()in(match!twith|None->()|Somefirst->Header.with_iteration_3(Elt.headerfirst)fnew_tfirst(funfnew_tfirst->letrecloopfinew_tfirstelt=iffi(Elt.valueelt)theninsert_lastnew_t(Elt.valueelt)|>(ignore:_Elt.t->unit);letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopf(i+1)new_tfirstnextinloopf0new_tfirstfirst));new_t;;letfilter_mapt~f=letnew_t=create()in(match!twith|None->()|Somefirst->Header.with_iteration_3(Elt.headerfirst)fnew_tfirst(funfnew_tfirst->letrecloopfnew_tfirstelt=(matchf(Elt.valueelt)with|None->()|Somevalue->insert_lastnew_tvalue|>(ignore:_Elt.t->unit));letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopfnew_tfirstnextinloopfnew_tfirstfirst));new_t;;letfilter_mapit~f=letnew_t=create()in(match!twith|None->()|Somefirst->Header.with_iteration_3(Elt.headerfirst)fnew_tfirst(funfnew_tfirst->letrecloopfinew_tfirstelt=(matchfi(Elt.valueelt)with|None->()|Somevalue->insert_lastnew_tvalue|>(ignore:_Elt.t->unit));letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopf(i+1)new_tfirstnextinloopf0new_tfirstfirst));new_t;;letpartition_tft~f=lett1=create()inlett2=create()in(match!twith|None->()|Somefirst->Header.with_iteration_4(Elt.headerfirst)ft1t2first(funft1t2first->letrecloopft1t2firstelt=insert_last(iff(Elt.valueelt)thent1elset2)(Elt.valueelt)|>(ignore:_Elt.t->unit);letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopft1t2firstnextinloopft1t2firstfirst));t1,t2;;letpartitioni_tft~f=lett1=create()inlett2=create()in(match!twith|None->()|Somefirst->Header.with_iteration_4(Elt.headerfirst)ft1t2first(funft1t2first->letrecloopfit1t2firstelt=insert_last(iffi(Elt.valueelt)thent1elset2)(Elt.valueelt)|>(ignore:_Elt.t->unit);letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopf(i+1)t1t2firstnextinloopf0t1t2firstfirst));t1,t2;;letpartition_mapt~f=lett1=create()inlett2=create()in(match!twith|None->()|Somefirst->Header.with_iteration_4(Elt.headerfirst)ft1t2first(funft1t2first->letrecloopft1t2firstelt=(match(f(Elt.valueelt):(_,_)Either.t)with|Firstvalue->insert_lastt1value|>(ignore:_Elt.t->unit)|Secondvalue->insert_lastt2value|>(ignore:_Elt.t->unit));letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopft1t2firstnextinloopft1t2firstfirst));t1,t2;;letpartition_mapit~f=lett1=create()inlett2=create()in(match!twith|None->()|Somefirst->Header.with_iteration_4(Elt.headerfirst)ft1t2first(funft1t2first->letrecloopfit1t2firstelt=(match(fi(Elt.valueelt):(_,_)Either.t)with|Firstvalue->insert_lastt1value|>(ignore:_Elt.t->unit)|Secondvalue->insert_lastt2value|>(ignore:_Elt.t->unit));letnext=Elt.nexteltinifnot(phys_equalnextfirst)thenloopf(i+1)t1t2firstnextinloopf0t1t2firstfirst));t1,t2;;exceptionInvalid_move__elt_equals_anchorletmove_beforetelt~anchor=ifElt.equalanchoreltthenraiseInvalid_move__elt_equals_anchor;ifHeader.equal(Elt.headeranchor)(Elt.headerelt)then(match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifHeader.equal(Elt.headerfirst)(Elt.headerelt)then((* unlink [elt] *)letafter_elt=Elt.nexteltinElt.split_or_splice_beforeeltafter_elt;letfirst=ifElt.equalfirsteltthen(t:=Someafter_elt;after_elt)elsefirstin(* splice [elt] in before [anchor] *)Elt.split_or_splice_beforeanchorelt;ifElt.equalfirstanchorthent:=Someelt)elseraiseElt_does_not_belong_to_list)elseraiseElt_does_not_belong_to_list;;letmove_to_fronttelt=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifnot(Elt.equaleltfirst)thenmove_beforetelt~anchor:first;;letmove_aftertelt~anchor=ifElt.equalanchoreltthenraiseInvalid_move__elt_equals_anchor;ifHeader.equal(Elt.headeranchor)(Elt.headerelt)then(match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->ifHeader.equal(Elt.headerfirst)(Elt.headerelt)then((* unlink [elt] *)letafter_elt=Elt.nexteltinElt.split_or_splice_beforeeltafter_elt;ifElt.equalfirsteltthent:=Someafter_elt;(* splice [elt] in after [anchor] *)Elt.split_or_splice_afteranchorelt)elseraiseElt_does_not_belong_to_list)elseraiseElt_does_not_belong_to_list;;letmove_to_backtelt=match!twith|None->raiseElt_does_not_belong_to_list|Somefirst->letlast=Elt.prevfirstinifnot(Elt.equaleltlast)thenmove_aftertelt~anchor:last;;letto_sequencet=to_listt|>Sequence.of_list