(* An implementation of Confluently Persistent Catenable Dequeues, as
   described in the paper:

   Kaplan, Haim, and Chris Okasaki, and Robert E. Tarjan. Simple
   Confluently Persistent Catenable Lists (1998). Draft.
   Currently available at:
   http://www.research.att.com/~hkl/papers/implicitJ.ps

   CPCDs are fully persistent data structures for lists which provide
   addition, removal, and inspection of elements at both ends as well
   as concatenation of two lists, all in amortized constant time.

   For latest version see: http://moonflare.com/code/cpcd/cpcd.php

   Copyright (c) 2003, Derrick Coetzee
   All rights reserved.

   Redistribution and use in source and binary forms, with or without
   modification, are permitted provided that the following conditions
   are met:

   - Redistributions of source code must retain the above copyright
     notice, this list of conditions and the following disclaimer.

   - Redistributions in binary form must reproduce the above copyright
     notice, this list of conditions and the following disclaimer in
     the documentation and/or other materials provided with the
     distribution.

   - The name of Derrick Coetzee may not be used to endorse or promote
     products derived from this software without specific prior
     written permission.

   This software is provided by the copyright holders and contributors
   "as is" and any express or implied warranties, including, but not
   limited to, the implied warranties of merchantability and fitness
   for a particular purpose are disclaimed. In no event shall the
   copyright owner or contributors be liable for any direct, indirect,
   incidental, special, exemplary, or consequential damages
   (including, but not limited to, procurement of substitute goods or
   services; loss of use, data, or profits; or business interruption)
   however caused and on any theory of liability, whether in contract,
   strict liability, or tort (including negligence or otherwise)
   arising in any way out of the use of this software, even if advised
   of the possibility of such damage.
*)

structure CPCD : sig

(* The deque structure, representing a CPCD of elements of some type 'a.
   The full datatype is exported so that users can pattern-match on EmptyDeque. *)
datatype 'a deque =
	 EmptyDeque
       | Deque of {prefix: 'a ElemOrTriple list ref, (* length 3 to 6 *)
                   left:   'a deque ref,  (* 'a should be made by EOTTriple here *)
		   middle: 'a ElemOrTriple list ref, (* length 2 *)
		   right:  'a deque ref, (* 'a should be made by EOTTriple here *)
		   suffix: 'a ElemOrTriple list ref  (* length 3 to 6, or 1 to 8 when
					                all other fields are empty *)}
