[project @ 2004-01-06 10:31:05 by ross]

new Queue type, using Chris Okasaki's cute 3-list implementation.

diff --git a/Data/Queue.hs b/Data/Queue.hs
new file mode 100644 (file)
index 0000000..8db6df6
--- /dev/null
+++ b/Data/Queue.hs
@@ -0,0 +1,79 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.Queue
+-- Copyright   :  (c) The University of Glasgow 2002
+-- License     :  BSD-style (see the file libraries/base/LICENSE)
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  experimental
+-- Portability :  portable
+--
+-- Queues with constant time operations, from
+-- /Simple and efficient purely functional queues and deques/,
+-- by Chris Okasaki, /JFP/ 5(4):583-592, October 1995.
+--
+-----------------------------------------------------------------------------
+
+module Data.Queue(
+       Queue,
+       -- * Primitive operations
+       -- | Each of these requires /O(1)/ time in the worst case.
+       emptyQueue, addToQueue, deQueue,
+       -- * Queues and lists
+       listToQueue, queueToList
+    ) where
+
+#ifdef __HADDOCK__
+import Prelude
+#endif
+
+-- | The type of FIFO queues.
+data Queue a = Q [a] [a] [a]
+
+-- Invariants for Q xs ys xs':
+--     length xs = length ys + length xs'
+--     xs' = drop (length ys) xs       -- in fact, shared (except after fmap)
+-- The queue then represents the list xs ++ reverse ys
+
+instance Functor Queue where
+       fmap f (Q xs ys xs') = Q (map f xs) (map f ys) (map f xs')
+       -- The new xs' does not share the tail of the new xs, but it does
+       -- share the tail of the old xs, so it still forces the rotations.
+       -- Note that elements of xs' are ignored.
+
+-- | The empty queue.
+emptyQueue :: Queue a
+emptyQueue = Q [] [] []
+
+-- | Add an element to the back of a queue.
+addToQueue :: Queue a -> a -> Queue a
+addToQueue (Q xs ys xs') y = makeQ xs (y:ys) xs'
+
+-- | Attempt to extract the front element from a queue.
+-- If the queue is empty, 'Nothing',
+-- otherwise the first element paired with the remainder of the queue.
+deQueue :: Queue a -> Maybe (a, Queue a)
+deQueue (Q [] _ _) = Nothing
+deQueue (Q (x:xs) ys xs') = Just (x, makeQ xs ys xs')
+
+-- Assuming
+--     length ys <= length xs + 1
+--     xs' = drop (length ys - 1) xs
+-- construct a queue respecting the invariant.
+makeQ :: [a] -> [a] -> [a] -> Queue a
+makeQ xs ys [] = listToQueue (rotate xs ys [])
+makeQ xs ys (_:xs') = Q xs ys xs'
+
+-- Assuming length ys = length xs + 1,
+--     rotate xs ys zs = xs ++ reverse ys ++ zs
+rotate :: [a] -> [a] -> [a] -> [a]
+rotate [] (y:_) zs = y : zs            -- the _ here must be []
+rotate (x:xs) (y:ys) zs = x : rotate xs ys (y:zs)
+
+-- | A queue with the same elements as the list.
+listToQueue :: [a] -> Queue a
+listToQueue xs = Q xs [] xs
+
+-- | The elements of a queue, front first.
+queueToList :: Queue a -> [a]
+queueToList (Q xs ys _) = xs ++ reverse ys