halfs-0.2: Data/Queue.hs

-----------------------------------------------------------------------------
-- test
-- |
-- 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, queueLength
    ) where

import Prelude -- necessary to get dependencies right
import Control.Exception(assert)

-- | The type of FIFO queues.
data Queue a = Q [a] [a] [a] !Int

-- 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' len) = Q (map f xs) (map f ys) (map f xs') len
	-- 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 [] [] [] 0

-- | Add an element to the back of a queue.
addToQueue :: Queue a -> a -> Queue a
addToQueue (Q xs ys xs' len) y = makeQ xs (y:ys) xs' (len + 1)

-- | 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 [] _ _ len) = assert (len == 0) $ Nothing
deQueue (Q (x:xs) ys xs' len) = Just (x, makeQ xs ys xs' (len - 1))

-- Assuming
--	length ys <= length xs + 1
--	xs' = drop (length ys - 1) xs
-- construct a queue respecting the invariant.
makeQ :: [a] -> [a] -> [a] -> Int -> Queue a
makeQ xs ys []      len = listToQueue' (rotate xs ys []) len
makeQ xs ys (_:xs') len = Q xs ys xs' len

-- 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)
rotate _ _ _ = error "Bad arguments to rotate"

-- | A queue with the same elements as the list.
listToQueue :: [a] -> Queue a
listToQueue xs = listToQueue' xs (length xs)

listToQueue' :: [a] -> Int -> Queue a
listToQueue' xs len = Q xs [] xs len

-- | The elements of a queue, front first.
queueToList :: Queue a -> [a]
queueToList (Q xs ys _ _) = xs ++ reverse ys

queueLength :: Queue a -> Int
queueLength (Q _xs _ys _ len) = len