System/Event/PSQ.hs

   1 {-# LANGUAGE BangPatterns, NoImplicitPrelude #-}
   2
   3 -- Copyright (c) 2008, Ralf Hinze
   4 -- All rights reserved.
   5 --
   6 -- Redistribution and use in source and binary forms, with or without
   7 -- modification, are permitted provided that the following conditions
   8 -- are met:
   9 --
  10 --     * Redistributions of source code must retain the above
  11 --       copyright notice, this list of conditions and the following
  12 --       disclaimer.
  13 --
  14 --     * Redistributions in binary form must reproduce the above
  15 --       copyright notice, this list of conditions and the following
  16 --       disclaimer in the documentation and/or other materials
  17 --       provided with the distribution.
  18 --
  19 --     * The names of the contributors may not be used to endorse or
  20 --       promote products derived from this software without specific
  21 --       prior written permission.
  22 --
  23 -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  24 -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  25 -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
  26 -- FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  27 -- COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  28 -- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  29 -- (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  30 -- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  31 -- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
  32 -- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
  33 -- ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
  34 -- OF THE POSSIBILITY OF SUCH DAMAGE.
  35
  36 -- | A /priority search queue/ (henceforth /queue/) efficiently
  37 -- supports the operations of both a search tree and a priority queue.
  38 -- An 'Elem'ent is a product of a key, a priority, and a
  39 -- value. Elements can be inserted, deleted, modified and queried in
  40 -- logarithmic time, and the element with the least priority can be
  41 -- retrieved in constant time.  A queue can be built from a list of
  42 -- elements, sorted by keys, in linear time.
  43 --
  44 -- This implementation is due to Ralf Hinze with some modifications by
  45 -- Scott Dillard and Johan Tibell.
  46 --
  47 -- * Hinze, R., /A Simple Implementation Technique for Priority Search
  48 -- Queues/, ICFP 2001, pp. 110-121
  49 --
  50 -- <http://citeseer.ist.psu.edu/hinze01simple.html>
  51 module System.Event.PSQ
  52     (
  53     -- * Binding Type
  54     Elem(..)
  55     , Key
  56     , Prio
  57
  58     -- * Priority Search Queue Type
  59     , PSQ
  60
  61     -- * Query
  62     , size
  63     , null
  64     , lookup
  65
  66     -- * Construction
  67     , empty
  68     , singleton
  69
  70     -- * Insertion
  71     , insert
  72
  73     -- * Delete/Update
  74     , delete
  75     , adjust
  76
  77     -- * Conversion
  78     , toList
  79     , toAscList
  80     , toDescList
  81     , fromList
  82
  83     -- * Min
  84     , findMin
  85     , deleteMin
  86     , minView
  87     , atMost
  88     ) where
  89
  90 import Data.Maybe (Maybe(..))
  91 import GHC.Base
  92 import GHC.Num (Num(..))
  93 import GHC.Show (Show(showsPrec))
  94 import System.Event.Unique (Unique)
  95
  96 -- | @E k p@ binds the key @k@ with the priority @p@.
  97 data Elem a = E
  98     { key   :: {-# UNPACK #-} !Key
  99     , prio  :: {-# UNPACK #-} !Prio
 100     , value :: a
 101     } deriving (Eq, Show)
 102
 103 ------------------------------------------------------------------------
 104 -- | A mapping from keys @k@ to priorites @p@.
 105
 106 type Prio = Double
 107 type Key = Unique
 108
 109 data PSQ a = Void
 110            | Winner {-# UNPACK #-} !(Elem a)
 111                     !(LTree a)
 112                     {-# UNPACK #-} !Key  -- max key
 113            deriving (Eq, Show)
 114
 115 -- | /O(1)/ The number of elements in a queue.
 116 size :: PSQ a -> Int
 117 size Void            = 0
 118 size (Winner _ lt _) = 1 + size' lt
 119
 120 -- | /O(1)/ True if the queue is empty.
 121 null :: PSQ a -> Bool
 122 null Void           = True
 123 null (Winner _ _ _) = False
 124
 125 -- | /O(log n)/ The priority and value of a given key, or Nothing if
 126 -- the key is not bound.
 127 lookup :: Key -> PSQ a -> Maybe (Prio, a)
 128 lookup k q = case tourView q of
 129     Null -> Nothing
 130     Single (E k' p v)
 131         | k == k'   -> Just (p, v)
 132         | otherwise -> Nothing
 133     tl `Play` tr
 134         | k <= maxKey tl -> lookup k tl
 135         | otherwise      -> lookup k tr
 136
 137 ------------------------------------------------------------------------
 138 -- Construction
 139
 140 empty :: PSQ a
 141 empty = Void
 142
 143 -- | /O(1)/ Build a queue with one element.
 144 singleton :: Key -> Prio -> a -> PSQ a
 145 singleton k p v = Winner (E k p v) Start k
 146
 147 ------------------------------------------------------------------------
 148 -- Insertion
 149
 150 -- | /O(log n)/ Insert a new key, priority and value in the queue.  If
 151 -- the key is already present in the queue, the associated priority
 152 -- and value are replaced with the supplied priority and value.
 153 insert :: Key -> Prio -> a -> PSQ a -> PSQ a
 154 insert k p v q = case q of
 155     Void -> singleton k p v
 156     Winner (E k' p' v') Start _ -> case compare k k' of
 157         LT -> singleton k  p  v  `play` singleton k' p' v'
 158         EQ -> singleton k  p  v
 159         GT -> singleton k' p' v' `play` singleton k  p  v
 160     Winner e (RLoser _ e' tl m tr) m'
 161         | k <= m    -> insert k p v (Winner e tl m) `play` (Winner e' tr m')
 162         | otherwise -> (Winner e tl m) `play` insert k p v (Winner e' tr m')
 163     Winner e (LLoser _ e' tl m tr) m'
 164         | k <= m    -> insert k p v (Winner e' tl m) `play` (Winner e tr m')
 165         | otherwise -> (Winner e' tl m) `play` insert k p v (Winner e tr m')
 166
 167 ------------------------------------------------------------------------
 168 -- Delete/Update
 169
 170 -- | /O(log n)/ Delete a key and its priority and value from the
 171 -- queue.  When the key is not a member of the queue, the original
 172 -- queue is returned.
 173 delete :: Key -> PSQ a -> PSQ a
 174 delete k q = case q of
 175     Void -> empty
 176     Winner (E k' p v) Start _
 177         | k == k'   -> empty
 178         | otherwise -> singleton k' p v
 179     Winner e (RLoser _ e' tl m tr) m'
 180         | k <= m    -> delete k (Winner e tl m) `play` (Winner e' tr m')
 181         | otherwise -> (Winner e tl m) `play` delete k (Winner e' tr m')
 182     Winner e (LLoser _ e' tl m tr) m'
 183         | k <= m    -> delete k (Winner e' tl m) `play` (Winner e tr m')
 184         | otherwise -> (Winner e' tl m) `play` delete k (Winner e tr m')
 185
 186 -- | /O(log n)/ Update a priority at a specific key with the result
 187 -- of the provided function.  When the key is not a member of the
 188 -- queue, the original queue is returned.
 189 adjust :: (Prio -> Prio) -> Key -> PSQ a -> PSQ a
 190 adjust f k q0 =  go q0
 191   where
 192     go q = case q of
 193         Void -> empty
 194         Winner (E k' p v) Start _
 195             | k == k'   -> singleton k' (f p) v
 196             | otherwise -> singleton k' p v
 197         Winner e (RLoser _ e' tl m tr) m'
 198             | k <= m    -> go (Winner e tl m) `unsafePlay` (Winner e' tr m')
 199             | otherwise -> (Winner e tl m) `unsafePlay` go (Winner e' tr m')
 200         Winner e (LLoser _ e' tl m tr) m'
 201             | k <= m    -> go (Winner e' tl m) `unsafePlay` (Winner e tr m')
 202             | otherwise -> (Winner e' tl m) `unsafePlay` go (Winner e tr m')
 203 {-# INLINE adjust #-}
 204
 205 ------------------------------------------------------------------------
 206 -- Conversion
 207
 208 -- | /O(n*log n)/ Build a queue from a list of key/priority/value
 209 -- tuples.  If the list contains more than one priority and value for
 210 -- the same key, the last priority and value for the key is retained.
 211 fromList :: [Elem a] -> PSQ a
 212 fromList = foldr (\(E k p v) q -> insert k p v q) empty
 213
 214 -- | /O(n)/ Convert to a list of key/priority/value tuples.
 215 toList :: PSQ a -> [Elem a]
 216 toList = toAscList
 217
 218 -- | /O(n)/ Convert to an ascending list.
 219 toAscList :: PSQ a -> [Elem a]
 220 toAscList q  = seqToList (toAscLists q)
 221
 222 toAscLists :: PSQ a -> Sequ (Elem a)
 223 toAscLists q = case tourView q of
 224     Null         -> emptySequ
 225     Single e     -> singleSequ e
 226     tl `Play` tr -> toAscLists tl <> toAscLists tr
 227
 228 -- | /O(n)/ Convert to a descending list.
 229 toDescList :: PSQ a -> [ Elem a ]
 230 toDescList q = seqToList (toDescLists q)
 231
 232 toDescLists :: PSQ a -> Sequ (Elem a)
 233 toDescLists q = case tourView q of
 234     Null         -> emptySequ
 235     Single e     -> singleSequ e
 236     tl `Play` tr -> toDescLists tr <> toDescLists tl
 237
 238 ------------------------------------------------------------------------
 239 -- Min
 240
 241 -- | /O(1)/ The element with the lowest priority.
 242 findMin :: PSQ a -> Maybe (Elem a)
 243 findMin Void           = Nothing
 244 findMin (Winner e _ _) = Just e
 245
 246 -- | /O(log n)/ Delete the element with the lowest priority.  Returns
 247 -- an empty queue if the queue is empty.
 248 deleteMin :: PSQ a -> PSQ a
 249 deleteMin Void           = Void
 250 deleteMin (Winner _ t m) = secondBest t m
 251
 252 -- | /O(log n)/ Retrieve the binding with the least priority, and the
 253 -- rest of the queue stripped of that binding.
 254 minView :: PSQ a -> Maybe (Elem a, PSQ a)
 255 minView Void           = Nothing
 256 minView (Winner e t m) = Just (e, secondBest t m)
 257
 258 secondBest :: LTree a -> Key -> PSQ a
 259 secondBest Start _                 = Void
 260 secondBest (LLoser _ e tl m tr) m' = Winner e tl m `play` secondBest tr m'
 261 secondBest (RLoser _ e tl m tr) m' = secondBest tl m `play` Winner e tr m'
 262
 263 -- | /O(r*(log n - log r))/ Return a list of elements ordered by
 264 -- key whose priorities are at most @pt@.
 265 atMost :: Prio -> PSQ a -> ([Elem a], PSQ a)
 266 atMost pt q = let (sequ, q') = atMosts pt q
 267               in (seqToList sequ, q')
 268
 269 atMosts :: Prio -> PSQ a -> (Sequ (Elem a), PSQ a)
 270 atMosts !pt q = case q of
 271     (Winner e _ _)
 272         | prio e > pt -> (emptySequ, q)
 273     Void              -> (emptySequ, Void)
 274     Winner e Start _  -> (singleSequ e, Void)
 275     Winner e (RLoser _ e' tl m tr) m' ->
 276         let (sequ, q')   = atMosts pt (Winner e tl m)
 277             (sequ', q'') = atMosts pt (Winner e' tr m')
 278         in (sequ <> sequ', q' `play` q'')
 279     Winner e (LLoser _ e' tl m tr) m' ->
 280         let (sequ, q')   = atMosts pt (Winner e' tl m)
 281             (sequ', q'') = atMosts pt (Winner e tr m')
 282         in (sequ <> sequ', q' `play` q'')
 283
 284 ------------------------------------------------------------------------
 285 -- Loser tree
 286
 287 type Size = Int
 288
 289 data LTree a = Start
 290              | LLoser {-# UNPACK #-} !Size
 291                       {-# UNPACK #-} !(Elem a)
 292                       !(LTree a)
 293                       {-# UNPACK #-} !Key  -- split key
 294                       !(LTree a)
 295              | RLoser {-# UNPACK #-} !Size
 296                       {-# UNPACK #-} !(Elem a)
 297                       !(LTree a)
 298                       {-# UNPACK #-} !Key  -- split key
 299                       !(LTree a)
 300              deriving (Eq, Show)
 301
 302 size' :: LTree a -> Size
 303 size' Start              = 0
 304 size' (LLoser s _ _ _ _) = s
 305 size' (RLoser s _ _ _ _) = s
 306
 307 left, right :: LTree a -> LTree a
 308
 309 left Start                = moduleError "left" "empty loser tree"
 310 left (LLoser _ _ tl _ _ ) = tl
 311 left (RLoser _ _ tl _ _ ) = tl
 312
 313 right Start                = moduleError "right" "empty loser tree"
 314 right (LLoser _ _ _  _ tr) = tr
 315 right (RLoser _ _ _  _ tr) = tr
 316
 317 maxKey :: PSQ a -> Key
 318 maxKey Void           = moduleError "maxKey" "empty queue"
 319 maxKey (Winner _ _ m) = m
 320
 321 lloser, rloser :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 322 lloser k p v tl m tr = LLoser (1 + size' tl + size' tr) (E k p v) tl m tr
 323 rloser k p v tl m tr = RLoser (1 + size' tl + size' tr) (E k p v) tl m tr
 324
 325 ------------------------------------------------------------------------
 326 -- Balancing
 327
 328 -- | Balance factor
 329 omega :: Int
 330 omega = 4
 331
 332 lbalance, rbalance :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 333
 334 lbalance k p v l m r
 335     | size' l + size' r < 2     = lloser        k p v l m r
 336     | size' r > omega * size' l = lbalanceLeft  k p v l m r
 337     | size' l > omega * size' r = lbalanceRight k p v l m r
 338     | otherwise                 = lloser        k p v l m r
 339
 340 rbalance k p v l m r
 341     | size' l + size' r < 2     = rloser        k p v l m r
 342     | size' r > omega * size' l = rbalanceLeft  k p v l m r
 343     | size' l > omega * size' r = rbalanceRight k p v l m r
 344     | otherwise                 = rloser        k p v l m r
 345
 346 lbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 347 lbalanceLeft  k p v l m r
 348     | size' (left r) < size' (right r) = lsingleLeft  k p v l m r
 349     | otherwise                        = ldoubleLeft  k p v l m r
 350
 351 lbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 352 lbalanceRight k p v l m r
 353     | size' (left l) > size' (right l) = lsingleRight k p v l m r
 354     | otherwise                        = ldoubleRight k p v l m r
 355
 356 rbalanceLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 357 rbalanceLeft  k p v l m r
 358     | size' (left r) < size' (right r) = rsingleLeft  k p v l m r
 359     | otherwise                        = rdoubleLeft  k p v l m r
 360
 361 rbalanceRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 362 rbalanceRight k p v l m r
 363     | size' (left l) > size' (right l) = rsingleRight k p v l m r
 364     | otherwise                        = rdoubleRight k p v l m r
 365
 366 lsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 367 lsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3)
 368     | p1 <= p2  = lloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3
 369     | otherwise = lloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3
 370 lsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
 371     rloser k2 p2 v2 (lloser k1 p1 v1 t1 m1 t2) m2 t3
 372 lsingleLeft _ _ _ _ _ _ = moduleError "lsingleLeft" "malformed tree"
 373
 374 rsingleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 375 rsingleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =
 376     rloser k1 p1 v1 (rloser k2 p2 v2 t1 m1 t2) m2 t3
 377 rsingleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
 378     rloser k2 p2 v2 (rloser k1 p1 v1 t1 m1 t2) m2 t3
 379 rsingleLeft _ _ _ _ _ _ = moduleError "rsingleLeft" "malformed tree"
 380
 381 lsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 382 lsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
 383     lloser k2 p2 v2 t1 m1 (lloser k1 p1 v1 t2 m2 t3)
 384 lsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
 385     lloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)
 386 lsingleRight _ _ _ _ _ _ = moduleError "lsingleRight" "malformed tree"
 387
 388 rsingleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 389 rsingleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
 390     lloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)
 391 rsingleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3
 392     | p1 <= p2  = rloser k1 p1 v1 t1 m1 (lloser k2 p2 v2 t2 m2 t3)
 393     | otherwise = rloser k2 p2 v2 t1 m1 (rloser k1 p1 v1 t2 m2 t3)
 394 rsingleRight _ _ _ _ _ _ = moduleError "rsingleRight" "malformed tree"
 395
 396 ldoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 397 ldoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =
 398     lsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)
 399 ldoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
 400     lsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)
 401 ldoubleLeft _ _ _ _ _ _ = moduleError "ldoubleLeft" "malformed tree"
 402
 403 ldoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 404 ldoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
 405     lsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
 406 ldoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
 407     lsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
 408 ldoubleRight _ _ _ _ _ _ = moduleError "ldoubleRight" "malformed tree"
 409
 410 rdoubleLeft :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 411 rdoubleLeft k1 p1 v1 t1 m1 (LLoser _ (E k2 p2 v2) t2 m2 t3) =
 412     rsingleLeft k1 p1 v1 t1 m1 (lsingleRight k2 p2 v2 t2 m2 t3)
 413 rdoubleLeft k1 p1 v1 t1 m1 (RLoser _ (E k2 p2 v2) t2 m2 t3) =
 414     rsingleLeft k1 p1 v1 t1 m1 (rsingleRight k2 p2 v2 t2 m2 t3)
 415 rdoubleLeft _ _ _ _ _ _ = moduleError "rdoubleLeft" "malformed tree"
 416
 417 rdoubleRight :: Key -> Prio -> a -> LTree a -> Key -> LTree a -> LTree a
 418 rdoubleRight k1 p1 v1 (LLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
 419     rsingleRight k1 p1 v1 (lsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
 420 rdoubleRight k1 p1 v1 (RLoser _ (E k2 p2 v2) t1 m1 t2) m2 t3 =
 421     rsingleRight k1 p1 v1 (rsingleLeft k2 p2 v2 t1 m1 t2) m2 t3
 422 rdoubleRight _ _ _ _ _ _ = moduleError "rdoubleRight" "malformed tree"
 423
 424 -- | Take two pennants and returns a new pennant that is the union of
 425 -- the two with the precondition that the keys in the ﬁrst tree are
 426 -- strictly smaller than the keys in the second tree.
 427 play :: PSQ a -> PSQ a -> PSQ a
 428 Void `play` t' = t'
 429 t `play` Void  = t
 430 Winner e@(E k p v) t m `play` Winner e'@(E k' p' v') t' m'
 431     | p <= p'   = Winner e (rbalance k' p' v' t m t') m'
 432     | otherwise = Winner e' (lbalance k p v t m t') m'
 433 {-# INLINE play #-}
 434
 435 -- | A version of 'play' that can be used if the shape of the tree has
 436 -- not changed or if the tree is known to be balanced.
 437 unsafePlay :: PSQ a -> PSQ a -> PSQ a
 438 Void `unsafePlay` t' =  t'
 439 t `unsafePlay` Void  =  t
 440 Winner e@(E k p v) t m `unsafePlay` Winner e'@(E k' p' v') t' m'
 441     | p <= p'   = Winner e (rloser k' p' v' t m t') m'
 442     | otherwise = Winner e' (lloser k p v t m t') m'
 443 {-# INLINE unsafePlay #-}
 444
 445 data TourView a = Null
 446                 | Single {-# UNPACK #-} !(Elem a)
 447                 | (PSQ a) `Play` (PSQ a)
 448
 449 tourView :: PSQ a -> TourView a
 450 tourView Void               = Null
 451 tourView (Winner e Start _) = Single e
 452 tourView (Winner e (RLoser _ e' tl m tr) m') =
 453     Winner e tl m `Play` Winner e' tr m'
 454 tourView (Winner e (LLoser _ e' tl m tr) m') =
 455     Winner e' tl m `Play` Winner e tr m'
 456
 457 ------------------------------------------------------------------------
 458 -- Utility functions
 459
 460 moduleError :: String -> String -> a
 461 moduleError fun msg = error ("System.Event.PSQ." ++ fun ++ ':' : ' ' : msg)
 462 {-# NOINLINE moduleError #-}
 463
 464 ------------------------------------------------------------------------
 465 -- Hughes's efficient sequence type
 466
 467 newtype Sequ a = Sequ ([a] -> [a])
 468
 469 emptySequ :: Sequ a
 470 emptySequ = Sequ (\as -> as)
 471
 472 singleSequ :: a -> Sequ a
 473 singleSequ a = Sequ (\as -> a : as)
 474
 475 (<>) :: Sequ a -> Sequ a -> Sequ a
 476 Sequ x1 <> Sequ x2 = Sequ (\as -> x1 (x2 as))
 477 infixr 5 <>
 478
 479 seqToList :: Sequ a -> [a]
 480 seqToList (Sequ x) = x []
 481
 482 instance Show a => Show (Sequ a) where
 483     showsPrec d a = showsPrec d (seqToList a)