fifo.sml

这是我们参加06年全国开源软件的竞赛作品

(* fifo.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file for details.
 *
 * Applicative fifos
 *
 *)

structure Fifo : FIFO =
  struct
    datatype 'a fifo = Q of {front: 'a list, rear: 'a list}

    exception Dequeue

    val empty = Q{front=[],rear=[]}

    fun isEmpty (Q{front=[],rear=[]}) = true
      | isEmpty _ = false

    fun enqueue (Q{front,rear},x) = Q{front=front,rear=(x::rear)}

    fun dequeue (Q{front=(hd::tl),rear}) = (Q{front=tl,rear=rear},hd)
      | dequeue (Q{rear=[],...}) = raise Dequeue
      | dequeue (Q{rear,...}) = dequeue(Q{front=rev rear,rear=[]})

    fun delete (Q{front, rear}, pred) = let
	  fun doFront [] = {front = doRear(rev rear), rear = []}
	    | doFront (x::r) = if (pred x)
		then {front = r, rear = rear}
		else let val {front, rear} = doFront r
		  in {front =  x :: front, rear = rear} end
	  and doRear [] = []
	    | doRear (x::r) = if (pred x) then r else x :: (doRear r)
	  in
	    Q(doFront front)
	  end

    fun peek (Q{front=(hd::_), ...}) = SOME hd
      | peek (Q{rear=[], ...}) = NONE
      | peek (Q{rear, ...}) = SOME(hd(rev rear))

    fun head (Q{front=(hd::_),...}) = hd
      | head (Q{rear=[],...}) = raise Dequeue
      | head (Q{rear,...}) = hd(rev rear)

    fun length (Q {rear,front}) = (List.length rear) + (List.length front)

    fun contents (Q {rear, front}) = (front @ (rev rear))

    fun app f (Q{front,rear}) = (List.app f front; List.app f (List.rev rear))
    fun map f (Q{front,rear}) = 
          Q{front = List.map f front, rear = rev(List.map f(rev rear))}
    fun foldl f b (Q{front,rear}) = List.foldr f (List.foldl f b front) rear
    fun foldr f b (Q{front,rear}) = List.foldr f (List.foldl f b rear) front

  end