moduleQuickQueueFunctor (Q : Prioqueue.CYCLE_QUEUE) : (Prioqueue.PRIOQUEUE)=struct (* this is here only because of tester. you can delete fhis line, if you won't be using PRIOQUEUE module type, because Q.priority is used instead *)typepriority=inttype'a t=Nodeof'a node|Leafof'a Q.queueand'a node={priority : priority;left : 'a t ref;right : 'a t ref;}(* A lot of code here is imperative, and so the queue itself is temporary, it changes in time, unlike fully functional data structures *)type'a queue=Rootof'a Q.queue ref*'a t ref (* this code might look better if translated into objects... for future *) (* for sake of my sanity - i declare to all thou readers, all functins available outside this module take no references as parameters. BUT! it doesn't mean, that objects passed as their parameters do preserve their status quo. mostly they do change and propably become useless. only funtions results are proper *)letempty()=letq=ref(Q.empty())inRoot(q, ref(Leaf!q))exceptionUnproper_use_of_queueletis_empty=functionRoot(_, q)->match!qwithLeaf p->Q.is_empty p|_->falseexceptionQueue_is_full (* Tricky come's into action! *) (* sometimes I wonder how come this code works... *) (* ---------- I N S E R T ----------- *)letinsert=fun(Root(min,que))p a->(* takes a leaf reference and divides it into a node and dwo leafs *)letdivide nod=(function(prio, l, r)->Node{priority=prio;left=ref(Leaf l);right=ref(Leaf r);})(Q.divide(match!(nod)withLeaf q->q|_->raiseUnproper_use_of_queue))(* when dividing most left leaf and afterwards if inserting not into new most left leaf, ins doesnt remember that most left leaf was changed *)anddivided_most_left_leaf nod=match!(nod)withNode e->beginmatch!(e.left)withLeaf q->(ref q, true)|_->raiseUnproper_use_of_queueend|_->raiseUnproper_use_of_queuein(* returns reference to cycle queue into whitch it added new element *) (* first parameter is where it should insert, second is if most left leaf was changed *)letins nodi mmi=letrecrec_ins nd mm=beginmatch!ndwithLeaf q->begin(ref(Q.insert q p a), mm);(* might end with an exception *)end|Node nod->ifp<nod.prioritythentryrec_ins nod.left mmwithQ.Queue_is_full->(* so nod.left is a leaf! *)beginnod.left:=divide nod.left;letins_result=rec_ins nod.left mminifmmthendivided_most_left_leaf nod.leftelseins_resultendelsetryrec_ins nod.right falsewithQ.Queue_is_full->(* so nod.right is a leaf! *)beginnod.right:=divide nod.right;rec_ins nod.right false;endendintryrec_ins nodi mmiwithQ.Queue_is_full->(* so ins was taken on a leaf at first *)beginnodi:=divide nodi;let_=rec_ins nodi trueindivided_most_left_leaf nodiend;inlet(new_min, modified_min)=ins que truein(* now it's time to check if the minimum has changed *)ifmodified_minthenRoot(new_min, que)elseRoot(min, que)(* take last updated and check if it's a minimum *) (* ----- end of I N S E R T ------- *)exceptionQueue_is_empty (* ---- D E L E T E M I N ----- *)letrecdelete_min=letrecgive_most_left_node q=match!qwithLeaf_->raiseQueue_is_empty|Node n->match!(n.left)withLeaf_->q|_->give_most_left_node n.leftin(* erase most left leaf from the tree (rearranging nodes) and return reference to new most left leaf *)letrecrebuild q=letnod=give_most_left_node qinmatch!nodwithNode n->beginnod:=!(n.right);(* leaf erased. now let's find another min *)match!nodwithLeaf_->nod|Node m->trymatch!(give_most_left_node nod)withNode e->e.left|_->raiseUnproper_use_of_queuewithQueue_is_empty->nodend|_->raiseUnproper_use_of_queueinfunction(Root(min,que))->trylet(p, e,_)=Q.delete_min!minin(* the idea of this part is that min should never be empty, if que is not just a leaf *)match!quewithLeaf_->(p, e, Root(min,que))|_->beginifQ.is_empty!minthen(* so we have an empty min with, let's rebuild *)letnew_min=rebuild queinmatch!new_minwithLeaf c->(p, e, Root(ref c, que))|_->raiseUnproper_use_of_queueelse(* min isn't empty *)(p, e, Root(min,que))endwithQ.Queue_is_empty->(* if queue is really empty en exception will be raised: se fuction give_most_left_node *)letnew_min=rebuild queinmatch!new_minwithLeaf c->delete_min(Root(ref c, que))|_->raiseUnproper_use_of_queue (* --- end of D E L E T E M I N --- *)letfind_min=function(Root(min,que))->((function((p, e,_), q)->(p, e, q))((Q.find_min!min), Root(min,que)))letrecunion q1 q2=ifis_empty q2thenq1else(function(p, e, q)->union(insert q1 p e)q)(delete_min q2)end (* todo -> parameter names *)