{-# LANGUAGE UnicodeSyntax, LinearTypes, QualifiedDo, NoImplicitPrelude, BlockArguments, ImpredicativeTypes, DefaultSignatures #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Linear.Alias
(
Alias
, Shareable(..)
, Forgettable(..)
, get
, use
, useM
, modify
, modifyM
, hoist
, 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
newAlias :: MonadIO m
=> (a ⊸ μ ())
⊸ a
⊸ 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 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
pure $ Alias freeC c x
get :: MonadIO μ => Alias μ a ⊸ μ (a, a ⊸ μ ())
get :: forall (μ :: * -> *) a.
MonadIO μ =>
Alias μ a %1 -> μ (a, a %1 -> μ ())
get (Alias a %1 -> μ ()
freeC Counter
counter a
x) = Linear.do
Ur 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 oldCount == 1
then Linear.do
pure (x, freeC)
else
pure (x, Unsafe.toLinear (\a
_ -> () %1 -> μ ()
forall a. a %1 -> μ a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
pure ()))
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)
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
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)
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)
class Forgettable m a where
forget :: MonadIO m => a ⊸ m ()
instance Forgettable μ (Alias μ a) where
forget :: MonadIO μ => Alias μ a ⊸ μ ()
forget :: MonadIO μ => Alias μ a %1 -> μ ()
forget (Alias a %1 -> μ ()
freeC Counter
counter a
x) = Linear.do
Ur 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 oldCount == 1
then Linear.do
freeC x
else
pure (Unsafe.toLinear (\a
_ -> ()) x)
class Shareable m a where
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
[()] %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
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
Unsafe.toLinear const (pure ()) a') (a -> [SomeAlias]
forall a. (Generic a, Fields (Rep a)) => a -> [SomeAlias]
countedFields a
x)
(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 :: 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
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''
pure $ Unsafe.toLinear (\Alias μ a
alias -> (Alias μ a
alias, Alias μ a
alias)) 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
[()] %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
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
Unsafe.toLinear const (pure ()) 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)
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
(a1,a2) <- a %1 -> m (a, a)
forall (m :: * -> *) a.
(Shareable m a, MonadIO m) =>
a %1 -> m (a, a)
share a
a0
(b1,b2) <- share b0
pure ((a1,b1),(a2,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