(* Queues (LIFO).
   Copyright (C) 2004 Jean Goubault-Larrecq and LSV, CNRS UMR 8643 & ENS Cachan.

   This file is part of h1.

   h1 is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   h1 is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with h1; see the file COPYING.  If not, write to
   the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*)

open "queue_h";

(*$E-*) (* turn off sharing for mlists. *)
datatype 'a mlist = MNIL
       | MCONS of 'a * 'a mlist ref;

datatype 'a queue = Q_HD of 'a mlist ref * 'a mlist ref ref;
	 (* (p, q):
	  p is pointer to head of list,
	  q is pointer to cdr of last element of list if any,
	  otherwise to p.
	  *)
(*$E+*)

fun queue () =
    let val p = ref MNIL
	val q = ref p

	fun push x =
	    let val last = ref MNIL
		val qp = !q
	    in
		qp := MCONS (x, last);
		q := last
	    end
	fun pop () =
	    let val qp = !q
	    in
		if qp=p
		    then raise QEmptyEvt
		else let val MCONS (x, p') = !p
		     in
			 p := !p';
			 if qp=p'
			     then q := p
			 else ();
			 x
		     end
	    end
	fun top () =
	    let val qp = !q
	    in
		if qp=p
		    then raise QEmptyEvt
		else let val MCONS (x, _) = !p
		     in
			 x
		     end
	    end
	fun mklist MNIL = nil
	  | mklist (MCONS (x, ref r)) =
	    x :: mklist r
    in
	|[push = push,
	  pop = pop,
	  top = top,
	  empty = fn () => !q=p,
	  mklist = fn () => mklist (!p)
	  ]|
    end;

