signature CATLIST2 =
sig
    type 'a T                       (* type of catenable lists *)

    exception EMPTY                 (* raised by pop(empty) or first(empty) *)

    val empty    : 'a T                 (* the empty list *)
    val isempty  : 'a T -> bool         (* return true if list is empty *)

    val makelist : 'a -> 'a T           (* create singleton list *)
    val catenate : 'a T * 'a T -> 'a T  (* append two lists *)

    val push     : 'a * 'a T -> 'a T    (* add element to front of list *)
    val pop      : 'a T -> 'a T         (* remove front element *)
    val first    : 'a T -> 'a           (* return front element *)

    val inject   : 'a * 'a T -> 'a T    (* add element to rear of list *)
end


structure CatList2 : CATLIST2 =
struct
    datatype 'a Tree = Node of 'a * 'a Tree Delay.T Queue.T

    datatype 'a T = Empty | NonEmpty of 'a Tree Delay.T

    exception EMPTY

    fun link (t1,t2) =
          let val (Node (x,q)) = Delay.force t1
          in
	      Node (x,Queue.inject(t2,q))
	  end

    fun multilink q =
	  if Queue.size q = 2 then
            link (Queue.first q,Queue.first (Queue.pop q))
          else
            link (Queue.first q,Delay.delay (fn () => multilink (Queue.pop q)))

    val empty = Empty
    fun isempty Empty = true
      | isempty (NonEmpty t) =  false

    fun makelist x = NonEmpty (Delay.trivial (Node (x,Queue.empty)))

    fun catenate (Empty,xs) = xs
      | catenate (xs,Empty) = xs
      | catenate (NonEmpty t1,NonEmpty t2) =
	  NonEmpty (Delay.trivial (link (t1,t2)))

    fun push (x,xs) = catenate (makelist x,xs)
    fun inject (x,xs) = catenate (xs,makelist x)

    fun first Empty = raise EMPTY
      | first (NonEmpty t) =
          let val (Node (x,q)) = Delay.force t
	  in
	      x
	  end

    fun pop Empty = raise EMPTY
      | pop (NonEmpty t) =
          let val (Node (x,q)) = Delay.force t
          in
	      case Queue.size q of
		0 => Empty
	      | 1 => NonEmpty (Queue.first q)
	      | n => NonEmpty (Delay.delay (fn () => multilink q))
	  end
end