signature CATLIST1 =
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 : '1a -> '1a T            (* create singleton list *)
    val catenate : '1a T * '1a T -> '1a T  (* append two lists *)

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

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


structure CatList1 : CATLIST1 =
struct
    datatype 'a Node = Occupied of 'a * 'a Tree Queue.T
                     | Vacant of 'a Tree Queue.T
    withtype 'a Tree = 'a Node ref

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

    exception EMPTY

    fun link (t1,t2) =
          let val (x,q) = force t1
          in
	      (x,Queue.inject (t2,q))
          end
           
    and force t =
	  case !t of
	      Occupied (x,q) => (x,q)
	    | Vacant q => 
		let val t1 = Queue.first q
                    val q' = Queue.pop q
                    val t2 = if Queue.size q = 2 then Queue.first q'
                             else ref (Vacant q')
		    val (x,q'') = link (t1,t2)
		in
		    t := Occupied (x,q'');
		    (x,q'')
		end

    val empty = Empty

    fun isempty Empty = true
      | isempty (NonEmpty t) = false
      
    fun makelist x = NonEmpty (ref (Occupied (x,Queue.empty)))

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

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

    fun catenate (Empty,xs) = xs
      | catenate (xs,Empty) = xs
      | catenate (NonEmpty t1,NonEmpty t2) =
	  NonEmpty (ref (Occupied (link (t1,t2))))

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

end