-- Copyright (c) 2016, Emil Axelsson, Peter Jonsson, Anders Persson and
--                     Josef Svenningsson
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are met:
--
--     * Redistributions of source code must retain the above copyright notice,
--       this list of conditions and the following disclaimer.
--     * Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in the
--       documentation and/or other materials provided with the distribution.
--     * Neither the name of the ERICSSON AB nor the names of its contributors
--       may be used to endorse or promote products derived from this software
--       without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
-- AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
-- IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
-- FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-- SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
-- CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
-- OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

-- | Indexable FIFO queues

module Feldspar.Data.Queue
  ( Queue (..)
  , initQueueFromBuffer
  , initQueue
  , newQueue
  , initQueueFromBuffer2
  , initQueue2
  , newQueue2
  ) where



import Prelude ()

import Feldspar
import Feldspar.Data.Vector



-- | Indexable FIFO queue
data Queue a = Queue
    { Queue a -> forall (m :: * -> *). MonadComp m => Data Index -> m a
indexQ :: forall m   . MonadComp m => Data Index -> m a
    , Queue a -> forall (m :: * -> *). MonadComp m => a -> m ()
putQ   :: forall m   . MonadComp m => a -> m ()
    , Queue a
-> forall (m :: * -> *) b.
   (Syntax b, MonadComp m) =>
   (Pull a -> m b) -> m b
withQ  :: forall m b . (Syntax b, MonadComp m) => (Pull a -> m b) -> m b
    }

-- Another option would be to represent a queue as its state (the counter and
-- the array), but the above representation leaves room for other
-- implementations.

-- | Create a new cyclic queue using an existing array as buffer. The length of
-- the array determines the queue size.
initQueueFromBuffer :: forall m a . (Syntax a, MonadComp m) =>
    Arr a -> m (Queue a)
initQueueFromBuffer :: Arr a -> m (Queue a)
initQueueFromBuffer Arr a
buf = do
    Ref (Data Index)
ir <- Data Index -> m (Ref (Data Index))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Index
0
    let indexQ :: forall m2 . MonadComp m2 => Data Index -> m2 a
        indexQ :: Data Index -> m2 a
indexQ Data Index
j = do
          Data Index
i <- Ref (Data Index) -> m2 (Data Index)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Index)
ir
          Arr a -> Data Index -> m2 a
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Arr a -> Data Index -> m a
getArr Arr a
buf (Data Index -> m2 a) -> Data Index -> m2 a
forall a b. (a -> b) -> a -> b
$ Data Index -> Data Index -> Data Index
calcIndex Data Index
i Data Index
j
        putQ :: forall m2 . MonadComp m2 => a -> m2 ()
        putQ :: a -> m2 ()
putQ a
a = do
          Data Index
i <- Ref (Data Index) -> m2 (Data Index)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Index)
ir
          Arr a -> Data Index -> a -> m2 ()
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> Data Index -> a -> m ()
setArr Arr a
buf Data Index
i a
a
          Ref (Data Index) -> Data Index -> m2 ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Index)
ir ((Data Index
iData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
+Data Index
1) Data Index -> Data Index -> Data Index
forall a. (Integral a, PrimType a) => Data a -> Data a -> Data a
`mod` Data Index
len)
        withQ :: forall m2 b . (Syntax b, MonadComp m2) => (Pull a -> m2 b) -> m2 b
        withQ :: (Pull a -> m2 b) -> m2 b
withQ Pull a -> m2 b
f = do
          Data Index
i   <- Ref (Data Index) -> m2 (Data Index)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Index)
ir
          IArr a
vec <- Arr a -> m2 (IArr a)
forall (m :: * -> *) a. MonadComp m => Arr a -> m (IArr a)
unsafeFreezeArr Arr a
buf
          Pull a -> m2 b
f (Pull a -> m2 b) -> Pull a -> m2 b
forall a b. (a -> b) -> a -> b
$ (Data Index -> Data Index -> Data Index) -> IArr a -> Pull a
forall vec a.
Pully vec a =>
(Data Index -> Data Index -> Data Index) -> vec -> Pull a
backPermute (\Data Index
_ -> Data Index -> Data Index -> Data Index
calcIndex Data Index
i) IArr a
vec
    Queue a -> m (Queue a)
forall (m :: * -> *) a. Monad m => a -> m a
return Queue :: forall a.
(forall (m :: * -> *). MonadComp m => Data Index -> m a)
-> (forall (m :: * -> *). MonadComp m => a -> m ())
-> (forall (m :: * -> *) b.
    (Syntax b, MonadComp m) =>
    (Pull a -> m b) -> m b)
