-- | Storable types
--
-- Note that the 'Storable' interface is currently not ideal for vectors:
--
-- * The 'Store' representation only allows a vector to be read back as the same
--   type as it was written. But it is usually desired to read a vector as
--   'Manifest' regardless of what type it was written as.
--
--     - But this is solved by using functions that operated on 'StoreRep'
--       instead (such as 'readStoreRep').
--
-- * There is no support for double-buffered storage, as provided by
--   "Feldspar.Data.Buffered" which means that memory management can become more
--   tedious.

module Feldspar.Data.Storable where



import qualified Prelude

import Control.Monad
import Data.Proxy

import Feldspar
import Feldspar.Data.Vector
import Feldspar.Data.Option
import Feldspar.Data.Validated



--------------------------------------------------------------------------------
-- * 'Forcible' class
--------------------------------------------------------------------------------

-- | Expression types that can be \"forced\" to values
class Forcible a
  where
    -- | Representation of a forced value
    type ValueRep a

    -- | Force an expression to a value. The resulting value can be used
    -- multiple times without risking re-computation.
    --
    -- 'toValue' will allocate memory to hold the value.
    toValue :: MonadComp m => a -> m (ValueRep a)

    -- | Convert a forced value back to an expression
    fromValue :: ValueRep a -> a

-- To some extent `Forcible` is subsumed by `Storable`. However, `ValueRep` is
-- more convenient to deal with for the user than `StoreRep`, since the latter
-- consists of mutable data structures (e.g. `Ref a` instead of `Data a`).

-- `Forcible` also resembles the `Syntactic` class, with the difference that the
-- former has a monadic interface and a more free internal representation
-- (`Syntactic` only allows `Data (Internal a)` as the internal representation).
--
-- This difference has two main benefits:
--
--   * We can guarantee that `toValue` returns a "cheep" value. There is no such
--     guarantee for `desugar` of the `Syntactic` class.
--   * We can use data structures such as `IArr` as the representation of values

instance Type a => Forcible (Data a)
  where
    type ValueRep (Data a) = Data a
    toValue :: Data a -> m (ValueRep (Data a))
toValue   = Ref (Data a) -> m (Data a)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef (Ref (Data a) -> m (Data a))
-> (Data a -> m (Ref (Data a))) -> Data a -> m (Data a)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Data a -> m (Ref (Data a))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef
    fromValue :: ValueRep (Data a) -> Data a
fromValue = ValueRep (Data a) -> Data a
forall a. Syntax a => Data (Internal a) -> a
sugar

instance (Forcible a, Forcible b) => Forcible (a,b)
  where
    type ValueRep (a,b) = (ValueRep a, ValueRep b)
    toValue :: (a, b) -> m (ValueRep (a, b))
