module CycleQueueFunctor = functor (S : Prioqueue.SIZE) ->
struct

  type priority = int
  (* tablice wpf.pdf str. 95 *)

  type 'a element =
    | None
    | Elem of 'a t
  and 'a t = {
    priority: priority;
    element: 'a;
  }

  type 'a queue = {
    vector: ('a element) array;
    first: int ref;
    elements: int ref;
  }

  let empty () = {
    vector = Array.make S.size None;
    first = ref 0;
    elements = ref 0;
  }

  let is_empty q = !(q.elements) = 0

  exception Queue_is_full

  exception Unproper_use_of_queue

  let rec insert q p a =
    if !(q.elements) < S.size then
      let e = { priority = p; element = a} in
          match q.vector.(!(q.first )) with
              Elem el ->
                if ( e.priority < el.priority ) then
                  begin
                    q.first := ( !(q.first) - 1) mod S.size;
                    if !(q.first) < 0 then
                      q.first := !(q.first) + S.size;
                    q.vector.(!(q.first)) <- Elem e;
                    q.elements := !(q.elements) + 1;
                    q
                  end
                else
                  begin
                    let t1 = ref e
                    and t2 = ref e
                    and j = ref 0 in
                      for i = !(q.first) to !(q.first) + !(q.elements) do
                        j := i mod S.size;
                        match q.vector.(!j) with
                            Elem e -> if ( (!t1).priority < e.priority ) then
                              begin
                                t2 := e;
                                q.vector.(!j) <- Elem !t1;
                                t1 := !t2;
                              end
                                (* ok, so it should really be the last element... *)
                          | None -> q.vector.(!j) <- Elem !t1;
                      done;
                      q.elements := !(q.elements) + 1;
                      q
                  end
            | None ->
                begin
                  q.vector.(!(q.first)) <- Elem e;
                  q.elements := 1;
                  q
                end
    else raise Queue_is_full

  exception Queue_is_empty
  exception Queue_is_empty2

  let delete_min q =
    if ( !(q.elements) = 0 ) then
      raise Queue_is_empty
    else match q.vector.(!(q.first)) with
        None -> raise Unproper_use_of_queue  (*  <- this really should never occur *)
      | Elem e ->
          begin
            q.vector.(!(q.first)) <- None;
            q.elements := !(q.elements) - 1;
            q.first := (!(q.first) + 1) mod S.size;
            ( e.priority, e.element, q);
          end

  let find_min q =
    if ( !(q.elements) = 0 ) then
      raise Queue_is_empty
    else match q.vector.(!(q.first)) with
        None -> raise Unproper_use_of_queue  (*  <- this really should never occur *)
      | Elem e -> ( e.priority, e.element, q)


  (* divides queue into two *)
  let divide q =
    let rec insert_and_remove from_q to_q count =
      if count > 0 then
        let (p, e, from_q) = delete_min from_q in
          insert_and_remove from_q (insert to_q p e) (count - 1)
      else
        (from_q, to_q)
    in
    let q1 = empty()
    and q2 = empty()
    in
    let (q_t, q1) = insert_and_remove q q1 (!(q.elements) / 2)
    in
    let (_, q2) = insert_and_remove q_t q2 !(q.elements)
    in
      match q2.vector.(!(q2.first)) with
          Elem e -> (e.priority , q1, q2)
        | _      -> raise Unproper_use_of_queue  (*  <- this really should never occur *)


(*       begin *)
(*      for i = !(q.first) to !(q.elements) / 2 do *)
(*        q1.vector.((i - !(q.first)) mod S.size) <- q.vector.(i mod S.size); *)
(*      done; *)
(*      for i = !(q.elements)/2 + 1 to !(q.elements) - 1 do  *)
(*        q2.vector.((i - !(q.elements)/2 + 1) mod S.size) <- q.vector.(i mod S.size); *)
(*      done; *)
(*      match q2.vector.(0) with  *)
(*          Elem e -> (e.priority, q1, q2)  *)
(*        | _      -> raise Unproper_use_of_queue  (\*  <- this really should never occur *\) *)
(*       end *)

end