{-# LANGUAGE UnicodeSyntax, LinearTypes, QualifiedDo, NoImplicitPrelude, BlockArguments, ImpredicativeTypes, DefaultSignatures #-}
{-# LANGUAGE UndecidableInstances #-} -- Rep a in the Generically instance
-- | Simple reference counting with linear types inspired by Advanced Topics in
-- Types and Programming Languages Chapter 1
module Data.Linear.Alias
  (
  -- * The heart of aliasing
    Alias
  , Shareable(..)
  , Forgettable(..)
  , get

  -- * Using and modifying aliased resources
  , use
  , useM
  , modify
  , modifyM
  , hoist

  -- * Creating aliases
  , newAlias
  ) where

import GHC.Generics
import Control.Functor.Linear as Linear hiding (get, modify)
import Control.Monad.IO.Class.Linear
import Prelude.Linear hiding (forget)
import qualified Control.Concurrent.Counter as Counter
import qualified Unsafe.Linear as Unsafe
import qualified Data.IntMap as IM
import qualified Data.Bifunctor.Linear as B

import Data.Linear.Alias.Internal
import qualified Data.Linear.Alias.Unsafe as Unsafe.Alias

-- TODO: This is already using atomic-counter, but this is not good enough (it would be cool to use the unlifted one).
-- Check out the TODO file.

----- Signature functions -----

-- | Create an alias for a resource.
newAlias :: MonadIO m
    => (a ⊸ μ ()) -- ^ Function to free resource when the last alias is released
     ⊸ a          -- ^ The resource to alias
     ⊸ m (Alias μ a)
newAlias :: forall (m :: * -> *) a (μ :: * -> *).
MonadIO m =>
(a %1 -> μ ()) %1 -> a %1 -> m (Alias μ a)
newAlias a %1 -> μ ()
freeC a
x = Linear.do
  Ur Counter
c <- IO Counter -> m (Ur Counter)
forall a. IO a -> m (Ur a)
forall (m :: * -> *) a. MonadIO m => IO a -> m (Ur a)
liftSystemIOU (IO Counter -> m (Ur Counter)) -> IO Counter -> m (Ur Counter)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ Int -> IO Counter
Counter.new Int
1
  Alias μ a %1 -> m (Alias μ a)
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure (Alias μ a %1 -> m (Alias μ a)) -> Alias μ a %1 -> m (Alias μ a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (a %1 -> μ ()) -> Counter -> a -> Alias μ a
forall a (m :: * -> *). (a %1 -> m ()) -> Counter -> a -> Alias m a
Alias a %1 -> μ ()
freeC Counter
c a
x


-- | This function returns a value that is aliased in a linear pair with a
-- function to free the linear value. Since both the value and freeing function
-- must be consumed linearly, it is guaranteed that the returned function is
-- the one used to free the resource.
--
-- The cleanup function can be one of two things:
--
-- * If the returned value was the last reference, the function is the one
-- passed as an argument to 'new'
--
-- * Otherwise, if this isn't the last reference to the value, the freeing
-- function will be a no-op, but still must be called on the value.
--
-- Usage:
--
-- @
-- (x, cleanup) <- Alias.get ref
-- x' <- useSomehow x
-- cleanup x'
-- @
get :: MonadIO μ => Alias μ a ⊸ μ (a, a ⊸ μ ())
-- Note on unsafety: If some (sub-)resource is unsafely duplicated from the
-- returned @a@, it's crucial that if @a@ is freed manually, it cannot be
-- passed on to the resource-freeing-function! If you don't mess with unsafety
-- this shouldn't be possible. (This is kind of a moot comment since it must be
-- considered in each case carefully).
get :: forall (μ :: * -> *) a.
MonadIO μ =>
Alias μ a %1 -> μ (a, a %1 -> μ ())
get (Alias a %1 -> μ ()
freeC Counter
counter a
x) = Linear.do
  -- The freeing function, in consuming @x@ linearly, is guaranteed to also
  -- free/forget recursively nested reference-counted resources (guaranteed in
  -- its implementation by linearity @freeC@).
  Ur Int
oldCount <- IO Int -> μ (Ur Int)
forall a. IO a -> μ (Ur a)
forall (m :: * -> *) a. MonadIO m => IO a -> m (Ur a)
liftSystemIOU (Counter -> Int -> IO Int
Counter.sub Counter
counter Int
1)
  if Int
oldCount Int %1 -> Int %1 -> Bool
forall a. Eq a => a %1 -> a %1 -> Bool
== Int
1
     then Linear.do
       -- This is the last reference to the resource, free it.
       (a, a %1 -> μ ()) %1 -> μ (a, a %1 -> μ ())
forall a. a %1 -> μ a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure (a
x, a %1 -> μ ()
freeC)
     else
      -- This is not the last reference, do nothing else.
      (a, a %1 -> μ ()) %1 -> μ (a, a %1 -> μ ())
forall a. a %1 -> μ a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure (a
x, (a -> μ ()) %1 -> a %1 -> μ ()
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear (\a
_ -> () %1 -> μ ()
forall a. a %1 -> μ a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ()))

-- | Like 'modifyM'
modify :: (a ⊸ a) ⊸ Alias μ a ⊸ Alias μ a
modify :: forall a (μ :: * -> *). (a %1 -> a) %1 -> Alias μ a %1 -> Alias μ a
modify a %1 -> a
f (Alias a %1 -> μ ()
freeC Counter
counter a
x) = (a %1 -> μ ()) -> Counter -> a -> Alias μ a
forall a (m :: * -> *). (a %1 -> m ()) -> Counter -> a -> Alias m a
Alias a %1 -> μ ()
freeC Counter
counter (a %1 -> a
f a
x)

-- | Run a monadic function that modifies a reference counted resource.
modifyM :: MonadIO m => (a ⊸ m a) ⊸ Alias μ a ⊸ m (Alias μ a)
modifyM :: forall (m :: * -> *) a (μ :: * -> *).
MonadIO m =>
(a %1 -> m a) %1 -> Alias μ a %1 -> m (Alias μ a)
modifyM a %1 -> m a
f (Alias a %1 -> μ ()
freeC Counter
counter a
x) = (a %1 -> μ ()) -> Counter -> a -> Alias μ a
forall a (m :: * -> *). (a %1 -> m ()) -> Counter -> a -> Alias m a
Alias a %1 -> μ ()
freeC Counter
counter (a %1 -> Alias μ a) %1 -> m a %1 -> m (Alias μ a)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
<$> a %1 -> m a
f a
x

-- | Like 'useM'
use :: Alias μ a ⊸ (a ⊸ (a, b)) ⊸ (Alias μ a, b)
use :: forall (μ :: * -> *) a b.
Alias μ a %1 -> (a %1 -> (a, b)) %1 -> (Alias μ a, b)
use (Alias a %1 -> μ ()
freeC Counter
counter a
x) a %1 -> (a, b)
f = case a %1 -> (a, b)
f a
x of (a
a,b
b) -> ((a %1 -> μ ()) -> Counter -> a -> Alias μ a
forall a (m :: * -> *). (a %1 -> m ()) -> Counter -> a -> Alias m a
Alias a %1 -> μ ()
freeC Counter
counter a
a, b
b)

-- | Use a reference value in an action that uses that value linearly
-- without destroying it.
--
-- The value with the same reference count will be returned together with a
-- byproduct of the linear computation.
useM :: MonadIO m
     => Alias μ a ⊸ (a ⊸ m (a, b)) ⊸ m (Alias μ a, b)
useM :: forall (m :: * -> *) (μ :: * -> *) a b.
MonadIO m =>
Alias μ a %1 -> (a %1 -> m (a, b)) %1 -> m (Alias μ a, b)
useM (Alias a %1 -> μ ()
freeC Counter
counter a
x) a %1 -> m (a, b)
f = a %1 -> m (a, b)
f a
x m (a, b)
%1 -> ((a, b) %1 -> m (Alias μ a, b)) %1 -> m (Alias μ a, b)
forall a b. m a %1 -> (a %1 -> m b) %1 -> m b
forall (m :: * -> *) a b.
Monad m =>
m a %1 -> (a %1 -> m b) %1 -> m b
>>= \(a
a,b
b) -> (Alias μ a, b) %1 -> m (Alias μ a, b)
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ((a %1 -> μ ()) -> Counter -> a -> Alias μ a
forall a (m :: * -> *). (a %1 -> m ()) -> Counter -> a -> Alias m a
Alias a %1 -> μ ()
freeC Counter
counter a
a, b
b)


hoist :: MonadIO m => ((a ⊸ m ()) ⊸ b ⊸ μ ()) ⊸ (a ⊸ b) ⊸ Alias m a ⊸ Alias μ b
hoist :: forall (m :: * -> *) a b (μ :: * -> *).
MonadIO m =>
((a %1 -> m ()) %1 -> b %1 -> μ ())
%1 -> (a %1 -> b) %1 -> Alias m a %1 -> Alias μ b
hoist (a %1 -> m ()) %1 -> b %1 -> μ ()
freeAB a %1 -> b
f (Alias a %1 -> m ()
freeA Counter
counter a
x) = (b %1 -> μ ()) -> Counter -> b -> Alias μ b
forall a (m :: * -> *). (a %1 -> m ()) -> Counter -> a -> Alias m a
Alias ((a %1 -> m ()) %1 -> b %1 -> μ ()
freeAB a %1 -> m ()
freeA) Counter
counter (a %1 -> b
f a
x)


----- Signature classes -----

class Forgettable m a where
  -- | Forget the existence of a linear resource
  forget :: MonadIO m => a ⊸ m ()
  -- romes: I had never thought about it, but it's a bit weird for the method
  -- to have constraints over the @m@, where the instances don't have to
  -- require that instance?

instance Forgettable μ (Alias μ a) where
  -- | Forget the existence of a linearly aliased resource, freeing it if necessary
  forget :: MonadIO μ => Alias μ a ⊸ μ ()
  forget :: MonadIO μ => Alias μ a %1 -> μ ()
forget (Alias a %1 -> μ ()
freeC Counter
counter a
x) = Linear.do
    -- Read comment regarding the freeing function and recursively nested aliases in @'get'@.
    Ur Int
oldCount <- IO Int -> μ (Ur Int)
forall a. IO a -> μ (Ur a)
forall (m :: * -> *) a. MonadIO m => IO a -> m (Ur a)
liftSystemIOU (Counter -> Int -> IO Int
Counter.sub Counter
counter Int
1)
    if Int
oldCount Int %1 -> Int %1 -> Bool
forall a. Eq a => a %1 -> a %1 -> Bool
== Int
1
       then Linear.do
         -- This is the last reference to the resource, free it.
         a %1 -> μ ()
freeC a
x
       else
         -- No-op
         () %1 -> μ ()
forall a. a %1 -> μ a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ((a -> ()) %1 -> a -> ()
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear (\a
_ -> ()) a
x)

class Shareable m a where
  -- | Share a linear resource
  --
  -- Careful! You must make sure that all aliases recursively nested within
  -- this structure @a@ are properly shared/incremented. 
  --
  -- If you fail to implement this correctly, reference counting won't be sound.
  -- Good thing is we can do this automatically! It's much less bug-prone,
  -- especially if you update the definition of a datatype. Your @a@ just needs
  -- to instance 'Generic'.
  share :: MonadIO m => a ⊸ m (a, a)

  default share :: (Generic a, Fields (Rep a)) => MonadIO m => a ⊸ m (a, a)
  share = (a -> m (a, a)) %1 -> a %1 -> m (a, a)
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear ((a -> m (a, a)) %1 -> a %1 -> m (a, a))
-> (a -> m (a, a)) %1 -> a %1 -> m (a, a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \a
x -> Linear.do

    -- We can forget the counted fields after incrementing them all
    [()] %1 -> ()
forall a. Consumable a => a %1 -> ()
consume ([()] %1 -> ()) %1 -> m [()] %1 -> m ()
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
<$>
      (SomeAlias %1 -> m ()) -> [SomeAlias] %1 -> m [()]
forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> [a] %1 -> f [b]
traverse' (\(SomeAlias Alias m b
alias) -> Linear.do
        Alias m b
a' <- Alias m b %1 -> m (Alias m b)
forall (m :: * -> *) (m' :: * -> *) a.
MonadIO m =>
Alias m' a %1 -> m (Alias m' a)
Unsafe.Alias.inc Alias m b
alias -- increment reference count
        (m () -> Alias m b -> m ()) %1 -> m () -> Alias m b -> m ()
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear m () -> Alias m b -> m ()
forall a b (q :: Multiplicity). a %q -> b -> a
const (() %1 -> m ()
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ()) Alias m b
a') (a -> [SomeAlias]
forall a. (Generic a, Fields (Rep a)) => a -> [SomeAlias]
countedFields a
x)

    -- It's safe to return two references to the pointer because we've
    -- incremented the reference count of all nested aliases. Both references must be used
    -- linearly *and* we decrement the reference count with every use except
    -- for the last through @free@, ensuring the resource is freed exactly one.
    (a, a) %1 -> m (a, a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
return (a
x,a
x)

instance Shareable m (Alias μ a) where
  -- | Share a linearly aliased resource, the heart of reference counting aliases.
  share :: MonadIO m => Alias μ a ⊸ m (Alias μ a, Alias μ a)
  share :: MonadIO m => Alias μ a %1 -> m (Alias μ a, Alias μ a)
share Alias μ a
alias'' = Linear.do
    -- Implement manually since there is no Generic instance for Alias
    Alias μ a
alias' <- Alias μ a %1 -> m (Alias μ a)
forall (m :: * -> *) (m' :: * -> *) a.
MonadIO m =>
Alias m' a %1 -> m (Alias m' a)
Unsafe.Alias.inc Alias μ a
alias'' 
    (Alias μ a, Alias μ a) %1 -> m (Alias μ a, Alias μ a)
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ((Alias μ a, Alias μ a) %1 -> m (Alias μ a, Alias μ a))
-> (Alias μ a, Alias μ a) %1 -> m (Alias μ a, Alias μ a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (Alias μ a -> (Alias μ a, Alias μ a))
%1 -> Alias μ a -> (Alias μ a, Alias μ a)
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear (\Alias μ a
alias -> (Alias μ a
alias, Alias μ a
alias)) Alias μ a
alias'

instance (Generic a, Fields (Rep a)) => Shareable m (Generically a) where
  share :: MonadIO m => Generically a %1 -> m (Generically a, Generically a)
share = (Generically a -> m (Generically a, Generically a))
%1 -> Generically a %1 -> m (Generically a, Generically a)
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear ((Generically a -> m (Generically a, Generically a))
 %1 -> Generically a %1 -> m (Generically a, Generically a))
-> (Generically a -> m (Generically a, Generically a))
%1 -> Generically a
%1 -> m (Generically a, Generically a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ \(Generically a
x) -> Linear.do
    -- Same implementation as the default instance of `share`
    [()] %1 -> ()
forall a. Consumable a => a %1 -> ()
consume ([()] %1 -> ()) %1 -> m [()] %1 -> m ()
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
<$>
      (SomeAlias %1 -> m ()) -> [SomeAlias] %1 -> m [()]
forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> [a] %1 -> f [b]
traverse' (\(SomeAlias Alias m b
alias) -> Linear.do
        Alias m b
a' <- Alias m b %1 -> m (Alias m b)
forall (m :: * -> *) (m' :: * -> *) a.
MonadIO m =>
Alias m' a %1 -> m (Alias m' a)
Unsafe.Alias.inc Alias m b
alias -- increment reference count
        (m () -> Alias m b -> m ()) %1 -> m () -> Alias m b -> m ()
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear m () -> Alias m b -> m ()
forall a b (q :: Multiplicity). a %q -> b -> a
const (() %1 -> m ()
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ()) Alias m b
a') (a -> [SomeAlias]
forall a. (Generic a, Fields (Rep a)) => a -> [SomeAlias]
countedFields a
x)
    (Generically a, Generically a)
%1 -> m (Generically a, Generically a)
forall (m :: * -> *) a. Monad m => a %1 -> m a
return (a -> Generically a
forall a. a -> Generically a
Generically a
x, a -> Generically a
forall a. a -> Generically a
Generically a
x)

-- Just like 'share', but doesn't require the action to be performed whithin
-- a MonadIO. Is there a situation where one might want to use 'share'
-- explicitly rather than dup? At least while let bindings are not working for linear types.
--
-- I suppose we also require that this function is bound strictly, as otherwise the value might not be incremented when expected
-- In that sense I suppose it is unsafe? If we call unsafeDup, then forget, but don't force the result of unsafeDup, forget will actually forget the result instead of having been incremented?
-- Have I taken precautions enough to ensure things happen as expected or does unsafePerformIO still not give me that?
--
-- Still seems unwieldly... the side effects are too observable
-- unsafeDup :: Alias x a ⊸ (Alias x a, Alias x a)
-- unsafeDup s = let !(a1,a2) = Unsafe.toLinear unsafePerformIO (share s) in (a1,a2)
-- {-# NOINLINE unsafeDup #-}

----- Other instances -----

-- The Consumable => Forgettable and Dupable => Shareable instances end up being a nuisance, despite being useful to have forgettable instances of things like Ints for free.

-- instance {-# OVERLAPPABLE #-} Consumable a => Forgettable m a where
--   forget a = pure (consume a)
--   {-# INLINE forget #-}
-- instance {-# OVERLAPPABLE #-} Dupable a => Shareable m a where
--   share a = pure (dup2 a)
--   {-# INLINE share #-}

instance (Forgettable m a, Forgettable m b) => Forgettable m (a,b) where
  forget :: MonadIO m => (a, b) %1 -> m ()
forget (a
a,b
b) = a %1 -> m ()
forall (m :: * -> *) a.
(Forgettable m a, MonadIO m) =>
a %1 -> m ()
forget a
a m () %1 -> m () %1 -> m ()
forall a. m () %1 -> m a %1 -> m a
forall (m :: * -> *) a. Monad m => m () %1 -> m a %1 -> m a
>> b %1 -> m ()
forall (m :: * -> *) a.
(Forgettable m a, MonadIO m) =>
a %1 -> m ()
forget b
b
  {-# INLINE forget #-}

instance (Forgettable m a, Forgettable m b, Forgettable m c) => Forgettable m (a,b,c) where
  forget :: MonadIO m => (a, b, c) %1 -> m ()
forget (a
a,b
b,c
c) = a %1 -> m ()
forall (m :: * -> *) a.
(Forgettable m a, MonadIO m) =>
a %1 -> m ()
forget a
a m () %1 -> m () %1 -> m ()
forall a. m () %1 -> m a %1 -> m a
forall (m :: * -> *) a. Monad m => m () %1 -> m a %1 -> m a
>> b %1 -> m ()
forall (m :: * -> *) a.
(Forgettable m a, MonadIO m) =>
a %1 -> m ()
forget b
b m () %1 -> m () %1 -> m ()
forall a. m () %1 -> m a %1 -> m a
forall (m :: * -> *) a. Monad m => m () %1 -> m a %1 -> m a
>> c %1 -> m ()
forall (m :: * -> *) a.
(Forgettable m a, MonadIO m) =>
a %1 -> m ()
forget c
c
  {-# INLINE forget #-}

instance Forgettable m a => Forgettable m (IM.IntMap a) where
  forget :: MonadIO m => IntMap a %1 -> m ()
forget IntMap a
im = [()] %1 -> ()
forall a. Consumable a => a %1 -> ()
consume ([()] %1 -> ()) %1 -> m [()] %1 -> m ()
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
<$> (a %1 -> m ()) -> [a] %1 -> m [()]
forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> [a] %1 -> f [b]
traverse' a %1 -> m ()
forall (m :: * -> *) a.
(Forgettable m a, MonadIO m) =>
a %1 -> m ()
forget (IntMap a -> [a]
forall a. IntMap a -> [a]
IM.elems IntMap a
im)
  {-# INLINE forget #-}

instance Forgettable m a => Forgettable m [a] where
  forget :: MonadIO m => [a] %1 -> m ()
forget [a]
l = [()] %1 -> ()
forall a. Consumable a => a %1 -> ()
consume ([()] %1 -> ()) %1 -> m [()] %1 -> m ()
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
<$> (a %1 -> m ()) -> [a] %1 -> m [()]
forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> [a] %1 -> f [b]
traverse' a %1 -> m ()
forall (m :: * -> *) a.
(Forgettable m a, MonadIO m) =>
a %1 -> m ()
forget [a]
l
  {-# INLINE forget #-}

instance (Shareable m a, Shareable m b) => Shareable m (a,b) where
  share :: MonadIO m => (a, b) %1 -> m ((a, b), (a, b))
share (a
a0,b
b0) = Linear.do
    (a
a1,a
a2) <- a %1 -> m (a, a)
forall (m :: * -> *) a.
(Shareable m a, MonadIO m) =>
a %1 -> m (a, a)
share a
a0
    (b
b1,b
b2) <- b %1 -> m (b, b)
forall (m :: * -> *) a.
(Shareable m a, MonadIO m) =>
a %1 -> m (a, a)
share b
b0
    ((a, b), (a, b)) %1 -> m ((a, b), (a, b))
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ((a
a1,b
b1),(a
a2,b
b2))
  {-# INLINE share #-}

instance Shareable m a => Shareable m (IM.IntMap a) where
  share :: MonadIO m => IntMap a %1 -> m (IntMap a, IntMap a)
share IntMap a
im = ([(Int, a)] %1 -> IntMap a)
-> ([(Int, a)] %1 -> IntMap a)
-> ([(Int, a)], [(Int, a)])
%1 -> (IntMap a, IntMap a)
forall a b c d. (a %1 -> b) -> (c %1 -> d) -> (a, c) %1 -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a %1 -> b) -> (c %1 -> d) -> p a c %1 -> p b d
B.bimap (([(Int, a)] -> IntMap a) %1 -> [(Int, a)] %1 -> IntMap a
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IM.fromList) (([(Int, a)] -> IntMap a) %1 -> [(Int, a)] %1 -> IntMap a
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
IM.fromList) (([(Int, a)], [(Int, a)]) %1 -> (IntMap a, IntMap a))
-> ([((Int, a), (Int, a))] %1 -> ([(Int, a)], [(Int, a)]))
-> [((Int, a), (Int, a))]
%1 -> (IntMap a, IntMap a)
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. [((Int, a), (Int, a))] %1 -> ([(Int, a)], [(Int, a)])
forall a b. [(a, b)] %1 -> ([a], [b])
unzip ([((Int, a), (Int, a))] %1 -> (IntMap a, IntMap a))
%1 -> m [((Int, a), (Int, a))] %1 -> m (IntMap a, IntMap a)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
<$>
             ((Int, a) %1 -> m ((Int, a), (Int, a)))
-> [(Int, a)] %1 -> m [((Int, a), (Int, a))]
forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> [a] %1 -> f [b]
traverse' (Int, a) %1 -> m ((Int, a), (Int, a))
forall (m :: * -> *) a.
(Shareable m a, MonadIO m) =>
a %1 -> m (a, a)
share (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
IM.toList IntMap a
im)
  {-# INLINE share #-}

instance Shareable m a => Shareable m [a] where
  share :: MonadIO m => [a] %1 -> m ([a], [a])
share [a]
l = [(a, a)] %1 -> ([a], [a])
forall a b. [(a, b)] %1 -> ([a], [b])
unzip ([(a, a)] %1 -> ([a], [a])) %1 -> m [(a, a)] %1 -> m ([a], [a])
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
<$> (a %1 -> m (a, a)) -> [a] %1 -> m [(a, a)]
forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> [a] %1 -> f [b]
traverse' a %1 -> m (a, a)
forall (m :: * -> *) a.
(Shareable m a, MonadIO m) =>
a %1 -> m (a, a)
share [a]
l
  {-# INLINE share #-}

instance Forgettable m Int where
  forget :: MonadIO m => Int %1 -> m ()
forget = () %1 -> m ()
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure (() %1 -> m ()) -> (Int %1 -> ()) -> Int %1 -> m ()
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. Int %1 -> ()
forall a. Consumable a => a %1 -> ()
consume
instance Shareable m Int where
  share :: MonadIO m => Int %1 -> m (Int, Int)
share = (Int, Int) %1 -> m (Int, Int)
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ((Int, Int) %1 -> m (Int, Int))
-> (Int %1 -> (Int, Int)) -> Int %1 -> m (Int, Int)
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. Int %1 -> (Int, Int)
forall a. Dupable a => a %1 -> (a, a)
dup2