From: ross <unknown>
Date: Tue, 6 Jan 2004 10:31:05 +0000 (+0000)
Subject: [project @ 2004-01-06 10:31:05 by ross]
X-Git-Tag: nhc98-1-18-release~414
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=b9f76ae04a6df4e7251e725c381588209773c0b3;p=ghc-base.git

[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
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