toValue (a
a,b
b)   = (,) (ValueRep a -> ValueRep b -> (ValueRep a, ValueRep b))
-> m (ValueRep a) -> m (ValueRep b -> (ValueRep a, ValueRep b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (ValueRep a)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue a
a m (ValueRep b -> (ValueRep a, ValueRep b))
-> m (ValueRep b) -> m (ValueRep a, ValueRep b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (ValueRep b)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue b
b
    fromValue :: ValueRep (a, b) -> (a, b)
fromValue (a,b) = (ValueRep a -> a
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep a
a, ValueRep b -> b
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep b
b)

instance (Forcible a, Forcible b, Forcible c) => Forcible (a,b,c)
  where
    type ValueRep (a,b,c) = (ValueRep a, ValueRep b, ValueRep c)
    toValue :: (a, b, c) -> m (ValueRep (a, b, c))
toValue (a
a,b
b,c
c)   = (,,) (ValueRep a
 -> ValueRep b
 -> ValueRep c
 -> (ValueRep a, ValueRep b, ValueRep c))
-> m (ValueRep a)
-> m (ValueRep b
      -> ValueRep c -> (ValueRep a, ValueRep b, ValueRep c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (ValueRep a)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue a
a m (ValueRep b
   -> ValueRep c -> (ValueRep a, ValueRep b, ValueRep c))
-> m (ValueRep b)
-> m (ValueRep c -> (ValueRep a, ValueRep b, ValueRep c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (ValueRep b)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue b
b m (ValueRep c -> (ValueRep a, ValueRep b, ValueRep c))
-> m (ValueRep c) -> m (ValueRep a, ValueRep b, ValueRep c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> m (ValueRep c)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue c
c
    fromValue :: ValueRep (a, b, c) -> (a, b, c)
fromValue (a,b,c) = (ValueRep a -> a
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep a
a, ValueRep b -> b
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep b
b, ValueRep c -> c
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep c
c)

instance (Forcible a, Forcible b, Forcible c, Forcible d) => Forcible (a,b,c,d)
  where
    type ValueRep (a,b,c,d) = (ValueRep a, ValueRep b, ValueRep c, ValueRep d)
    toValue :: (a, b, c, d) -> m (ValueRep (a, b, c, d))
toValue (a
a,b
b,c
c,d
d)   = (,,,) (ValueRep a
 -> ValueRep b
 -> ValueRep c
 -> ValueRep d
 -> (ValueRep a, ValueRep b, ValueRep c, ValueRep d))
-> m (ValueRep a)
-> m (ValueRep b
      -> ValueRep c
      -> ValueRep d
      -> (ValueRep a, ValueRep b, ValueRep c, ValueRep d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (ValueRep a)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue a
a m (ValueRep b
   -> ValueRep c
   -> ValueRep d
   -> (ValueRep a, ValueRep b, ValueRep c, ValueRep d))
-> m (ValueRep b)
-> m (ValueRep c
      -> ValueRep d -> (ValueRep a, ValueRep b, ValueRep c, ValueRep d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (ValueRep b)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue b
b m (ValueRep c
   -> ValueRep d -> (ValueRep a, ValueRep b, ValueRep c, ValueRep d))
-> m (ValueRep c)
-> m (ValueRep d
      -> (ValueRep a, ValueRep b, ValueRep c, ValueRep d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> m (ValueRep c)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue c
c m (ValueRep d -> (ValueRep a, ValueRep b, ValueRep c, ValueRep d))
-> m (ValueRep d)
-> m (ValueRep a, ValueRep b, ValueRep c, ValueRep d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> m (ValueRep d)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue d
d
    fromValue :: ValueRep (a, b, c, d) -> (a, b, c, d)
fromValue (a,b,c,d) = (ValueRep a -> a
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep a
a, ValueRep b -> b
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep b
b, ValueRep c -> c
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep c
c, ValueRep d -> d
forall a. Forcible a => ValueRep a -> a
fromValue ValueRep d
d)

instance Forcible a => Forcible [a]
  where
    type ValueRep [a] = [ValueRep a]
    toValue :: [a] -> m (ValueRep [a])
toValue   = (a -> m (ValueRep a)) -> [a] -> m [ValueRep a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM a -> m (ValueRep a)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue
    fromValue :: ValueRep [a] -> [a]
fromValue = (ValueRep a -> a) -> [ValueRep a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map ValueRep a -> a
forall a. Forcible a => ValueRep a -> a
fromValue

-- | 'toValue' will force the value even if it's invalid
instance Forcible a => Forcible (Validated a)
  where
    type ValueRep (Validated a) = (Data Bool, ValueRep a)
    toValue :: Validated a -> m (ValueRep (Validated a))
toValue (Validated Data Bool
valid a
a) = (Data Bool, a) -> m (ValueRep (Data Bool, a))
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue (Data Bool
valid,a
a)
    fromValue :: ValueRep (Validated a) -> Validated a
fromValue = (Data Bool -> a -> Validated a) -> (Data Bool, a) -> Validated a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Data Bool -> a -> Validated a
forall a. Data Bool -> a -> Validated a
Validated ((Data Bool, a) -> Validated a)
-> ((Data Bool, ValueRep a) -> (Data Bool, a))
-> (Data Bool, ValueRep a)
-> Validated a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Data Bool, ValueRep a) -> (Data Bool, a)
forall a. Forcible a => ValueRep a -> a
fromValue

instance Syntax a => Forcible (Option a)
  where
    type ValueRep (Option a) = (Data Bool, a)
    toValue :: Option a -> m (ValueRep (Option a))
toValue Option a
o = do
        Ref (Data Bool)
valid <- Data Bool -> m (Ref (Data Bool))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Bool
false
        Ref a
r     <- a -> m (Ref a)
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef (a
forall a. Syntax a => a
example :: a)
        Option a -> (String -> m ()) -> (a -> m ()) -> m ()
forall (m :: * -> *) a.
MonadComp m =>
Option a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionM Option a
o
          (\String
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          (\a
b -> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
valid Data Bool
true m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ref a -> a -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref a
r a
b)
        (,) (Data Bool -> a -> (Data Bool, a))
-> m (Data Bool) -> m (a -> (Data Bool, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref (Data Bool) -> m (Data Bool)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Bool)
valid m (a -> (Data Bool, a)) -> m a -> m (Data Bool, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ref a -> m a
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref a
r
    fromValue :: ValueRep (Option a) -> Option a
fromValue (valid,a) = String -> Data Bool -> a -> Option a
forall (m :: * -> *) a.
Monad m =>
String -> Data Bool -> a -> OptionT m a
guarded String
"fromIStore: none" Data Bool
valid a
a
  -- Ideally, one should use `Storable` instead of the `Syntax` constraint, and
  -- make `r` a `Store` instead of a reference. But the problem is that one
  -- would have to make use of `newStore` which needs a size argument. This is
  -- problematic because the size of the value is not known until inside
  -- `caseOptionM`.

-- Note: There are no instances for vector types, because that would require
-- allocating a new array inside `toValue`.

-- | Cast between 'Forcible' types that have the same value representation
forceCast :: (Forcible a, Forcible b, ValueRep a ~ ValueRep b, MonadComp m) =>
    a -> m b
forceCast :: a -> m b
forceCast = (ValueRep b -> b) -> m (ValueRep b) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueRep b -> b
forall a. Forcible a => ValueRep a -> a
fromValue (m (ValueRep b) -> m b) -> (a -> m (ValueRep b)) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (ValueRep b)
forall a (m :: * -> *).
(Forcible a, MonadComp m) =>
a -> m (ValueRep a)
toValue

-- | Force the computation of an expression. The resulting value can be used
-- multiple times without risking re-computation.
force :: (Forcible a, MonadComp m) => a -> m a
force :: a -> m a
force = a -> m a
forall a b (m :: * -> *).
(Forcible a, Forcible b, ValueRep a ~ ValueRep b, MonadComp m) =>
a -> m b
forceCast



--------------------------------------------------------------------------------
-- * 'Storable' class
--------------------------------------------------------------------------------

-- | Storable types
class Storable a
  where
    -- | Memory representation
    type StoreRep a
    -- | Size of memory representation
    type StoreSize a

    -- | Creat a fresh memory store. It is usually better to use 'newStore'
    -- instead of this function as it improves type inference.
    newStoreRep :: MonadComp m => proxy a -> StoreSize a -> m (StoreRep a)

    -- | Store a value to a fresh memory store. It is usually better to use
    -- 'initStore' instead of this function as it improves type inference.
    initStoreRep :: MonadComp m => a -> m (StoreRep a)

    -- | Read from a memory store. It is usually better to use 'readStore'
    -- instead of this function as it improves type inference.
    readStoreRep :: MonadComp m => StoreRep a -> m a

    -- | Unsafe freezing of a memory store. It is usually better to use
    -- 'unsafeFreezeStore' instead of this function as it improves type
    -- inference.
    unsafeFreezeStoreRep :: MonadComp m => StoreRep a -> m a

    -- | Write to a memory store. It is usually better to use 'writeStore'
    -- instead of this function as it improves type inference.
    writeStoreRep :: MonadComp m => StoreRep a -> a -> m ()

instance Storable ()
  where
    type StoreRep ()  = ()
    type StoreSize () = ()
    newStoreRep :: proxy () -> StoreSize () -> m (StoreRep ())
newStoreRep proxy ()
_ StoreSize ()
_        = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    initStoreRep :: () -> m (StoreRep ())
initStoreRep ()
_         = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    readStoreRep :: StoreRep () -> m ()
readStoreRep StoreRep ()
_         = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    unsafeFreezeStoreRep :: StoreRep () -> m ()
unsafeFreezeStoreRep StoreRep ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    writeStoreRep :: StoreRep () -> () -> m ()
writeStoreRep StoreRep ()
_ ()
_      = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

instance Type a => Storable (Data a)
  where
    type StoreRep (Data a)  = DRef a
    type StoreSize (Data a) = ()
    newStoreRep :: proxy (Data a) -> StoreSize (Data a) -> m (StoreRep (Data a))
newStoreRep proxy (Data a)
_ StoreSize (Data a)
_      = m (StoreRep (Data a))
forall a (m :: * -> *). (Syntax a, MonadComp m) => m (Ref a)
newRef
    initStoreRep :: Data a -> m (StoreRep (Data a))
initStoreRep         = Data a -> m (StoreRep (Data a))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef
    readStoreRep :: StoreRep (Data a) -> m (Data a)
readStoreRep         = StoreRep (Data a) -> m (Data a)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef
    unsafeFreezeStoreRep :: StoreRep (Data a) -> m (Data a)
unsafeFreezeStoreRep = StoreRep (Data a) -> m (Data a)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef
    writeStoreRep :: StoreRep (Data a) -> Data a -> m ()
writeStoreRep        = StoreRep (Data a) -> Data a -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef

instance (Storable a, Storable b) => Storable (a,b)
  where
    type StoreRep (a,b)  = (StoreRep a, StoreRep b)
    type StoreSize (a,b) = (StoreSize a, StoreSize b)
    newStoreRep :: proxy (a, b) -> StoreSize (a, b) -> m (StoreRep (a, b))
newStoreRep proxy (a, b)
_ (a,b)          = (,) (StoreRep a -> StoreRep b -> (StoreRep a, StoreRep b))
-> m (StoreRep a) -> m (StoreRep b -> (StoreRep a, StoreRep b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> StoreSize a -> m (StoreRep a)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) StoreSize a
a m (StoreRep b -> (StoreRep a, StoreRep b))
-> m (StoreRep b) -> m (StoreRep a, StoreRep b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy b -> StoreSize b -> m (StoreRep b)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) StoreSize b
b
    initStoreRep :: (a, b) -> m (StoreRep (a, b))
initStoreRep (a
a,b
b)           = (,) (StoreRep a -> StoreRep b -> (StoreRep a, StoreRep b))
-> m (StoreRep a) -> m (StoreRep b -> (StoreRep a, StoreRep b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (StoreRep a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep a
a m (StoreRep b -> (StoreRep a, StoreRep b))
-> m (StoreRep b) -> m (StoreRep a, StoreRep b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (StoreRep b)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep b
b
    readStoreRep :: StoreRep (a, b) -> m (a, b)
readStoreRep (la,lb)         = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep a
la m (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep b -> m b
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep b
lb
    unsafeFreezeStoreRep :: StoreRep (a, b) -> m (a, b)
unsafeFreezeStoreRep (la,lb) = (,) (a -> b -> (a, b)) -> m a -> m (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep a
la m (b -> (a, b)) -> m b -> m (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep b -> m b
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep b
lb
    writeStoreRep :: StoreRep (a, b) -> (a, b) -> m ()
writeStoreRep (la,lb) (a
a,b
b)  = StoreRep a -> a -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep a
la a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoreRep b -> b -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep b
lb b
b

instance (Storable a, Storable b, Storable c) => Storable (a,b,c)
  where
    type StoreRep (a,b,c)  = (StoreRep a, StoreRep b, StoreRep c)
    type StoreSize (a,b,c) = (StoreSize a, StoreSize b, StoreSize c)
    newStoreRep :: proxy (a, b, c) -> StoreSize (a, b, c) -> m (StoreRep (a, b, c))
newStoreRep proxy (a, b, c)
_ (a,b,c)            = (,,) (StoreRep a
 -> StoreRep b
 -> StoreRep c
 -> (StoreRep a, StoreRep b, StoreRep c))
-> m (StoreRep a)
-> m (StoreRep b
      -> StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> StoreSize a -> m (StoreRep a)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) StoreSize a
a m (StoreRep b
   -> StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
-> m (StoreRep b)
-> m (StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy b -> StoreSize b -> m (StoreRep b)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) StoreSize b
b m (StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
-> m (StoreRep c) -> m (StoreRep a, StoreRep b, StoreRep c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy c -> StoreSize c -> m (StoreRep c)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c) StoreSize c
c
    initStoreRep :: (a, b, c) -> m (StoreRep (a, b, c))
initStoreRep (a
a,b
b,c
c)             = (,,) (StoreRep a
 -> StoreRep b
 -> StoreRep c
 -> (StoreRep a, StoreRep b, StoreRep c))
-> m (StoreRep a)
-> m (StoreRep b
      -> StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (StoreRep a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep a
a m (StoreRep b
   -> StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
-> m (StoreRep b)
-> m (StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (StoreRep b)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep b
b m (StoreRep c -> (StoreRep a, StoreRep b, StoreRep c))
-> m (StoreRep c) -> m (StoreRep a, StoreRep b, StoreRep c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> m (StoreRep c)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep c
c
    readStoreRep :: StoreRep (a, b, c) -> m (a, b, c)
readStoreRep (la,lb,lc)          = (,,) (a -> b -> c -> (a, b, c)) -> m a -> m (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep a
la m (b -> c -> (a, b, c)) -> m b -> m (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep b -> m b
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep b
lb m (c -> (a, b, c)) -> m c -> m (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep c -> m c
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep c
lc
    unsafeFreezeStoreRep :: StoreRep (a, b, c) -> m (a, b, c)
unsafeFreezeStoreRep (la,lb,lc)  = (,,) (a -> b -> c -> (a, b, c)) -> m a -> m (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep a
la m (b -> c -> (a, b, c)) -> m b -> m (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep b -> m b
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep b
lb m (c -> (a, b, c)) -> m c -> m (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep c -> m c
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep c
lc
    writeStoreRep :: StoreRep (a, b, c) -> (a, b, c) -> m ()
writeStoreRep (la,lb,lc) (a
a,b
b,c
c) = StoreRep a -> a -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep a
la a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoreRep b -> b -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep b
lb b
b m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoreRep c -> c -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep c
lc c
c

instance (Storable a, Storable b, Storable c, Storable d) => Storable (a,b,c,d)
  where
    type StoreRep (a,b,c,d)  = (StoreRep a, StoreRep b, StoreRep c, StoreRep d)
    type StoreSize (a,b,c,d) = (StoreSize a, StoreSize b, StoreSize c, StoreSize d)
    newStoreRep :: proxy (a, b, c, d)
-> StoreSize (a, b, c, d) -> m (StoreRep (a, b, c, d))
newStoreRep proxy (a, b, c, d)
_ (a,b,c,d)               = (,,,) (StoreRep a
 -> StoreRep b
 -> StoreRep c
 -> StoreRep d
 -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep a)
-> m (StoreRep b
      -> StoreRep c
      -> StoreRep d
      -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy a -> StoreSize a -> m (StoreRep a)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) StoreSize a
a m (StoreRep b
   -> StoreRep c
   -> StoreRep d
   -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep b)
-> m (StoreRep c
      -> StoreRep d -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy b -> StoreSize b -> m (StoreRep b)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy b
forall k (t :: k). Proxy t
Proxy :: Proxy b) StoreSize b
b m (StoreRep c
   -> StoreRep d -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep c)
-> m (StoreRep d
      -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy c -> StoreSize c -> m (StoreRep c)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy c
forall k (t :: k). Proxy t
Proxy :: Proxy c) StoreSize c
c m (StoreRep d -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep d)
-> m (StoreRep a, StoreRep b, StoreRep c, StoreRep d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy d -> StoreSize d -> m (StoreRep d)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy d
forall k (t :: k). Proxy t
Proxy :: Proxy d) StoreSize d
d
    initStoreRep :: (a, b, c, d) -> m (StoreRep (a, b, c, d))
initStoreRep (a
a,b
b,c
c,d
d)                = (,,,) (StoreRep a
 -> StoreRep b
 -> StoreRep c
 -> StoreRep d
 -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep a)
-> m (StoreRep b
      -> StoreRep c
      -> StoreRep d
      -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m (StoreRep a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep a
a m (StoreRep b
   -> StoreRep c
   -> StoreRep d
   -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep b)
-> m (StoreRep c
      -> StoreRep d -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> b -> m (StoreRep b)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep b
b m (StoreRep c
   -> StoreRep d -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep c)
-> m (StoreRep d
      -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> c -> m (StoreRep c)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep c
c m (StoreRep d -> (StoreRep a, StoreRep b, StoreRep c, StoreRep d))
-> m (StoreRep d)
-> m (StoreRep a, StoreRep b, StoreRep c, StoreRep d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> d -> m (StoreRep d)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep d
d
    readStoreRep :: StoreRep (a, b, c, d) -> m (a, b, c, d)
readStoreRep (la,lb,lc,ld)            = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> m a -> m (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep a
la m (b -> c -> d -> (a, b, c, d))
-> m b -> m (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep b -> m b
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep b
lb m (c -> d -> (a, b, c, d)) -> m c -> m (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep c -> m c
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep c
lc m (d -> (a, b, c, d)) -> m d -> m (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep d -> m d
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep d
ld
    unsafeFreezeStoreRep :: StoreRep (a, b, c, d) -> m (a, b, c, d)
unsafeFreezeStoreRep (la,lb,lc,ld)    = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> m a -> m (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep a
la m (b -> c -> d -> (a, b, c, d))
-> m b -> m (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep b -> m b
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep b
lb m (c -> d -> (a, b, c, d)) -> m c -> m (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep c -> m c
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep c
lc m (d -> (a, b, c, d)) -> m d -> m (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StoreRep d -> m d
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep d
ld
    writeStoreRep :: StoreRep (a, b, c, d) -> (a, b, c, d) -> m ()
writeStoreRep (la,lb,lc,ld) (a
a,b
b,c
c,d
d) = StoreRep a -> a -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep a
la a
a m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoreRep b -> b -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep b
lb b
b m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoreRep c -> c -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep c
lc c
c m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoreRep d -> d -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep d
ld d
d

initStoreRepVec :: forall m vec
    .  ( Storable vec
       , StoreSize vec ~ Data Length
       , Finite vec
       , MonadComp m
       )
    => vec -> m (StoreRep vec)
initStoreRepVec :: vec -> m (StoreRep vec)
initStoreRepVec vec
vec = do
    StoreRep vec
st <- Proxy vec -> StoreSize vec -> m (StoreRep vec)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy vec
forall k (t :: k). Proxy t
Proxy :: Proxy vec) (StoreSize vec -> m (StoreRep vec))
-> StoreSize vec -> m (StoreRep vec)
forall a b. (a -> b) -> a -> b
$ vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec
    StoreRep vec -> vec -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep vec
st vec
vec
    StoreRep vec -> m (StoreRep vec)
forall (m :: * -> *) a. Monad m => a -> m a
return StoreRep vec
st

initStoreRepVec2 :: forall m vec
    .  ( Storable vec
       , StoreSize vec ~ (Data Length, Data Length)
       , Finite2 vec
       , MonadComp m
       )
    => vec -> m (StoreRep vec)
initStoreRepVec2 :: vec -> m (StoreRep vec)
initStoreRepVec2 vec
vec = do
    StoreRep vec
st <- Proxy vec -> StoreSize vec -> m (StoreRep vec)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy vec
forall k (t :: k). Proxy t
Proxy :: Proxy vec) (StoreSize vec -> m (StoreRep vec))
-> StoreSize vec -> m (StoreRep vec)
forall a b. (a -> b) -> a -> b
$ vec -> (Data Length, Data Length)
forall a. Finite2 a => a -> (Data Length, Data Length)
extent2 vec
vec
    StoreRep vec -> vec -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep vec
st vec
vec
    StoreRep vec -> m (StoreRep vec)
forall (m :: * -> *) a. Monad m => a -> m a
return StoreRep vec
st

writeStoreRepVec
    :: ( Manifestable m vec a
       , StoreRep vec ~ (DRef Length, Arr a)
       , Finite vec
       , Syntax a
       , MonadComp m
       )
    => StoreRep vec -> vec -> m ()
writeStoreRepVec :: StoreRep vec -> vec -> m ()
writeStoreRepVec (lr,arr) vec
vec = do
    Ref (Data Length) -> Data Length -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Length)
lr (Data Length -> m ()) -> Data Length -> m ()
forall a b. (a -> b) -> a -> b
$ vec -> Data Length
forall a. Finite a => a -> Data Length
length vec
vec
    Arr a -> vec -> m ()
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
Arr a -> vec -> m ()
manifestStore Arr a
arr vec
vec

writeStoreRepVec2
    :: ( Manifestable2 m vec a
       , StoreRep vec ~ (DRef Length, DRef Length, Arr a)
       , Finite2 vec
       , Syntax a
       , MonadComp m
       )
    => StoreRep vec -> vec -> m ()
writeStoreRepVec2 :: StoreRep vec -> vec -> m ()
writeStoreRepVec2 (rr,cr,arr) vec
vec = do
    Ref (Data Length) -> Data Length -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Length)
rr (Data Length -> m ()) -> Data Length -> m ()
forall a b. (a -> b) -> a -> b
$ vec -> Data Length
forall a. Finite2 a => a -> Data Length
numRows vec
vec
    Ref (Data Length) -> Data Length -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Length)
cr (Data Length -> m ()) -> Data Length -> m ()
forall a b. (a -> b) -> a -> b
$ vec -> Data Length
forall a. Finite2 a => a -> Data Length
numCols vec
vec
    Arr a -> vec -> m ()
forall (m :: * -> *) vec a.
(Manifestable2 m vec a, Syntax a) =>
Arr a -> vec -> m ()
manifestStore2 Arr a
arr vec
vec

instance Syntax a => Storable (Manifest a)
  where
    type StoreRep (Manifest a)  = (DRef Length, Arr a)
    type StoreSize (Manifest a) = Data Length

    newStoreRep :: proxy (Manifest a)
-> StoreSize (Manifest a) -> m (StoreRep (Manifest a))
newStoreRep proxy (Manifest a)
_ StoreSize (Manifest a)
l = (,) (Ref (Data Length) -> Arr a -> (Ref (Data Length), Arr a))
-> m (Ref (Data Length)) -> m (Arr a -> (Ref (Data Length), Arr a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data Length -> m (Ref (Data Length))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Length
StoreSize (Manifest a)
l m (Arr a -> (Ref (Data Length), Arr a))
-> m (Arr a) -> m (Ref (Data Length), Arr a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data Length -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> m (Arr a)
newArr Data Length
StoreSize (Manifest a)
l

    initStoreRep :: Manifest a -> m (StoreRep (Manifest a))
initStoreRep = Manifest a -> m (StoreRep (Manifest a))
forall (m :: * -> *) vec.
(Storable vec, StoreSize vec ~ Data Length, Finite vec,
 MonadComp m) =>
vec -> m (StoreRep vec)
initStoreRepVec

    readStoreRep :: StoreRep (Manifest a) -> m (Manifest a)
readStoreRep (lr,arr) = do
        Data Length
l <- Ref (Data Length) -> m (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef Ref (Data Length)
lr
        Data Length -> Arr a -> m (Manifest a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> Arr a -> m (IArr a)
freezeSlice Data Length
l Arr a
arr

    unsafeFreezeStoreRep :: StoreRep (Manifest a) -> m (Manifest a)
unsafeFreezeStoreRep (lr,arr) = do
        Data Length
l <- Ref (Data Length) -> m (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
lr
        Data Length -> Arr a -> m (Manifest a)
forall (m :: * -> *) a.
MonadComp m =>
Data Length -> Arr a -> m (IArr a)
unsafeFreezeSlice Data Length
l Arr a
arr

    writeStoreRep :: StoreRep (Manifest a) -> Manifest a -> m ()
writeStoreRep = StoreRep (Manifest a) -> Manifest a -> m ()
forall (m :: * -> *) vec a.
(Manifestable m vec a, StoreRep vec ~ (Ref (Data Length), Arr a),
 Finite vec, Syntax a, MonadComp m) =>
StoreRep vec -> vec -> m ()
writeStoreRepVec

instance Syntax a => Storable (Manifest2 a)
  where
    type StoreRep (Manifest2 a)  = (DRef Length, DRef Length, Arr a)
    type StoreSize (Manifest2 a) = (Data Length, Data Length)

    newStoreRep :: proxy (Manifest2 a)
-> StoreSize (Manifest2 a) -> m (StoreRep (Manifest2 a))
newStoreRep proxy (Manifest2 a)
_ (r,c) = (,,) (Ref (Data Length)
 -> Ref (Data Length)
 -> Arr a
 -> (Ref (Data Length), Ref (Data Length), Arr a))
-> m (Ref (Data Length))
-> m (Ref (Data Length)
      -> Arr a -> (Ref (Data Length), Ref (Data Length), Arr a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data Length -> m (Ref (Data Length))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Length
r m (Ref (Data Length)
   -> Arr a -> (Ref (Data Length), Ref (Data Length), Arr a))
-> m (Ref (Data Length))
-> m (Arr a -> (Ref (Data Length), Ref (Data Length), Arr a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data Length -> m (Ref (Data Length))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Length
c m (Arr a -> (Ref (Data Length), Ref (Data Length), Arr a))
-> m (Arr a) -> m (Ref (Data Length), Ref (Data Length), Arr a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Data Length -> m (Arr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> m (Arr a)
newArr (Data Length
rData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c)

    initStoreRep :: Manifest2 a -> m (StoreRep (Manifest2 a))
initStoreRep = Manifest2 a -> m (StoreRep (Manifest2 a))
forall (m :: * -> *) vec.
(Storable vec, StoreSize vec ~ (Data Length, Data Length),
 Finite2 vec, MonadComp m) =>
vec -> m (StoreRep vec)
initStoreRepVec2

    readStoreRep :: StoreRep (Manifest2 a) -> m (Manifest2 a)
readStoreRep (rr,cr,arr) = do
        Data Length
r <- Ref (Data Length) -> m (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef Ref (Data Length)
rr
        Data Length
c <- Ref (Data Length) -> m (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
getRef Ref (Data Length)
cr
        Data Length -> Data Length -> IArr a -> Manifest2 a
forall a. Finite a => Data Length -> Data Length -> a -> Nest a
nest Data Length
r Data Length
c (IArr a -> Manifest2 a) -> m (IArr a) -> m (Manifest2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data Length -> Arr a -> m (IArr a)
forall a (m :: * -> *).
(Type (Internal a), MonadComp m) =>
Data Length -> Arr a -> m (IArr a)
freezeSlice (Data Length
rData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c) Arr a
arr

    unsafeFreezeStoreRep :: StoreRep (Manifest2 a) -> m (Manifest2 a)
unsafeFreezeStoreRep (rr,cr,arr) = do
        Data Length
r <- Ref (Data Length) -> m (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
rr
        Data Length
c <- Ref (Data Length) -> m (Data Length)
forall a (m :: * -> *). (Syntax a, MonadComp m) => Ref a -> m a
unsafeFreezeRef Ref (Data Length)
cr
        Data Length -> Data Length -> IArr a -> Manifest2 a
forall a. Finite a => Data Length -> Data Length -> a -> Nest a
nest Data Length
r Data Length
c (IArr a -> Manifest2 a) -> m (IArr a) -> m (Manifest2 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Data Length -> Arr a -> m (IArr a)
forall (m :: * -> *) a.
MonadComp m =>
Data Length -> Arr a -> m (IArr a)
unsafeFreezeSlice (Data Length
rData Length -> Data Length -> Data Length
forall a. Num a => a -> a -> a
*Data Length
c) Arr a
arr

    writeStoreRep :: StoreRep (Manifest2 a) -> Manifest2 a -> m ()
writeStoreRep = StoreRep (Manifest2 a) -> Manifest2 a -> m ()
forall (m :: * -> *) vec a.
(Manifestable2 m vec a,
 StoreRep vec ~ (Ref (Data Length), Ref (Data Length), Arr a),
 Finite2 vec, Syntax a, MonadComp m) =>
StoreRep vec -> vec -> m ()
writeStoreRepVec2

instance Syntax a => Storable (Pull a)
  where
    type StoreRep (Pull a)  = (DRef Length, Arr a)
    type StoreSize (Pull a) = Data Length

    newStoreRep :: proxy (Pull a) -> StoreSize (Pull a) -> m (StoreRep (Pull a))
newStoreRep proxy (Pull a)
_ = Proxy (Manifest a)
-> StoreSize (Manifest a) -> m (StoreRep (Manifest a))
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy (Manifest a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Manifest a))
    initStoreRep :: Pull a -> m (StoreRep (Pull a))
initStoreRep  = Pull a -> m (StoreRep (Pull a))
forall (m :: * -> *) vec.
(Storable vec, StoreSize vec ~ Data Length, Finite vec,
 MonadComp m) =>
vec -> m (StoreRep vec)
initStoreRepVec

    readStoreRep :: StoreRep (Pull a) -> m (Pull a)
readStoreRep = (Manifest a -> Pull a) -> m (Manifest a) -> m (Pull a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Manifest a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull (Manifest a -> Pull a)
-> (Manifest a -> Manifest a) -> Manifest a -> Pull a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manifest a -> Manifest a
forall a. a -> a
id :: Manifest a -> _)) (m (Manifest a) -> m (Pull a))
-> ((Ref (Data Length), Arr a) -> m (Manifest a))
-> (Ref (Data Length), Arr a)
-> m (Pull a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ref (Data Length), Arr a) -> m (Manifest a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep

    unsafeFreezeStoreRep :: StoreRep (Pull a) -> m (Pull a)
unsafeFreezeStoreRep =
        (Manifest a -> Pull a) -> m (Manifest a) -> m (Pull a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Manifest a -> Pull a
forall vec a. Pully vec a => vec -> Pull a
toPull (Manifest a -> Pull a)
-> (Manifest a -> Manifest a) -> Manifest a -> Pull a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manifest a -> Manifest a
forall a. a -> a
id :: Manifest a -> _)) (m (Manifest a) -> m (Pull a))
-> ((Ref (Data Length), Arr a) -> m (Manifest a))
-> (Ref (Data Length), Arr a)
-> m (Pull a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ref (Data Length), Arr a) -> m (Manifest a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep

    writeStoreRep :: StoreRep (Pull a) -> Pull a -> m ()
writeStoreRep = StoreRep (Pull a) -> Pull a -> m ()
forall (m :: * -> *) vec a.
(Manifestable m vec a, StoreRep vec ~ (Ref (Data Length), Arr a),
 Finite vec, Syntax a, MonadComp m) =>
StoreRep vec -> vec -> m ()
writeStoreRepVec

instance Syntax a => Storable (Push Comp a)
  -- Generalizing this instance to any monad would require making the monad a
  -- parameter of the class (like for Manifestable)
  where
    type StoreRep (Push Comp a)  = (DRef Length, Arr a)
    type StoreSize (Push Comp a) = Data Length

    newStoreRep :: proxy (Push Comp a)
-> StoreSize (Push Comp a) -> m (StoreRep (Push Comp a))
newStoreRep proxy (Push Comp a)
_ = Proxy (Manifest a)
-> StoreSize (Manifest a) -> m (StoreRep (Manifest a))
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy (Manifest a)
forall k (t :: k). Proxy t
Proxy :: Proxy (Manifest a))
    initStoreRep :: Push Comp a -> m (StoreRep (Push Comp a))
initStoreRep  = Push Comp a -> m (StoreRep (Push Comp a))
forall (m :: * -> *) vec.
(Storable vec, StoreSize vec ~ Data Length, Finite vec,
 MonadComp m) =>
vec -> m (StoreRep vec)
initStoreRepVec

    readStoreRep :: StoreRep (Push Comp a) -> m (Push Comp a)
readStoreRep = (Manifest a -> Push Comp a) -> m (Manifest a) -> m (Push Comp a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Manifest a -> Push Comp a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush (Manifest a -> Push Comp a)
-> (Manifest a -> Manifest a) -> Manifest a -> Push Comp a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manifest a -> Manifest a
forall a. a -> a
id :: Manifest a -> _)) (m (Manifest a) -> m (Push Comp a))
-> ((Ref (Data Length), Arr a) -> m (Manifest a))
-> (Ref (Data Length), Arr a)
-> m (Push Comp a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ref (Data Length), Arr a) -> m (Manifest a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep

    unsafeFreezeStoreRep :: StoreRep (Push Comp a) -> m (Push Comp a)
unsafeFreezeStoreRep =
        (Manifest a -> Push Comp a) -> m (Manifest a) -> m (Push Comp a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Manifest a -> Push Comp a
forall (m :: * -> *) vec a. Pushy m vec a => vec -> Push m a
toPush (Manifest a -> Push Comp a)
-> (Manifest a -> Manifest a) -> Manifest a -> Push Comp a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Manifest a -> Manifest a
forall a. a -> a
id :: Manifest a -> _)) (m (Manifest a) -> m (Push Comp a))
-> ((Ref (Data Length), Arr a) -> m (Manifest a))
-> (Ref (Data Length), Arr a)
-> m (Push Comp a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ref (Data Length), Arr a) -> m (Manifest a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep

    writeStoreRep :: StoreRep (Push Comp a) -> Push Comp a -> m ()
writeStoreRep (lr,arr) Push Comp a
vec = Comp () -> m ()
forall (m :: * -> *) a. MonadComp m => Comp a -> m a
liftComp (Comp () -> m ()) -> Comp () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Ref (Data Length) -> Data Length -> Comp ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Length)
lr (Data Length -> Comp ()) -> Data Length -> Comp ()
forall a b. (a -> b) -> a -> b
$ Push Comp a -> Data Length
forall a. Finite a => a -> Data Length
length Push Comp a
vec
        Arr a -> Push Comp a -> Comp ()
forall (m :: * -> *) vec a.
(Manifestable m vec a, Syntax a) =>
Arr a -> vec -> m ()
manifestStore Arr a
arr Push Comp a
vec

instance (Storable a, Syntax a, StoreSize a ~ ()) => Storable (Option a)
  where
    type StoreRep (Option a)  = (DRef Bool, StoreRep a)
    type StoreSize (Option a) = ()
    newStoreRep :: proxy (Option a) -> StoreSize (Option a) -> m (StoreRep (Option a))
newStoreRep proxy (Option a)
_ StoreSize (Option a)
_ = do
        Ref (Data Bool)
valid <- Data Bool -> m (Ref (Data Bool))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Bool
false
        StoreRep a
r     <- Maybe a -> StoreSize a -> m (StoreRep a)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Maybe a
forall a. Maybe a
Nothing :: Maybe a) ()
        (Ref (Data Bool), StoreRep a) -> m (Ref (Data Bool), StoreRep a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref (Data Bool)
valid,StoreRep a
r)
    initStoreRep :: Option a -> m (StoreRep (Option a))
initStoreRep Option a
o = do
        Ref (Data Bool)
valid <- Data Bool -> m (Ref (Data Bool))
forall a (m :: * -> *). (Syntax a, MonadComp m) => a -> m (Ref a)
initRef Data Bool
false
        StoreRep a
r     <- Proxy a -> StoreSize a -> m (StoreRep a)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) ()
        Option a -> (String -> m ()) -> (a -> m ()) -> m ()
forall (m :: * -> *) a.
MonadComp m =>
Option a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionM Option a
o
          (\String
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          (\a
b -> StoreRep (Data Bool, a) -> (Data Bool, a) -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep (Ref (Data Bool)
valid,StoreRep a
r) (Data Bool
true,a
b))
        (Ref (Data Bool), StoreRep a) -> m (Ref (Data Bool), StoreRep a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ref (Data Bool)
valid,StoreRep a
r)
    readStoreRep :: StoreRep (Option a) -> m (Option a)
readStoreRep StoreRep (Option a)
oRep = do
        (Data Bool
valid,a
a) <- StoreRep (Data Bool, a) -> m (Data Bool, a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep StoreRep (Data Bool, a)
StoreRep (Option a)
oRep
        Option a -> m (Option a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Option a -> m (Option a)) -> Option a -> m (Option a)
forall a b. (a -> b) -> a -> b
$ String -> Data Bool -> a -> Option a
forall (m :: * -> *) a.
Monad m =>
String -> Data Bool -> a -> OptionT m a
guarded String
"readStoreRep: none" Data Bool
valid a
a
    unsafeFreezeStoreRep :: StoreRep (Option a) -> m (Option a)
unsafeFreezeStoreRep StoreRep (Option a)
oRep = do
        (Data Bool
valid,a
a) <- StoreRep (Data Bool, a) -> m (Data Bool, a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep StoreRep (Data Bool, a)
StoreRep (Option a)
oRep
        Option a -> m (Option a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Option a -> m (Option a)) -> Option a -> m (Option a)
forall a b. (a -> b) -> a -> b
$ String -> Data Bool -> a -> Option a
forall (m :: * -> *) a.
Monad m =>
String -> Data Bool -> a -> OptionT m a
guarded String
"unsafeFreezeStoreRep: none" Data Bool
valid a
a
    writeStoreRep :: StoreRep (Option a) -> Option a -> m ()
writeStoreRep oRep :: StoreRep (Option a)
oRep@(valid,r) Option a
o = Option a -> (String -> m ()) -> (a -> m ()) -> m ()
forall (m :: * -> *) a.
MonadComp m =>
Option a -> (String -> m ()) -> (a -> m ()) -> m ()
caseOptionM Option a
o
        (\String
_ -> Ref (Data Bool) -> Data Bool -> m ()
forall a (m :: * -> *).
(Syntax a, MonadComp m) =>
Ref a -> a -> m ()
setRef Ref (Data Bool)
valid Data Bool
false)
        (\a
a -> StoreRep (Data Bool, a) -> (Data Bool, a) -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep StoreRep (Data Bool, a)
StoreRep (Option a)
oRep (Data Bool
true,a
a))



----------------------------------------
-- ** User interface
----------------------------------------

-- | Memory for storing values
newtype Store a = Store { Store a -> StoreRep a
unStore :: StoreRep a }
  -- The reason for this type and its associated interface is to improve type
  -- inference over the methods in the `Storable` class. The problem with those
  -- methods is that they involve type families.

-- | Create a fresh 'Store'
newStore :: forall a m . (Storable a, MonadComp m) => StoreSize a -> m (Store a)
newStore :: StoreSize a -> m (Store a)
newStore = (StoreRep a -> Store a) -> m (StoreRep a) -> m (Store a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StoreRep a -> Store a
forall a. StoreRep a -> Store a
Store (m (StoreRep a) -> m (Store a))
-> (StoreSize a -> m (StoreRep a)) -> StoreSize a -> m (Store a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> StoreSize a -> m (StoreRep a)
forall a (m :: * -> *) (proxy :: * -> *).
(Storable a, MonadComp m) =>
proxy a -> StoreSize a -> m (StoreRep a)
newStoreRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)

-- | Store a value to a fresh 'Store'
initStore :: (Storable a, MonadComp m) => a -> m (Store a)
initStore :: a -> m (Store a)
initStore = (StoreRep a -> Store a) -> m (StoreRep a) -> m (Store a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StoreRep a -> Store a
forall a. StoreRep a -> Store a
Store (m (StoreRep a) -> m (Store a))
-> (a -> m (StoreRep a)) -> a -> m (Store a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (StoreRep a)
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
a -> m (StoreRep a)
initStoreRep

-- | Read from a 'Store'
readStore :: (Storable a, MonadComp m) => Store a -> m a
readStore :: Store a -> m a
readStore = StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
readStoreRep (StoreRep a -> m a) -> (Store a -> StoreRep a) -> Store a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store a -> StoreRep a
forall a. Store a -> StoreRep a
unStore

-- | Unsafe freezeing of a 'Store'. This operation is only safe if the 'Store'
-- is not updated as long as the resulting value is alive.
unsafeFreezeStore :: (Storable a, MonadComp m) => Store a -> m a
unsafeFreezeStore :: Store a -> m a
unsafeFreezeStore = StoreRep a -> m a
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> m a
unsafeFreezeStoreRep (StoreRep a -> m a) -> (Store a -> StoreRep a) -> Store a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store a -> StoreRep a
forall a. Store a -> StoreRep a
unStore

-- | Write to a 'Store'
writeStore :: (Storable a, MonadComp m) => Store a -> a -> m ()
writeStore :: Store a -> a -> m ()
writeStore = StoreRep a -> a -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
StoreRep a -> a -> m ()
writeStoreRep (StoreRep a -> a -> m ())
-> (Store a -> StoreRep a) -> Store a -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Store a -> StoreRep a
forall a. Store a -> StoreRep a
unStore

-- | Update a 'Store' in-place
inplace :: (Storable a, MonadComp m) => Store a -> (a -> a) -> m ()
inplace :: Store a -> (a -> a) -> m ()
inplace Store a
store a -> a
f = Store a -> a -> m ()
forall a (m :: * -> *).
(Storable a, MonadComp m) =>
Store a -> a -> m ()
writeStore Store a
store (a -> m ()) -> (a -> a) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Store a -> m a
forall a (m :: * -> *). (Storable a, MonadComp m) => Store a -> m a
unsafeFreezeStore Store a
store