(* Need this to do non-uniform recursion *)
and 'a ElemOrTriple = Elem of 'a
		    | Triple of
		      (* first middle buffer, length 0/2/3 *)
		      'a ElemOrTriple list * 
		      (* 'a should be EOTTriple here *)
		      'a deque * 
		      (* last middle buffer, length 0/2/3 *)
		      'a ElemOrTriple list

(* Determines if a deque is empty (O(1)) *)
val null : 'a deque -> bool

(* Determines number of elements in the deque (O(n), n = deque size) *)
val length : 'a deque -> int

(* Gets element at front of a deque (O(1)). If also removing, use pop instead. *)
val hd : 'a deque -> 'a

(* Gets element at end of a deque (O(1)). If also removing, use eject instead. *)
val last : 'a deque -> 'a

(* Gets element at a zero-based index from the beginning of a deque
   (O(n), n=deque size). *)
val nth : ('a deque) * int -> 'a

(* Gets first n elements of the deque as a deque. (O(n), n=argument). *)
val take : ('a deque) * int -> 'a deque

(* Gets deque with first n elements removed. (O(n), n=argument). *)
val drop : ('a deque) * int -> 'a deque

(* Gets last n elements of the deque as a deque. (O(n), n=argument). *)
val takeEnd : ('a deque) * int -> 'a deque

(* Gets deque with last n elements removed. (O(n), n=argument). *)
val dropEnd : ('a deque) * int -> 'a deque

(* Adds an element to the front of a deque, gives the resulting deque (amortized O(1)) *)
val push : 'a * ('a deque) -> 'a deque

(* Convenient alias for push (ex. elem1::elem2::elem3::EmptyDeque) *)
val :: : 'a * ('a deque) -> 'a deque

(* Adds an element to the end of a deque, gives the resulting deque (amortized O(1)) *)
val inject : 'a * ('a deque) -> 'a deque

(* Convenient alias for inject (ex. EmptyDeque @@ elem1 @@ elem2 @@ elem3) *)
val @@ : ('a deque) * 'a -> 'a deque

(* Concatenates two deques into one resulting deque (amortized O(1)) *)
val @ : ('a deque) * ('a deque) -> 'a deque

(* Given a queue q1, returns a pair (x,q2), where x is the element
   at the front of q1, and q2 is q1 with x removed from the front. *)
val pop : 'a deque -> 'a * ('a deque)

(* Gives the given queue with the first element removed (amortized O(1)). *)
val tl : 'a deque -> 'a deque

(* Gives the given queue with the last element removed (amortized O(1)). *)
val dropLast : 'a deque -> 'a deque

(* Given a queue q1, returns a pair (x,q2), where x is the element
   at the end of q1, and q2 is q1 with x removed from the end. *)
val eject : 'a deque -> 'a * ('a deque)

(* Applies a function returning unit to each element of the queue in
   order (O(n), n=deque size). *)
val app : ('a -> unit) -> 'a deque -> unit

(* Applies a function returning unit to each element of the queue in
   reverse order (O(n), n=deque size). *)
val appRev : ('a -> unit) -> 'a deque -> unit

(* Equivalent to List.foldl f init (CPCD.toList q), but with no space use.
   (time O(n), n=deque size). *)
val foldl : ('a * 'b -> 'b) -> 'b -> 'a deque -> 'b

(* Equivalent to List.foldr f init (CPCD.toList q), but with no space use.
   (time O(n), n=deque size). *)
val foldr : ('a * 'b -> 'b) -> 'b -> 'a deque -> 'b

(* Equivalent to List.map f init (CPCD.toList q), but with no space use.
   (time O(n), n=deque size). *)
val map : ('a -> 'b) -> 'a deque -> 'b deque

(* Makes a deque containing this list's contents in order. (O(n), n=list size) *)
val fromList : 'a list -> 'a deque

(* Makes a list containing this deque's contents in order. (O(n), n=deque size) *)
val toList : 'a deque -> 'a list

(* Evaluates f for each element of the queue in order, returning SOME x
   for the first one it returns true for, or NONE if it never does.
   (worst-case time O(n), n=deque size). *)
val find : ('a -> bool) -> 'a deque -> 'a option

(* Evaluates f for each element of the queue in reverse order,
   returning SOME x for the first one it returns true for, or NONE if
   it never does. (worst-case time O(n), n=deque size). *)
val findLast : ('a -> bool) -> 'a deque -> 'a option

(* Returns a queue containing the elements of this queue for which
   the given function returns true, in their original order
   (time O(n), n=deque size). *)
val filter : ('a -> bool) -> 'a deque -> 'a deque

(* Returns true only if f(e) returns true for some element e of a queue.
   (worst-case time O(n), n=deque size). *)
val exists : ('a -> bool) -> 'a deque -> bool

(* Returns true only if f(e) returns true for every element e of a queue.
   (worst-case time O(n), n=deque size). *)
val all : ('a -> bool) -> 'a deque -> bool

(* Returns a new deque with the same elements in the opposite order
   (O(n), n=deque size). *)
val rev : 'a deque -> 'a deque

(* Tests all list length conditions to make sure this is a valid
   queue, for testing. (O(n), n=deque size). *)
val isValid : 'a deque -> bool

(* Returns true iff deques have same elements in same order
   (O(n), n=mutual size of deques) *)
(*val = : ('a deque) * ('a deque) -> bool*)

(* Thrown if an internal value was found to have the wrong value (element/triple) *)
exception TypeError

end
= struct

exception TypeError

(* The deque structure, representing a CPCD of elements of some type 'a *)
datatype 'a deque =
	 EmptyDeque
       | Deque of {prefix: 'a ElemOrTriple list ref, (* length 3 to 6 *)
                   left:   'a deque ref,  (* 'a should be made by EOTTriple here *)
		   middle: 'a ElemOrTriple list ref, (* length 2 *)
		   right:  'a deque ref, (* 'a should be made by EOTTriple here *)
		   suffix: 'a ElemOrTriple list ref  (* length 3 to 6, or 1 to 8 when
					                all other fields are empty *)}
(* Need this to do non-uniform recursion *)
and 'a ElemOrTriple = Elem of 'a
		    | Triple of
		      (* first middle buffer, length 0/2/3 *)
		      'a ElemOrTriple list * 
		      (* 'a should be EOTTriple here *)
		      'a deque * 
		      (* last middle buffer, length 0/2/3 *)
		      'a ElemOrTriple list

(* Empty dequeue for exporting *)
val empty = EmptyDeque

(* Determines if a dequeue is empty *)
fun null(EmptyDeque) = true
  | null _           = false

(* Determines number of elements in the deque (O(n), n = deque size) *)
fun length(EmptyDeque) = 0
  | length(Deque{prefix,left,middle,right,suffix}) =
    eotListLength  (!prefix) +
    length         (!left)   +
    eotListLength  (!middle) + 
    length         (!right)  +
    eotListLength  (!suffix)

and lengthTriple (Elem(e)) = raise TypeError
  | lengthTriple (Triple(midBuf1, tripleDeque, midBuf2)) =
    eotListLength  midBuf1     +
    length         tripleDeque +
    eotListLength  midBuf2

and eotListLength([]) = 0
  | eotListLength(lst:'a ElemOrTriple list) =
    (* Lists are all of one type, so if hd is Elem, so is all *)
    case hd(lst)
     of Elem(x) => List.length lst
      | _       => List.foldl (fn(x,soFar)=>lengthTriple x + soFar) 0 lst

(* Gets a queue containing only the given element *)
fun singleton(element) =
    Deque {prefix = ref [],
	   left   = ref EmptyDeque,
	   middle = ref [],
	   right  = ref EmptyDeque,
	   suffix = ref [element]}

(* Takes all of a list except the last element *)
fun takeButLast(lst) =
    List.take(lst, (List.length lst)-1)

(* Adds an element to the front of a deque *)
fun pushInternal(newElement, EmptyDeque) = singleton(newElement)
(* Case 2 *)
  | pushInternal(newElement,
		 q as Deque{prefix=prefix as ref [],left,middle,right,suffix}) =
    if List.length (!suffix) < 8 then
	Deque {prefix=prefix,left=left,middle=middle,right=right,
	       suffix=ref(newElement::(!suffix)) }
    else
	(prefix := List.take(!suffix,3);
	 middle := [List.nth(!suffix,3), List.nth(!suffix,4)];
	 suffix := List.drop(!suffix,5);
	 pushInternal(newElement, q) (* simplified from paper *))

(* Case 1 *)
  | pushInternal(newElement,
		 Deque{prefix,left,middle,right,suffix}) =
    ((* 1) *)
     if List.length(!prefix) = 6 then
	 let val p'  = List.take(!prefix, 4)
	     val p'' = List.drop(!prefix, 4)
	 in
	     prefix := p';
	     left := pushInternal(Triple(p'', EmptyDeque, []), !left)
	 end
     else ();
     (* 2) *)
     Deque{prefix = ref(newElement::(!prefix)),
	   left=left, middle=middle, right=right, suffix=suffix})

(* Adds an element to the front of a deque and gives the resulting deque *)
fun push(newElement, queue) = pushInternal(Elem(newElement), queue)

fun op::(e, q) = push(e,q)

(* Adds an element to the front of a deque *)
fun injectInternal(newElement, EmptyDeque) = singleton(newElement)
(* Case 2 *)
  | injectInternal(newElement,
		 q as Deque{prefix=prefix as ref [],left,middle,right,suffix}) =
    if List.length (!suffix) < 8 then
	Deque {prefix=prefix,left=left,middle=middle,right=right,
	       suffix=ref((!suffix)@[newElement]) (*Arrays would make this faster*)}
    else
	(prefix := List.take(!suffix,3);
	 middle := [List.nth(!suffix,3), List.nth(!suffix,4)];
	 suffix := List.drop(!suffix,5);
	 injectInternal(newElement, q) (* simplified from paper *))

(* Case 1 *)
  | injectInternal(newElement,
		 Deque{prefix,left,middle,right,suffix}) =
    ((* 1) *)
     if List.length(!suffix) = 6 then
	 let val p'  = List.drop(!suffix, 2)
	     val p'' = List.take(!suffix, 2)
	 in
	     suffix := p';
	     right := injectInternal(Triple([], EmptyDeque, p''), !right)
	 end
     else ();
     (* 2) *)
     Deque{prefix = prefix, left=left, middle=middle, right=right,
	   suffix=ref((!suffix)@[newElement]) (*Arrays would make this faster*) })

fun inject(newElement, queue) = injectInternal(Elem(newElement), queue)

fun op@@(q,e) = inject(e,q)

(* Gets wrapped first element of a queue (O(1)) *)
fun firstInternal(EmptyDeque) = raise Empty
  | firstInternal(q as Deque{prefix=prefix as ref [],left,middle,right,suffix}) =
    List.hd(!suffix)
  | firstInternal(Deque{prefix,left,middle,right,suffix}) =
    List.hd(!prefix)

(* Gets first element of a queue (O(1)) *)
fun hd(q) = case firstInternal(q)
	     of Elem(e) => e
	      | _       => raise TypeError

(* Gets wrapped last element of a queue (O(1)) *)
fun lastInternal(EmptyDeque) = raise Empty
  | lastInternal(Deque{prefix,left,middle,right,suffix}) =
    List.last(!suffix)
(* Gets last element of a queue (O(1)) *)
fun last(q) = case lastInternal(q)
	       of Elem(e) => e
		| _       => raise TypeError

(* Concatenates two queues in O(1) amortized time *)
fun op@(q1, EmptyDeque) = q1
  | op@(EmptyDeque, q2) = q2
  | op@(q1 as Deque{prefix=ref [],suffix,...}, q2) =
    List.foldr (fn(element, qSoFar) => pushInternal(element, qSoFar)) q2 (!suffix)
  | op@(q1, q2 as Deque{prefix=ref [],suffix,...}) =
    List.foldl (fn(element, qSoFar) => injectInternal(element, qSoFar)) q1 (!suffix)
  | op@(q1 as Deque{prefix=prefix1,left=left1,middle=middle1,right=right1,suffix=suffix1},
	     q2 as Deque{prefix=prefix2,left=left2,middle=middle2,right=right2,suffix=suffix2}) =
    let (* Gets a number n such that either both n and i-n are 2 or 3,
           or n=i is 2 or 3. *)
	fun splitPoint(i) = if i <= 3 then i
			    else if i >= 5 then 3 else 2
	val newMiddle = [List.last(!suffix1), List.hd(!prefix2)]
	val suffix1SplitPoint = splitPoint(List.length (!suffix1) - 1)
	val suffix1left  = List.take(!suffix1, suffix1SplitPoint)
	val suffix1right = List.drop(takeButLast(!suffix1), suffix1SplitPoint)
	val newLeftLeft =
	    injectInternal(Triple(!middle1, !right1, suffix1left), !left1)
        val newLeft =
	    if List.length suffix1right = 0 then newLeftLeft
	    else injectInternal(Triple(suffix1right, EmptyDeque, []), newLeftLeft)
	val prefix2SplitPoint = (List.length (!prefix2)) -
				splitPoint(List.length (!prefix2) - 1)
	val prefix2left  = tl(List.take(!prefix2, prefix2SplitPoint))
	val prefix2right =    List.drop(!prefix2, prefix2SplitPoint)
	val newRightRight =
	    pushInternal(Triple(prefix2right, !left2, !middle2), !right2)
        val newRight =
	    if List.length prefix2left = 0 then newRightRight
	    else pushInternal(Triple(prefix2left, EmptyDeque, []), newRightRight)
    in
	Deque{prefix=prefix1,
	      left=ref newLeft,
	      middle=ref newMiddle,
	      right=ref newRight,
	      suffix=suffix2}
    end

(* Given a queue q1, returns a pair (x,q2), where x is at the front of q1,
   and q2 is q1 with x removed from the front. Naive because q2 may not be
   a valid deque  (a prefix may become too small). *)
fun naivePop(EmptyDeque) = raise Empty
  | naivePop(q as Deque{prefix=prefix as ref [],left,middle,right,suffix as ref [single]}) =
    (single, EmptyDeque)
  | naivePop(q as Deque{prefix=prefix as ref [],left,middle,right,suffix}) =
    (List.hd(!suffix),
     Deque {prefix=prefix,left=left,middle=middle,right=right,
	    suffix=ref(tl(!suffix)) })
  | naivePop(Deque{prefix,left,middle,right,suffix}) =
    (List.hd(!prefix),
     Deque {prefix=ref(tl(!prefix)),
	    left=left,middle=middle,right=right, suffix=suffix})

(* Given a queue q1, returns a pair (x,q2), where x is at the front of q1,
   and q2 is q1 with x removed from the front, and is valid. *)
fun popInternal(q as EmptyDeque) = naivePop(q)
  | popInternal(q as Deque{prefix=prefix as ref [],...}) = naivePop(q)
  | popInternal(q as Deque{prefix,left=ref EmptyDeque,middle,right=ref EmptyDeque,suffix}) =
    naivePop(if List.length (!prefix) > 3 then q else
    (* Case 3 *)
    (if List.length (!suffix) = 3 then
	 (* Turn into a suffix-only dequeue *)
	 Deque {prefix = ref [],
		left   = ref EmptyDeque,
		middle = ref [],
		right  = ref EmptyDeque,
		suffix = ref(List.concat[!prefix,!middle,!suffix])}
     else
	 (* Shift from middle to prefix and suffix to middle *)
	 (prefix := (List.@)(!prefix,[List.hd(!middle)]);
	  middle := (List.@)(tl(!middle),[List.hd(!suffix)]);
	  suffix := tl(!suffix);
	  q)))
  | popInternal(q as Deque{prefix,left=ref EmptyDeque,middle,right,suffix}) =
    naivePop(if List.length (!prefix) > 3 then q else
    (* Case 2 *)
    (let val (Triple(firstBuf,rightq,lastBuf), rightRest) =
	    case firstInternal(!right)
	     of Triple(firstBuf, rightq, lastBuf) =>
		if (List.length firstBuf = 3) orelse
		   (List.length firstBuf = 0 andalso List.length lastBuf = 3) orelse
		   (not (null rightq)) then
		    naivePop(!right)
		else
		    popInternal(!right)
	      | _ => raise TypeError
        (* If firstBuf empty, then so must be rightq, and we can reverse lastBuf
           and firstBuf safely to get firstBuf of positive length *)
	val (firstBuf, lastBuf) = if List.length firstBuf = 0 then
				      (lastBuf, firstBuf)
				  else (firstBuf, lastBuf)
    in
	if List.length firstBuf = 3 then
	    (* Case 2.1 *)
	    (prefix := (List.@)(!prefix, [List.hd(!middle)]);
	     middle := (List.@)(tl(!middle), [List.hd(firstBuf)]);
	     right  := pushInternal(Triple
			(tl(firstBuf), rightq, lastBuf), rightRest);
	     q)
	else
	    (* Case 2.2 *)
	    (prefix := (List.@)(!prefix,!middle);
	     middle := firstBuf;
	     right  := (if List.length lastBuf = 0 andalso null(rightq) then
			    rightRest
			else
			    let val t = Triple(lastBuf, EmptyDeque, [])
				val q = pushInternal(t, rightRest)
			    in
				rightq @ q
			    end);
	     q)
    end))
  | popInternal(q as Deque{prefix,left,middle,right,suffix}) =
    naivePop(if List.length (!prefix) > 3 then q else
    (* Case 1 *)
    let val (Triple(firstBuf,leftq,lastBuf), leftRest) =
	    case firstInternal(!left)
	     of Triple(firstBuf, leftq, lastBuf) =>
		if (List.length firstBuf = 3) orelse
		   (List.length firstBuf = 0 andalso List.length lastBuf = 3) orelse
		   (not (null leftq)) then
		    naivePop(!left)
		else
		    popInternal(!left)
	      | _ => raise TypeError

	(* If firstBuf empty, then so must be rightq, and we can reverse lastBuf
	   and firstBuf safely to get firstBuf of positive length *)
	val (firstBuf, lastBuf) = if List.length firstBuf = 0 then
				      (lastBuf, firstBuf)
				  else (firstBuf, lastBuf)
    in
	if List.length firstBuf = 3 then
	    (* Case 1.1 *)
	    (prefix := (List.@)(!prefix, [List.hd(firstBuf)]);
	     left   := pushInternal(Triple
			(tl(firstBuf), leftq, lastBuf), leftRest);
	     q)
	else
	    (* Case 1.2 *)
	    (prefix := (List.@)(!prefix,firstBuf);
	     left   := (if List.length lastBuf = 0 andalso null(leftq) then
			    leftRest
			else
			    let val t = Triple(lastBuf, EmptyDeque, [])
				val q = pushInternal(t, leftRest)
			    in
				leftq @ q
			    end);
	     q)
    end)

(* Given a queue q1, returns a pair (x,q2), where x is the stored data
   at the front of q1, and q2 is q1 with x removed from the front. *)
fun pop(queue) =
    case popInternal(queue)
     of (Elem(x),q) => (x,q)
      | _           => raise TypeError

(* Gives the given queue with the first element removed. *)
fun tl(q) = case pop(q) of (e,newq) => newq

(* Given a queue q1, returns a pair (x,q2), where x is at the end of q1,
   and q2 is q1 with x removed from the end. Naive because q2 may not be
   a valid deque (a suffix may become too small). *)
fun naiveEject(EmptyDeque) = raise Empty
  | naiveEject(q as Deque{prefix=prefix as ref [],left,middle,right,suffix as ref [single]}) =
    (single, EmptyDeque)
  | naiveEject(q as Deque{prefix,left,middle,right,suffix}) =
    (List.last(!suffix),
     Deque {prefix=prefix,left=left,middle=middle,right=right,
	    suffix=ref(takeButLast(!suffix))})

(* Given a queue q1, returns a pair (x,q2), where x is at the end of q1,
   and q2 is q1 with x removed from the end, and is valid. *)
fun ejectInternal(q as EmptyDeque) = naiveEject(q)
  | ejectInternal(q as Deque{prefix=prefix as ref [],...}) = naiveEject(q)
  | ejectInternal(q as Deque{prefix,left=ref EmptyDeque,middle,right=ref EmptyDeque,suffix}) =
    naiveEject(if List.length (!suffix) > 3 then q else
    (if List.length (!prefix) = 3 then
	 (* Turn into a suffix-only dequeue *)
	 Deque {prefix = ref [],
		left   = ref EmptyDeque,
		middle = ref [],
		right  = ref EmptyDeque,
		suffix = ref(List.concat[!prefix,!middle,!suffix])}
     else
	 (* Shift from middle to suffix and prefix to middle *)
	 (suffix := (List.@)(List.tl(!middle), !suffix);
	  middle := [List.last(!prefix), List.hd(!middle)];
	  prefix := takeButLast(!prefix);
	  q)))
  | ejectInternal(q as Deque{prefix,left,middle,right=ref EmptyDeque,suffix}) =
    naiveEject(if List.length (!suffix) > 3 then q else
    (* Case 2 *)
    let val (Triple(firstBuf,leftq,lastBuf), leftRest) =
	    case lastInternal(!left)
	     of Triple(firstBuf, leftq, lastBuf) =>
		if (List.length lastBuf = 3) orelse
		   (List.length lastBuf = 0 andalso List.length firstBuf = 3) orelse
		   (not (null leftq)) then
		    naiveEject(!left)
		else
		    ejectInternal(!left)
	      | _ => raise TypeError 
	(* If lastBuf empty, then so must be leftq, and we can reverse lastBuf
	   and firstBuf safely to get lastBuf of positive length *)
	val (firstBuf, lastBuf) = if List.length lastBuf = 0 then
				       (lastBuf, firstBuf)
				  else (firstBuf, lastBuf)
    in
	if List.length lastBuf = 3 then
	    (* Case 2.1 *)
	    (suffix := List.::((List.last(!middle)), (!suffix));
	     middle := [List.last lastBuf, List.hd(!middle)];
	     left  := injectInternal(Triple
			 (firstBuf, leftq, takeButLast(lastBuf)), leftRest);
	     q)
	else (* if List.length lastBuf = 2 then *)
	    (* Case 2.2 *)
	    (suffix := (List.@)(!middle, !suffix);
	     middle := lastBuf;
	     left  := (if List.length firstBuf = 0 andalso null(leftq) then
			   leftRest
		       else
			   let val t = Triple(firstBuf, EmptyDeque, [])
			       val q = injectInternal(t, leftRest)
			   in
			       q @ leftq
			   end);
	     q)
    end)
  | ejectInternal(q as Deque{prefix,left,middle,right,suffix}) =
    naiveEject(if List.length (!suffix) > 3 then q else
    (* Case 1 *)
    let val (Triple(firstBuf,rightq,lastBuf), rightRest) =
	case lastInternal(!right)
	 of Triple(firstBuf, rightq, lastBuf) =>
	    if (List.length lastBuf = 3) orelse
	       (List.length lastBuf = 0 andalso List.length firstBuf = 3) orelse
	       (not (null rightq)) then
		naiveEject(!right)
	    else
		ejectInternal(!right)
	  | _ => raise TypeError
	(* If lastBuf empty, then so must be leftq, and we can reverse lastBuf
	   and firstBuf safely to get lastBuf of positive length *)
	val (firstBuf, lastBuf) = if List.length lastBuf = 0 then
				      (lastBuf, firstBuf)
				  else (firstBuf, lastBuf)
    in
	if List.length lastBuf = 3 then
	    (* Case 1.1 *)
	    (suffix := List.::( (List.last(lastBuf)), (!suffix));
	     right  := injectInternal(Triple
			  (firstBuf, rightq, takeButLast(lastBuf)), rightRest);
	     q)
	else (* if length lastBuf = 2 then *)
	    (* Case 1.2 *)
	    (suffix := (List.@)(lastBuf, !suffix);
	     right  := (if List.length firstBuf = 0 andalso null(rightq) then
			   rightRest
			else
			   let val t = Triple(firstBuf, EmptyDeque, [])
			       val q = injectInternal(t, rightRest)
			   in
			       q @ rightq
			   end);
	     q)
    end)

(* Given a queue q1, returns a pair (x,q2), where x is the stored data
   at the end of q1, and q2 is q1 with x removed from the end. *)
fun eject(queue) =
    case ejectInternal(queue)
     of (Elem(x),q) => (x,q)
      | _           => raise TypeError

(* Gives the given queue with the last element removed (amortized O(1)). *)
fun dropLast(q) = case eject(q) of (e,newq) => newq;

(* Applies a function returning unit to each element of the queue in order
   in O(n) time, n=queue size. *)
fun app f  EmptyDeque = ()
  | app f (Deque{prefix,left,middle,right,suffix}) =
    (elemListApp f (!prefix);
     app f (!left);
     elemListApp f (!middle);
     app f (!right);
     elemListApp f (!suffix))

and appElemOrTriple f (Elem(e)) = f(e)
  | appElemOrTriple f (Triple(midBuf1, tripleDeque, midBuf2)) =
    (elemListApp f midBuf1;
     app f tripleDeque;
     elemListApp f midBuf2)

and elemListApp f elemList =
     List.app (fn(e)=>appElemOrTriple f e) elemList

(* Applies a function returning unit to each element of the queue in order
   in O(n) time, n=queue size. *)
fun appRev f  EmptyDeque = ()
  | appRev f (Deque{prefix,left,middle,right,suffix}) =
    (elemListAppRev f (!suffix);
     appRev f (!right);
     elemListAppRev f (!middle);
     appRev f (!left);
     elemListAppRev f (!prefix))

and appRevElemOrTriple f (Elem(e)) = f(e)
  | appRevElemOrTriple f (Triple(midBuf1, tripleDeque, midBuf2)) =
    (elemListAppRev f midBuf2;
     appRev f tripleDeque;
     elemListAppRev f midBuf1)

and elemListAppRev f elemList =
     List.app (fn(e)=>appRevElemOrTriple f e) (List.rev elemList)

(* Equivalent to List.foldl f init (CPCD.toList q), but with no space use.
   (time O(n), n=deque size). *)
fun foldl f init EmptyDeque = init
  | foldl f init (Deque{prefix,left,middle,right,suffix}) =
    let val r1 = elemListFoldl f init (!prefix)
	val r2 = foldl         f r1   (!left)
	val r3 = elemListFoldl f r2   (!middle)
	val r4 = foldl         f r3   (!right)
	val r5 = elemListFoldl f r4   (!suffix)
    in
	r5
    end

and foldlElemOrTriple f init (Elem(e)) = f(e, init)
  | foldlElemOrTriple f init (Triple(midBuf1, tripleDeque, midBuf2)) =
    let val r1 = elemListFoldl f init midBuf1
	val r2 = foldl         f r1   tripleDeque
	val r3 = elemListFoldl f r2   midBuf2
    in
	r3
    end

and elemListFoldl f init elemList =
     List.foldl (fn(e, soFar)=>foldlElemOrTriple f soFar e) init elemList

(* Equivalent to List.foldr f init (CPCD.toList q), but with no space use.
   (time O(n), n=deque size). *)
fun foldr f init EmptyDeque = init
  | foldr f init (Deque{prefix,left,middle,right,suffix}) =
    let val r1 = elemListFoldr f init (!suffix)
	val r2 = foldr         f r1   (!right)
	val r3 = elemListFoldr f r2   (!middle)
	val r4 = foldr         f r3   (!left)
	val r5 = elemListFoldr f r4   (!prefix)
    in
	r5
    end

and foldrElemOrTriple f init (Elem(e)) = f(e, init)
  | foldrElemOrTriple f init (Triple(midBuf1, tripleDeque, midBuf2)) =
    let val r1 = elemListFoldr f init midBuf2
	val r2 = foldr         f r1   tripleDeque
	val r3 = elemListFoldr f r2   midBuf1
    in
	r3
    end

and elemListFoldr f init elemList =
     List.foldr (fn(e, soFar)=>foldrElemOrTriple f soFar e) init elemList

(* Evaluates f for each element of the queue, returning SOME x for the
   first one it returns true for, or NONE if it never does.
   (worst-case time O(n), n=deque size). *)
fun find f EmptyDeque = NONE
  | find f (Deque{prefix,left,middle,right,suffix}) =
    case elemListFind f (!prefix) of SOME x => SOME x | NONE =>
    case find         f (!left)   of SOME x => SOME x | NONE =>
    case elemListFind f (!middle) of SOME x => SOME x | NONE =>
    case find         f (!right)  of SOME x => SOME x | NONE =>
         elemListFind f (!suffix)

and findElemOrTriple f (Elem(e)) = if f(e) then SOME e else NONE
  | findElemOrTriple f (Triple(midBuf1, tripleDeque, midBuf2)) =
    case elemListFind f midBuf1      of SOME x => SOME x | NONE =>
    case find         f tripleDeque  of SOME x => SOME x | NONE =>
         elemListFind f midBuf2

and elemListFind f []       = NONE
  | elemListFind f (List.::(elem,moreElems)) =
    case findElemOrTriple f (elem)
     of SOME x => SOME x
      | NONE   => elemListFind f moreElems

(* Evaluates f for each element of the queue in reverse order,
   returning SOME x for the first one it returns true for, or NONE if
   it never does. (worst-case time O(n), n=deque size). *)
fun findLast f EmptyDeque = NONE
  | findLast f (Deque{prefix,left,middle,right,suffix}) =
    case elemListFindLast f (!suffix) of SOME x => SOME x | NONE =>
    case findLast         f (!right)  of SOME x => SOME x | NONE =>
    case elemListFindLast f (!middle) of SOME x => SOME x | NONE =>
    case findLast         f (!left)   of SOME x => SOME x | NONE =>
         elemListFindLast f (!prefix)

and findLastElemOrTriple f (Elem(e)) = if f(e) then SOME e else NONE
  | findLastElemOrTriple f (Triple(midBuf1, tripleDeque, midBuf2)) =
    case elemListFindLast f midBuf2      of SOME x => SOME x | NONE =>
    case findLast         f tripleDeque  of SOME x => SOME x | NONE =>
         elemListFindLast f midBuf1

and elemListFindLast f lst = elemListFindLastForward f (rev lst)
and elemListFindLastForward f []       = NONE
  | elemListFindLastForward f (List.::(elem, moreElems)) =
    case findLastElemOrTriple f (elem)
     of SOME x => SOME x
      | NONE   => elemListFindLastForward f moreElems

(* If an nth element exists, returns (SOME x, _), otherwise returns
   (NONE, current position). This implementation is meant to be
   faster than the solution with hd/tl by not modifying the structure
   and by skipping entire buffers at once if the index is large enough. *)
fun nthHelper(_, _, result as (SOME x, i)) = result
  | nthHelper(EmptyDeque, n, result) = result
  | nthHelper(Deque{prefix,left,middle,right,suffix}, n, result) =
    let val result = eotListNthHelper(!prefix, n, result)
	val result = nthHelper       (!left,   n, result)
	val result = eotListNthHelper(!middle, n, result)
	val result = nthHelper       (!right,  n, result)
	val result = eotListNthHelper(!suffix, n, result)
    in
	result
    end

and nthHelperTriple (_, _, (SOME x, i)) = (SOME x, i)
  | nthHelperTriple (Elem(e), n, (NONE, i)) = raise TypeError
  | nthHelperTriple (Triple(midBuf1, tripleDeque, midBuf2), n, result) =
    let val result = eotListNthHelper(midBuf1,     n, result)
	val result = nthHelper       (tripleDeque, n, result)
	val result = eotListNthHelper(midBuf2,     n, result)
    in
	result
    end

and optionListNth (lst, n) =
    if n < 0 orelse n >= List.length lst
    then NONE
    else SOME (List.nth(lst,n))

and eotListNthHelper(_, _, (SOME x, i)) = (SOME x, i)
  | eotListNthHelper([], _, (NONE, i))  = (NONE, i)
  | eotListNthHelper(lst, n, (NONE, i)) =
    (* Lists are all of one type, so if hd is Elem, so is all *)
    case List.hd(lst)
     of Elem(x) => (optionListNth(lst, n-i), i + List.length lst)
      | _       => List.foldl (fn(x,soFar)=>nthHelperTriple(x,n,soFar)) (NONE, i) lst

(* Gets element at a zero-based index from the beginning of a deque
   (O(n), n=deque size). *)
fun nth(q,n) =
    if n < 0 then raise Subscript (* will anyway, but for efficiency *)
    else 
    (case nthHelper(q,n,(NONE, 0))
      of (SOME (Elem x), _) => x
       | (SOME x,       _) => raise TypeError
       | _                 => raise Subscript)

(* Gets first n elements of the deque as a deque. (O(n), n=argument). *)
fun take(q, n) =
    let fun takeHelper(q, 0, result) = result
	  | takeHelper(EmptyDeque, _, _) = raise Subscript
	  | takeHelper(q, n, result) =
	    takeHelper(tl q, n-1, inject(hd q, result))
    in
	takeHelper(q, n, EmptyDeque)
    end

(* Gets deque with first n elements removed. (O(n), n=argument). *)
fun drop(q, 0) = q
  | drop(EmptyDeque, _) = raise Subscript
  | drop(q, n) = drop(tl q, n-1)

(* Gets last n elements of the deque as a deque. (O(n), n=argument). *)
fun takeEnd(q, n) =
    let fun takeEndHelper(q, 0, result) = result
	  | takeEndHelper(EmptyDeque, _, _) = raise Subscript
	  | takeEndHelper(q, n, result) =
	    takeEndHelper(dropLast q, n-1, push(last q, result))
    in
	takeEndHelper(q, n, EmptyDeque)
    end

(* Gets deque with last n elements removed. (O(n), n=argument). *)
fun dropEnd(q, 0) = q
  | dropEnd(EmptyDeque, _) = raise Subscript
  | dropEnd(q, n) = dropEnd(dropLast q, n-1)

(* Returns a queue containing the elements of this queue for which
   the given function returns true, in their original order
   (time O(n), n=deque size). *)
fun filter f q =
    foldr (fn(x,soFar)=>if f(x) then push(x,soFar) else soFar) EmptyDeque q

(* Returns true only if f(e) returns true for some element e of a queue.
   (time O(n), n=deque size). *)
fun exists f q =
    case find f q
     of SOME x => true
      | NONE   => false

(* Returns true only if f(e) returns true for every element e of a queue.
   (time O(n), n=deque size). *)
fun all f q = not(exists (not o f) q)

(* Equivalent to List.map f init (CPCD.toList q), but with no space use.
   (time O(n), n=deque size). *)
fun map f q = foldl (fn(e, soFar)=>inject(f(e), soFar)) EmptyDeque q

(* Makes a list containing this deque's contents in order. (O(n), n=deque size) *)
fun fromList lst =
    (* Could use push/foldr or inject/foldl, but push/foldr is a bit more efficient
       with the current implementation. *)
    List.foldr push EmptyDeque lst

(* Makes a list containing this deque's contents in order. (O(n), n=deque size) *)
fun toList q = foldr (List.::) [] q

(* Reverses a deque. *)
fun rev q =
    let fun revHelper (EmptyDeque, result) = result
	  | revHelper (q, resultSoFar) =
	    revHelper(tl(q), inject(hd(q), resultSoFar))
    in
	revHelper (q, EmptyDeque)
    end

(* Tests all list length conditions to make sure this is a valid
   queue, for testing *)
fun isValid(EmptyDeque) = true
  | isValid(q as Deque{prefix=prefix as ref [],left,middle,right,suffix}) =
    (if List.length (!suffix) >= 1 then true else (print "Suffix-only deque suffix too short\n"; false)) andalso
    (if List.length (!suffix) <= 8 then true else (print "Suffix-only deque suffix too long\n"; false)) andalso
    (if null(!left) then true else (print "Suffix-only deque has non-empty left deque\n"; false)) andalso
    (if null(!right) then true else (print "Suffix-only deque has non-empty right deque\n"; false)) andalso
    (if List.length (!prefix) = 0 then true else (print "Suffix-only deque has non-empty prefix\n"; false)) andalso
    (if List.length (!middle) = 0 then true else (print "Suffix-only deque has non-empty middle\n"; false)) andalso
    elemListIsValid (!suffix)

  | isValid(q as Deque{prefix,left,middle,right,suffix}) =
    (if List.length (!prefix) >= 3 then true else (print "Deque prefix too short\n"; false)) andalso
    (if List.length (!prefix) <= 6 then true else (print "Deque prefix too long\n"; false)) andalso
    (if List.length (!middle)  = 2 then true else (print "Deque middle not of length 2\n"; false)) andalso
    (if List.length (!suffix) >= 3 then true else (print "Deque suffix too short\n"; false)) andalso
    (if List.length (!suffix) <= 6 then true else (print "Deque suffix too long\n"; false)) andalso
    (if isTripleList (!left) then true else (print "Deque left deque contains non-triple"; false)) andalso
    (if isTripleList (!right) then true else (print "Deque right deque contains non-triple"; false)) andalso

    elemListIsValid (!prefix) andalso
    isValid (!left)           andalso
    elemListIsValid (!middle) andalso
    isValid (!right)          andalso
    elemListIsValid (!suffix)

and elemOrTripleIsValid (Elem(e)) = true
  | elemOrTripleIsValid (Triple(midBuf1, tripleDeque, midBuf2)) =
    (if List.length midBuf1 >= 2 orelse (null tripleDeque andalso List.length midBuf1=0) then true
     else (print "Triple first middle buffer too short (deque must be empty for it to be empty)\n"; false)) andalso
    (if List.length midBuf2 >= 2 orelse (null tripleDeque andalso List.length midBuf2=0) then true
     else (print "Triple second middle buffer too short (deque must be empty for it to be empty)\n"; false)) andalso
    (if List.length midBuf1 > 0 orelse List.length midBuf2 > 0 then true
     else (print "Triple middle buffers both empty\n"; false)) andalso
    (if List.length midBuf1 <= 3 then true else (print "Triple first middle buffer too long\n"; false)) andalso
    (if List.length midBuf2 <= 3 then true else (print "Triple last middle buffer too long\n"; false)) andalso
    (if isTripleList (tripleDeque) then true else (print "Triple deque contains non-triple"; false)) andalso

    elemListIsValid midBuf1 andalso
    isValid tripleDeque     andalso
    elemListIsValid midBuf2

and elemListIsValid elemList =
     List.all (fn(e)=>elemOrTripleIsValid e) elemList

and isTripleList EmptyDeque = true
  | isTripleList deque =
    let val (e, newq) = popInternal deque in
	(case e of Triple _ => true | _ => false) andalso
	isTripleList(newq)
    end

end

infix 5 @@

(* Open this structure to replace top-level list functions and operators
   with equivalent deque operators (except for [x,...,z] literal notation,
   which will still need to be wrapped with CPCD.fromList, and nil, which
   becomes EmptyDeque). *)
structure OpenCPCD : sig

(* The deque structure, representing a CPCD of elements of some type 'a.
   The full datatype is exported so that users can pattern-match on EmptyDeque. *)
datatype 'a deque =
	 EmptyDeque
       | Deque of {prefix: 'a ElemOrTriple list ref, (* length 3 to 6 *)
                   left:   'a deque ref,  (* 'a should be made by EOTTriple here *)
		   middle: 'a ElemOrTriple list ref, (* length 2 *)
		   right:  'a deque ref, (* 'a should be made by EOTTriple here *)
		   suffix: 'a ElemOrTriple list ref  (* length 3 to 6, or 1 to 8 when
					                all other fields are empty *)}
(* Need this to do non-uniform recursion *)
and 'a ElemOrTriple = Elem of 'a
		    | Triple of
		      (* first middle buffer, length 0/2/3 *)
		      'a ElemOrTriple list * 
		      (* 'a should be EOTTriple here *)
		      'a deque * 
		      (* last middle buffer, length 0/2/3 *)
		      'a ElemOrTriple list

val ::     : 'a * ('a deque) -> 'a deque
val @      : ('a deque) * ('a deque) -> 'a deque
val app    : ('a -> unit) -> 'a deque -> unit
val foldl  : ('a * 'b -> 'b) -> 'b -> 'a deque -> 'b
val foldr  : ('a * 'b -> 'b) -> 'b -> 'a deque -> 'b
val hd     : 'a deque -> 'a
val length : 'a deque -> int
val map    : ('a -> 'b) -> 'a deque -> 'b deque
val null   : 'a deque -> bool
val rev    : 'a deque -> 'a deque
val tl     : 'a deque -> 'a deque

end = CPCD