open SequenceSig 

(*-----------------------------------------------------------------------------*)

module Make 
   (Chunk : SequenceSig.FixedCapacityS)
   (Middle : SequenceSig.S) =
struct


(*-----------------------------------------------------------------------------*)

(** Representation *)

type 'a t = {
  mutable front_outer : 'a Chunk.t;
  mutable front_inner : 'a Chunk.t;
  mutable middle : ('a Chunk.t) Middle.t;
  mutable back_inner : 'a Chunk.t;
  mutable back_outer : 'a Chunk.t; }

(** Creation *)

let create () = {
   front_outer = Chunk.create();
   front_inner = Chunk.create();
   middle = Middle.create();
   back_inner = Chunk.create();
   back_outer = Chunk.create(); }

(** Emptiness test *)    
  
let is_empty s =
     Chunk.is_empty s.front_outer
  && Chunk.is_empty s.front_inner
  && Middle.is_empty s.middle
  && Chunk.is_empty s.back_inner
  && Chunk.is_empty s.back_outer

(** Push front *)

let push_front x s =
   let co = s.front_outer in
   if Chunk.is_full co then begin
      let ci = s.front_inner in
      s.front_inner <- co;
      if Chunk.is_empty ci then begin
         s.front_outer <- ci;
      end else begin
         Middle.push_front ci s.middle;
         s.front_outer <- Chunk.create();
      end 
   end;
   Chunk.push_front x s.front_outer

(** Push back *)

let push_back x s =
   let co = s.back_outer in
   if Chunk.is_full co then begin
      let ci = s.back_inner in
      s.back_inner <- co;
      if Chunk.is_empty ci then begin
         s.back_outer <- ci;
      end else begin
         Middle.push_back ci s.middle;
         s.back_outer <- Chunk.create();
      end 
   end;
   Chunk.push_back x s.back_outer

(** Pop front *)

let pop_front s =
   let co = s.front_outer in
   if not (Chunk.is_empty co) then begin
      Chunk.pop_front co
   end else begin
      let ci = s.front_inner in
      let m = s.middle in
      if not (Chunk.is_empty ci) then begin
         s.front_outer <- ci;
         s.front_inner <- co;
         Chunk.pop_front s.front_outer
      end else if not (Middle.is_empty m) then begin
         s.front_outer <- Middle.pop_front m;
         Chunk.pop_front s.front_outer
      end else if not (Chunk.is_empty s.back_inner) then begin
         s.front_outer <- s.back_inner;
         s.back_inner <- co;
         Chunk.pop_front s.front_outer
      end else begin
         Chunk.pop_front s.back_outer
      end
   end

(** Pop back *)

let pop_back s =
   let co = s.back_outer in
   if not (Chunk.is_empty co) then begin
      Chunk.pop_back co
   end else begin
      let ci = s.back_inner in
      let m = s.middle in
      if not (Chunk.is_empty ci) then begin
         s.back_outer <- ci;
         s.back_inner <- co;
         Chunk.pop_back s.back_outer
      end else if not (Middle.is_empty m) then begin
         s.back_outer <- Middle.pop_back m;
         Chunk.pop_back s.back_outer
      end else if not (Chunk.is_empty s.front_inner) then begin
         s.back_outer <- s.front_inner;
         s.front_inner <- co;
         Chunk.pop_back s.back_outer
      end else begin
         Chunk.pop_back s.front_outer
      end
   end
 
(** Push a buffer to the back of the middle sequence, 
    possibly merging it with the back chunk in the middle sequence *)

let middle_merge_back m c =
   let sc = Chunk.length c in
   if sc > 0 then begin
      if Middle.is_empty m then begin
         Middle.push_back c m
      end else begin
         let b = Middle.pop_back m in
         let sb = Chunk.length b in
         if sc + sb > Chunk.capacity then begin
            Middle.push_back b m;
            Middle.push_back c m
         end else begin
            Chunk.append b c;
            Middle.push_back b m;
         end
      end
   end

(** Symmetric to middle_merge_back *)

let middle_merge_front m c =
   let sc = Chunk.length c in
   if sc > 0 then begin
      if Middle.is_empty m then begin
         Middle.push_front c m
      end else begin
         let b = Middle.pop_front m in
         let sb = Chunk.length b in
         if sc + sb > Chunk.capacity then begin
            Middle.push_front b m;
            Middle.push_front c m
         end else begin
            Chunk.append c b;
            Middle.push_front c m;
         end
      end
   end

(** Append to the back of s1 the items of s2; s2 becomes invalid *)

let append s1 s2 =
   let m1 = s1.middle in
   let ci = s1.back_inner in
   let co = s1.back_outer in
   if Chunk.is_empty ci then begin
      middle_merge_back m1 co
   end else begin
      Middle.push_back ci m1;
      if not (Chunk.is_empty co)
         then Middle.push_back co m1;
   end;
   let m2 = s2.middle in
   let fi = s2.front_inner in
   let fo = s2.front_outer in
   if Chunk.is_empty fi then begin
      middle_merge_front m2 fo
   end else begin
      Middle.push_front fi m2;
      if not (Chunk.is_empty fo)
         then Middle.push_front fo m2;
   end;
   s1.back_inner <- s2.back_inner;
   s1.back_outer <- s2.back_outer;
   if   not (Middle.is_empty m1)
     && not (Middle.is_empty m2) then begin
      let c1 = Middle.pop_back m1 in
      let sc1 = Chunk.length c1 in
      let c2 = Middle.pop_front m2 in
      let sc2 = Chunk.length c2 in
      if sc1 + sc2 > Chunk.capacity then begin
         Middle.push_back c1 m1;
         Middle.push_front c2 m2;
      end else begin
         Chunk.append c1 c2;
         Middle.push_back c1 m1;
      end
   end;
   Middle.append m1 m2

end