-> Queue a
Queue {forall (m2 :: * -> *). MonadComp m2 => a -> m2 ()
forall (m2 :: * -> *). MonadComp m2 => Data Index -> m2 a
forall (m2 :: * -> *) b.
(Syntax b, MonadComp m2) =>
(Pull a -> m2 b) -> m2 b
withQ :: forall (m2 :: * -> *) b.
(Syntax b, MonadComp m2) =>
(Pull a -> m2 b) -> m2 b
putQ :: forall (m2 :: * -> *). MonadComp m2 => a -> m2 ()
indexQ :: forall (m2 :: * -> *). MonadComp m2 => Data Index -> m2 a
withQ :: forall (m2 :: * -> *) b.
(Syntax b, MonadComp m2) =>
(Pull a -> m2 b) -> m2 b
putQ :: forall (m2 :: * -> *). MonadComp m2 => a -> m2 ()
indexQ :: forall (m2 :: * -> *). MonadComp m2 => Data Index -> m2 a
..}
  where
    len :: Data Index
len = Arr a -> Data Index
forall a. Finite a => a -> Data Index
length Arr a
buf
    calcIndex :: Data Index -> Data Index -> Data Index
calcIndex Data Index
i Data Index
j = (Data Index
lenData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
+Data Index
iData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
-Data Index
jData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
-Data Index
1) Data Index -> Data Index -> Data Index
forall a. (Integral a, PrimType a) => Data a -> Data a -> Data a
`mod` Data Index
len

-- | Create a new cyclic queue initialized by the given vector (which also
-- determines the size)
initQueue :: (Manifestable m vec a, Finite vec, Syntax a, MonadComp m)
    => vec  -- ^ Initial content (also determines the queue size)
    -> m (Queue a)
initQueue :: vec -> m (Queue a)
initQueue vec
init = do
    Arr a
buf <- Data Index -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Index -> m (Arr a)
newArr (Data Index -> m (Arr a)) -> Data Index -> m (Arr a)
forall a b. (a -> b) -> a -> b
$ vec -> Data Index
forall a. Finite a => a -> Data Index
length vec
init
    Arr a -> vec -> m ()
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
Arr a -> vec -> m ()
manifestStore Arr a
buf vec
init
    Arr a -> m (Queue a)
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> m (Queue a)
initQueueFromBuffer Arr a
buf

-- | Create a new cyclic queue of the given length without initialization
newQueue :: (Syntax a, MonadComp m) => Data Length -> m (Queue a)
newQueue :: Data Index -> m (Queue a)
newQueue Data Index
l = Data Index -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Index -> m (Arr a)
newArr Data Index
l m (Arr a) -> (Arr a -> m (Queue a)) -> m (Queue a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Arr a -> m (Queue a)
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> m (Queue a)
initQueueFromBuffer

initQueueFromBuffer2 :: forall m a . (Syntax a, MonadComp m)
    => Data Length  -- ^ Queue size, must be <= half the buffer size
    -> Arr a        -- ^ Buffer
    -> m (Queue a)
initQueueFromBuffer2 :: Data Index -> Arr a -> m (Queue a)
initQueueFromBuffer2 Data Index
len Arr a
buf = do
    Ref (Data Index)
ir <- Data Index -> m (Ref (Data Index))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Index
0
    let indexQ :: forall m2 . MonadComp m2 => Data Index -> m2 a
        indexQ :: Data Index -> m2 a
indexQ Data Index
j = do
          Data Index
i <- Ref (Data Index) -> m2 (Data Index)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Index)
ir
          Arr a -> Data Index -> m2 a
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Arr a -> Data Index -> m a
getArr Arr a
buf (Data Index
lenData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
+Data Index
iData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
-Data Index
jData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
-Data Index
1)
        putQ :: forall m2 . MonadComp m2 => a -> m2 ()
        putQ :: a -> m2 ()
putQ a
a = do
          Data Index
i <- Ref (Data Index) -> m2 (Data Index)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Index)
ir
          Arr a -> Data Index -> a -> m2 ()
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> Data Index -> a -> m ()
setArr Arr a
buf Data Index
i a
a
          Arr a -> Data Index -> a -> m2 ()
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Arr a -> Data Index -> a -> m ()
setArr Arr a
buf (Data Index
iData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
+Data Index
len) a
a
          Ref (Data Index) -> Data Index -> m2 ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Index)
ir ((Data Index
iData Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
+Data Index
1) Data Index -> Data Index -> Data Index
forall a. (Integral a, PrimType a) => Data a -> Data a -> Data a
`mod` Data Index
len)
        withQ :: forall m2 b . (Syntax b, MonadComp m2) => (Pull a -> m2 b) -> m2 b
        withQ :: (Pull a -> m2 b) -> m2 b
withQ Pull a -> m2 b
f = do
          Data Index
i <- Ref (Data Index) -> m2 (Data Index)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Index)
ir
          IArr a
vec <- Arr a -> m2 (IArr a)
forall (m :: * -> *) a. MonadComp m => Arr a -> m (IArr a)
unsafeFreezeArr Arr a
buf
          Pull a -> m2 b
f (Pull a -> m2 b) -> Pull a -> m2 b
forall a b. (a -> b) -> a -> b
$ Pull a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
reverse (Pull a -> Pull a) -> Pull a -> Pull a
forall a b. (a -> b) -> a -> b
$ Data Index -> Pull a -> Pull a
forall vec a. Pully vec a => Data Index -> vec -> Pull a
take Data Index
len (Pull a -> Pull a) -> Pull a -> Pull a
forall a b. (a -> b) -> a -> b
$ Data Index -> IArr a -> Pull a
forall vec a. Pully vec a => Data Index -> vec -> Pull a
drop Data Index
i IArr a
vec
    Queue a -> m (Queue a)
forall (m :: * -> *) a. Monad m => a -> m a
return Queue :: forall a.
(forall (m :: * -> *). MonadComp m => Data Index -> m a)
-> (forall (m :: * -> *). MonadComp m => a -> m ())
-> (forall (m :: * -> *) b.
    (Syntax b, MonadComp m) =>
    (Pull a -> m b) -> m b)
-> Queue a
Queue {forall (m2 :: * -> *). MonadComp m2 => a -> m2 ()
forall (m2 :: * -> *). MonadComp m2 => Data Index -> m2 a
forall (m2 :: * -> *) b.
(Syntax b, MonadComp m2) =>
(Pull a -> m2 b) -> m2 b
withQ :: forall (m2 :: * -> *) b.
(Syntax b, MonadComp m2) =>
(Pull a -> m2 b) -> m2 b
putQ :: forall (m2 :: * -> *). MonadComp m2 => a -> m2 ()
indexQ :: forall (m2 :: * -> *). MonadComp m2 => Data Index -> m2 a
withQ :: forall (m2 :: * -> *) b.
(Syntax b, MonadComp m2) =>
(Pull a -> m2 b) -> m2 b
putQ :: forall (m2 :: * -> *). MonadComp m2 => a -> m2 ()
indexQ :: forall (m2 :: * -> *). MonadComp m2 => Data Index -> m2 a
..}

-- | Create a new cyclic queue. This implementation uses a buffer twice as long
-- as the queue size to avoid modulus operations when accessing the elements.
initQueue2 :: (Pushy m vec a, Finite vec, Syntax a, MonadComp m)
    => vec  -- ^ Initial content (also determines the queue size)
    -> m (Queue a)
initQueue2 :: vec -> m (Queue a)
initQueue2 vec
init = do
    Arr a
buf <- Data Index -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Index -> m (Arr a)
newArr (Data Index
2Data Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
*Data Index
len)
    Arr a -> Push m a -> m ()
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
Arr a -> vec -> m ()
manifestStore Arr a
buf (vec
initvec -> vec -> Push m a
forall (m :: * -> *) vec1 a vec2.
(Pushy m vec1 a, Pushy m vec2 a, Monad m) =>
vec1 -> vec2 -> Push m a
++vec
init)
    Data Index -> Arr a -> m (Queue a)
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Data Index -> Arr a -> m (Queue a)
initQueueFromBuffer2 Data Index
len Arr a
buf
  where
    len :: Data Index
len = vec -> Data Index
forall a. Finite a => a -> Data Index
length vec
init

-- | Create a new cyclic queue. This implementation uses a buffer twice as long
-- as the queue size to avoid modulus operations when accessing the elements.
newQueue2 :: (Syntax a, MonadComp m)
    => Data Length  -- ^ Queue size
    -> m (Queue a)
newQueue2 :: Data Index -> m (Queue a)
newQueue2 Data Index
l = do
    Arr a
buf <- Data Index -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Index -> m (Arr a)
newArr (Data Index
2Data Index -> Data Index -> Data Index
forall a. Num a => a -> a -> a
*Data Index
l)
    Data Index -> Arr a -> m (Queue a)
forall (m :: * -> *) a.
(Syntax a, MonadComp m) =>
Data Index -> Arr a -> m (Queue a)
initQueueFromBuffer2 Data Index
l Arr a
buf