{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE QualifiedDo #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

module Control.Concurrent.DivideConquer.Linear (
  divideAndConquer,
  DivideConquer (..),

  -- * Examples
  qsortDC,
) where

import Control.Applicative qualified as NonLinear
import Control.Concurrent (ThreadId, forkIO, killThread)
import Control.Concurrent.DivideConquer.Utils.OnceChan.Linear (Sink, Source)
import Control.Concurrent.DivideConquer.Utils.OnceChan.Linear qualified as Once
import Control.Concurrent.DivideConquer.Utils.QueuePool (QueuePool, newQueuePool, popWork, pushWork, pushWorkMaster)
import Control.Functor.Linear qualified as Control
import Control.Monad.Borrow.Pure.Affine (Affine, GenericallyAffine (..))
import Control.Monad.Borrow.Pure.BO
import Control.Monad.Borrow.Pure.BO.Unsafe
import Control.Monad.Borrow.Pure.Copyable
import Data.Functor.Linear qualified as Data
import Data.Kind (Type)
import Data.List.Linear qualified as LL
import Data.List.NonEmpty.Linear (NonEmpty (..))
import Data.List.NonEmpty.Linear qualified as NEL
import Data.Proxy (Proxy (..))
import Data.V.Linear (V)
import Data.V.Linear.Internal (V (..))
import Data.Vector qualified as V
import Data.Vector.Mutable.Linear.Borrow qualified as LV
import GHC.Exts qualified as GHC
import GHC.Generics qualified as GHC
import GHC.TypeNats (SomeNat (..), someNatVal)
import Generics.Linear.TH (deriveGenericAnd1)
import Prelude.Linear
import Prelude.Linear.Generically (Generically, Generically1)
import System.IO.Unsafe (unsafePerformIO)
import Unsafe.Linear qualified as Unsafe

data DivideConquer α t a = DivideConquer
  { forall (α :: Lifetime) (t :: * -> *) a.
DivideConquer α t a
-> forall (β :: Lifetime).
   (α >= β) =>
   Mut β a %1 -> BO β (Result β t a)
divide :: forall β. (α >= β) => Mut β a %1 -> BO β (Result β t a)
  }

data Result β t a = Done | Continue (t (Mut β a))

data Work α a (t :: Type -> Type) where
  Process :: Mut α a %1 -> Sink () %1 -> Work α a t %1 -> Work α a t
  Unite :: t (Source ()) %1 -> Sink () %1 -> Work α a t
  Final :: Work α a t

newtype Thread = Thread ThreadId

instance Consumable Thread where
  {-# NOINLINE consume #-}
  consume :: Thread %1 -> ()
consume = (Thread %1 -> ()) -> Thread %1 -> ()
forall a. a -> a
GHC.noinline ((Thread %1 -> ()) -> Thread %1 -> ())
-> (Thread %1 -> ()) -> Thread %1 -> ()
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (Thread -> ()) %1 -> Thread %1 -> ()
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear \(Thread ThreadId
tid) -> IO () -> ()
forall a. IO a -> a
unsafePerformIO (IO () -> ()) -> IO () -> ()
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ do
    ThreadId -> IO ()
killThread ThreadId
tid

newtype DList a = DList ([a] %1 -> [a])

instance Semigroup (DList a) where
  DList [a] %1 -> [a]
f <> :: DList a %1 -> DList a %1 -> DList a
<> DList [a] %1 -> [a]
g = ([a] %1 -> [a]) -> DList a
forall a. ([a] %1 -> [a]) -> DList a
DList ([a] %1 -> [a]
f ([a] %1 -> [a]) %1 -> ([a] %1 -> [a]) %1 -> [a] %1 -> [a]
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. [a] %1 -> [a]
g)
  {-# INLINE (<>) #-}

instance Monoid (DList a) where
  mempty :: DList a
mempty = ([a] %1 -> [a]) -> DList a
forall a. ([a] %1 -> [a]) -> DList a
DList [a] %1 -> [a]
forall a (q :: Multiplicity). a %q -> a
id
  {-# INLINE mempty #-}

singletonD :: a %1 -> DList a
singletonD :: forall a. a %1 -> DList a
singletonD = ([a] %1 -> [a]) -> DList a
forall a. ([a] %1 -> [a]) -> DList a
DList (([a] %1 -> [a]) %1 -> DList a)
-> (a %1 -> [a] %1 -> [a]) -> a %1 -> DList a
forall b c a (q :: Multiplicity) (m :: Multiplicity)
       (n :: Multiplicity).
(b %1 -> c) %q -> (a %1 -> b) %m -> a %n -> c
. (:)
{-# INLINE singletonD #-}

toListD :: DList a %1 -> [a]
toListD :: forall a. DList a %1 -> [a]
toListD (DList [a] %1 -> [a]
f) = [a] %1 -> [a]
f []
{-# INLINE toListD #-}

-- TODO: perhaps we can use atomic counter here again?

data QState α a t
  = Idle !(Mut α (QueuePool (Work α a t)))
  | DoThen !(Work α a t) !(Mut α (QueuePool (Work α a t)))

popQState ::
  QState α a t %1 ->
  BO α (Maybe (Work α a t, QState α a t))
popQState :: forall (α :: Lifetime) a (t :: * -> *).
QState α a t %1 -> BO α (Maybe (Work α a t, QState α a t))
popQState = \case
  Idle Mut α (QueuePool (Work α a t))
q -> Control.do
    m <- Mut α (QueuePool (Work α a t))
%1 -> BO α (Maybe (Work α a t, Mut α (QueuePool (Work α a t))))
forall (α :: Lifetime) a.
Mut α (QueuePool a) %1 -> BO α (Maybe (a, Mut α (QueuePool a)))
popWork Mut α (QueuePool (Work α a t))
q
    case m of
      Maybe (Work α a t, Mut α (QueuePool (Work α a t)))
Nothing -> Maybe (Work α a t, QState α a t)
%1 -> BO α (Maybe (Work α a t, QState α a t))
forall a. a %1 -> BO α a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure Maybe (Work α a t, QState α a t)
forall a. Maybe a
Nothing
      Just (Work α a t
work, Mut α (QueuePool (Work α a t))
q) -> Maybe (Work α a t, QState α a t)
%1 -> BO α (Maybe (Work α a t, QState α a t))
forall a. a %1 -> BO α a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure ((Work α a t, QState α a t) -> Maybe (Work α a t, QState α a t)
forall a. a -> Maybe a
Just (Work α a t
work, Mut α (QueuePool (Work α a t)) -> QState α a t
forall (α :: Lifetime) a (t :: * -> *).
Mut α (QueuePool (Work α a t)) -> QState α a t
Idle Mut α (QueuePool (Work α a t))
q))
  DoThen Work α a t
work Mut α (QueuePool (Work α a t))
q -> Maybe (Work α a t, QState α a t)
%1 -> BO α (Maybe (Work α a t, QState α a t))
forall a. a %1 -> BO α a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure (Maybe (Work α a t, QState α a t)
 %1 -> BO α (Maybe (Work α a t, QState α a t)))
-> Maybe (Work α a t, QState α a t)
%1 -> BO α (Maybe (Work α a t, QState α a t))
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (Work α a t, QState α a t) -> Maybe (Work α a t, QState α a t)
forall a. a -> Maybe a
Just (Work α a t
work, Mut α (QueuePool (Work α a t)) -> QState α a t
forall (α :: Lifetime) a (t :: * -> *).
Mut α (QueuePool (Work α a t)) -> QState α a t
Idle Mut α (QueuePool (Work α a t))
q)

enqueue :: QState α a t %1 -> Work α a t %1 -> BO α (QState α a t)
enqueue :: forall (α :: Lifetime) a (t :: * -> *).
QState α a t %1 -> Work α a t %1 -> BO α (QState α a t)
enqueue QState α a t
q Work α a t
work = case QState α a t
q of
  Idle Mut α (QueuePool (Work α a t))
q -> Mut α (QueuePool (Work α a t)) -> QState α a t
forall (α :: Lifetime) a (t :: * -> *).
Mut α (QueuePool (Work α a t)) -> QState α a t
Idle (Mut α (QueuePool (Work α a t)) %1 -> QState α a t)
%1 -> BO α (Mut α (QueuePool (Work α a t)))
%1 -> BO α (QState α a t)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.<$> Mut α (QueuePool (Work α a t))
%1 -> Work α a t %1 -> BO α (Mut α (QueuePool (Work α a t)))
forall (α :: Lifetime) a.
Mut α (QueuePool a) %1 -> a %1 -> BO α (Mut α (QueuePool a))
pushWork Mut α (QueuePool (Work α a t))
q Work α a t
work
  DoThen Work α a t
work' Mut α (QueuePool (Work α a t))
q -> [Char]
-> Work α a t
%1 -> Mut α (QueuePool (Work α a t))
%1 -> Work α a t
%1 -> BO α (QState α a t)
forall a. HasCallStack => [Char] -> a
error [Char]
"Could not happen!" Work α a t
work Mut α (QueuePool (Work α a t))
q Work α a t
work'

doAndEnqueue :: QState α a t %1 -> Work α a t %1 -> Work α a t %1 -> BO α (QState α a t)
doAndEnqueue :: forall (α :: Lifetime) a (t :: * -> *).
QState α a t
%1 -> Work α a t %1 -> Work α a t %1 -> BO α (QState α a t)
doAndEnqueue QState α a t
q Work α a t
work Work α a t
cont = case QState α a t
q of
  Idle Mut α (QueuePool (Work α a t))
q -> Work α a t -> Mut α (QueuePool (Work α a t)) -> QState α a t
forall (α :: Lifetime) a (t :: * -> *).
Work α a t -> Mut α (QueuePool (Work α a t)) -> QState α a t
DoThen Work α a t
work (Mut α (QueuePool (Work α a t)) %1 -> QState α a t)
%1 -> BO α (Mut α (QueuePool (Work α a t)))
%1 -> BO α (QState α a t)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.<$> Mut α (QueuePool (Work α a t))
%1 -> Work α a t %1 -> BO α (Mut α (QueuePool (Work α a t)))
forall (α :: Lifetime) a.
Mut α (QueuePool a) %1 -> a %1 -> BO α (Mut α (QueuePool a))
pushWork Mut α (QueuePool (Work α a t))
q Work α a t
cont
  DoThen Work α a t
work' Mut α (QueuePool (Work α a t))
q -> [Char]
-> Work α a t
%1 -> Work α a t
%1 -> Work α a t
%1 -> Mut α (QueuePool (Work α a t))
%1 -> BO α (QState α a t)
forall a. HasCallStack => [Char] -> a
error [Char]
"Could not happen!" Work α a t
work Work α a t
cont Work α a t
work' Mut α (QueuePool (Work α a t))
q

divideAndConquer ::
  forall α β t a.
  (Data.Traversable t, Consumable (t ()), α >= β) =>
  -- | The # of workers.
  Int ->
  DivideConquer α t a ->
  Mut α a %1 ->
  BO β (Mut α a)
divideAndConquer :: forall (α :: Lifetime) (β :: Lifetime) (t :: * -> *) a.
(Traversable t, Consumable (t ()), α >= β) =>
Int -> DivideConquer α t a -> Mut α a %1 -> BO β (Mut α a)
divideAndConquer Int
n DivideConquer {forall (β :: Lifetime).
(α >= β) =>
Mut β a %1 -> BO β (Result β t a)
divide :: forall (α :: Lifetime) (t :: * -> *) a.
DivideConquer α t a
-> forall (β :: Lifetime).
   (α >= β) =>
   Mut β a %1 -> BO β (Result β t a)
divide :: forall (β :: Lifetime).
(α >= β) =>
Mut β a %1 -> BO β (Result β t a)
..} Mut α a
ini
  | Int
n Int %1 -> Int %1 -> Bool
forall a. Eq a => a %1 -> a %1 -> Bool
== Int
0 = [Char] -> Mut α a %1 -> BO β (Mut α a)
forall a. HasCallStack => [Char] -> a
error ([Char]
"divideAndConquer: # of workers must be positive, but got: " [Char] %1 -> [Char] %1 -> [Char]
forall a. Semigroup a => a %1 -> a %1 -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n) Mut α a
ini
  | Bool
otherwise =
      BO α (Mut α a) %1 -> BO β (Mut α a)
forall a b. (a <: b) => a %1 -> b
upcast (BO α (Mut α a) %1 -> BO β (Mut α a))
-> BO α (Mut α a) %1 -> BO β (Mut α a)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$
        (() %1 -> Mut α a %1 -> Mut α a) -> ((), Mut α a) %1 -> Mut α a
forall a (p :: Multiplicity) b c (q :: Multiplicity).
(a %p -> b %p -> c) %q -> (a, b) %p -> c
uncurry (forall a b. Consumable a => a %1 -> b %1 -> b
lseq @()) (((), Mut α a) %1 -> Mut α a)
%1 -> BO α ((), Mut α a) %1 -> BO α (Mut α a)
forall (f :: * -> *) a b.
Functor f =>
(a %1 -> b) %1 -> f a %1 -> f b
Control.<$> Mut α a
%1 -> (forall (β :: Lifetime).
       Mut (β /\ α) a %1 -> BO (β /\ α) (After β ()))
%1 -> BO α ((), Mut α a)
forall (α :: Lifetime) a (α' :: Lifetime) r.
Mut α a
%1 -> (forall (β :: Lifetime).
       Mut (β /\ α) a %1 -> BO (β /\ α') (After β r))
%1 -> BO α' (r, Mut α a)
reborrowing' Mut α a
ini \(Mut (β /\ α) a
ini :: Mut γ a) ->
          Natural -> SomeNat
someNatVal (Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) SomeNat
-> (SomeNat -> BO (β /\ α) (After β ()))
%1 -> BO (β /\ α) (After β ())
forall a b (p :: Multiplicity) (q :: Multiplicity).
a %p -> (a %p -> b) %q -> b
& \(SomeNat (Proxy n
_ :: Proxy n)) -> Control.do
            (workers, master) <- forall (n :: Natural) a (α :: Lifetime).
KnownNat n =>
BO α (V n (Mut α (QueuePool a)), MasterQueuePool a)
newQueuePool @n
            (masterQ, masterLend) <- asksLinearly $ borrow master
            (rootSink, rootSource) <- asksLinearly Once.new

            Control.void $ pushWorkMaster masterQ $ Process ini rootSink Final

            concurrentMap_ worker workers
            Once.take rootSource

            Control.pure (upcast $ consume Control.<$> reclaim' masterLend)
  where
    worker :: (α >= α') => Mut α' (QueuePool (Work α' a t)) %1 -> BO α' ()
    worker :: forall (α' :: Lifetime).
(α >= α') =>
Mut α' (QueuePool (Work α' a t)) %1 -> BO α' ()
worker Mut α' (QueuePool (Work α' a t))
q =
      QState α' a t
%1 -> (QState α' a t
       %1 -> BO α' (Maybe (Work α' a t, QState α' a t)))
-> (QState α' a t %1 -> Work α' a t %1 -> BO α' (QState α' a t))
-> BO α' ()
forall (m :: * -> *) r a.
Monad m =>
r %1 -> (r %1 -> m (Maybe (a, r))) -> (r %1 -> a %1 -> m r) -> m ()
whileJust_ (Mut α' (QueuePool (Work α' a t)) -> QState α' a t
forall (α :: Lifetime) a (t :: * -> *).
Mut α (QueuePool (Work α a t)) -> QState α a t
Idle Mut α' (QueuePool (Work α' a t))
q) QState α' a t %1 -> BO α' (Maybe (Work α' a t, QState α' a t))
forall (α :: Lifetime) a (t :: * -> *).
QState α a t %1 -> BO α (Maybe (Work α a t, QState α a t))
popQState \QState α' a t
q -> \case
        Work α' a t
Final -> QState α' a t %1 -> BO α' (QState α' a t)
forall a. a %1 -> BO α' a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure QState α' a t
q
        Process Mut α' a
ini Sink ()
sink Work α' a t
next -> Control.do
          q <- QState α' a t %1 -> Work α' a t %1 -> BO α' (QState α' a t)
forall (α :: Lifetime) a (t :: * -> *).
QState α a t %1 -> Work α a t %1 -> BO α (QState α a t)
enqueue QState α' a t
q Work α' a t
next
          resl <- divide ini
          case resl of
            Result α' t a
Done -> Control.do
              Sink () %1 -> () %1 -> BO α' ()
forall a (α :: Lifetime). Sink a %1 -> a %1 -> BO α ()
Once.put Sink ()
sink ()
              QState α' a t %1 -> BO α' (QState α' a t)
forall a. a %1 -> BO α' a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure QState α' a t
q
            Continue t (Mut α' a)
ts -> Control.do
              (sources, ks) <-
                (StateT (DList (Mut α' a, Sink ())) (BO α') (t (Source ()))
 %1 -> DList (Mut α' a, Sink ())
 %1 -> BO α' (t (Source ()), DList (Mut α' a, Sink ())))
-> DList (Mut α' a, Sink ())
%1 -> StateT (DList (Mut α' a, Sink ())) (BO α') (t (Source ()))
%1 -> BO α' (t (Source ()), DList (Mut α' a, Sink ()))
forall a (p :: Multiplicity) b (q :: Multiplicity) c
       (r :: Multiplicity).
(a %p -> b %q -> c) %r -> b %q -> a %p -> c
flip StateT (DList (Mut α' a, Sink ())) (BO α') (t (Source ()))
%1 -> DList (Mut α' a, Sink ())
%1 -> BO α' (t (Source ()), DList (Mut α' a, Sink ()))
forall s (m :: * -> *) a. StateT s m a %1 -> s %1 -> m (a, s)
Control.runStateT DList (Mut α' a, Sink ())
forall a. Monoid a => a
mempty (StateT (DList (Mut α' a, Sink ())) (BO α') (t (Source ()))
 %1 -> BO α' (t (Source ()), DList (Mut α' a, Sink ())))
-> StateT (DList (Mut α' a, Sink ())) (BO α') (t (Source ()))
%1 -> BO α' (t (Source ()), DList (Mut α' a, Sink ()))
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ t (Mut α' a)
%1 -> (Mut α' a
       %1 -> StateT (DList (Mut α' a, Sink ())) (BO α') (Source ()))
-> StateT (DList (Mut α' a, Sink ())) (BO α') (t (Source ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a %1 -> (a %1 -> f b) -> f (t b)
Data.for t (Mut α' a)
ts \Mut α' a
work -> Control.do
                  (sink, source) <- BO α' (Sink (), Source ())
%1 -> StateT
        (DList (Mut α' a, Sink ())) (BO α') (Sink (), Source ())
forall (m :: * -> *) a.
Monad m =>
m a %1 -> StateT (DList (Mut α' a, Sink ())) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a %1 -> t m a
Control.lift (BO α' (Sink (), Source ())
 %1 -> StateT
         (DList (Mut α' a, Sink ())) (BO α') (Sink (), Source ()))
-> BO α' (Sink (), Source ())
%1 -> StateT
        (DList (Mut α' a, Sink ())) (BO α') (Sink (), Source ())
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (Linearly %1 -> (Sink (), Source ()))
%1 -> BO α' (Sink (), Source ())
forall r (α :: Lifetime). (Linearly %1 -> r) %1 -> BO α r
asksLinearly Linearly %1 -> (Sink (), Source ())
forall a. Linearly %1 -> (Sink a, Source a)
Once.new
                  Control.modify (<> singletonD (work, sink))
                  Control.pure source
              let %1 !cont = Unite sources sink
              case NEL.nonEmpty $ toListD ks of
                Maybe (NonEmpty (Mut α' a, Sink ()))
Nothing -> QState α' a t %1 -> Work α' a t %1 -> BO α' (QState α' a t)
forall (α :: Lifetime) a (t :: * -> *).
QState α a t %1 -> Work α a t %1 -> BO α (QState α a t)
enqueue QState α' a t
q Work α' a t
cont
                Just ((Mut α' a
ini, Sink ()
sink) :| [(Mut α' a, Sink ())]
ks) ->
                  QState α' a t
%1 -> Work α' a t %1 -> Work α' a t %1 -> BO α' (QState α' a t)
forall (α :: Lifetime) a (t :: * -> *).
QState α a t
%1 -> Work α a t %1 -> Work α a t %1 -> BO α (QState α a t)
doAndEnqueue
                    QState α' a t
q
                    (Mut α' a -> Sink () -> Work α' a t -> Work α' a t
forall (α :: Lifetime) a (t :: * -> *).
Mut α a -> Sink () -> Work α a t -> Work α a t
Process Mut α' a
ini Sink ()
sink Work α' a t
forall (α :: Lifetime) a (t :: * -> *). Work α a t
Final)
                    (Work α' a t %1 -> BO α' (QState α' a t))
%1 -> Work α' a t %1 -> BO α' (QState α' a t)
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ ((Mut α' a, Sink ()) %1 -> Work α' a t %1 -> Work α' a t)
-> Work α' a t %1 -> [(Mut α' a, Sink ())] %1 -> Work α' a t
forall a b. (a %1 -> b %1 -> b) -> b %1 -> [a] %1 -> b
LL.foldr ((Mut α' a %1 -> Sink () %1 -> Work α' a t %1 -> Work α' a t)
-> (Mut α' a, Sink ()) %1 -> Work α' a t %1 -> Work α' a t
forall a (p :: Multiplicity) b c (q :: Multiplicity).
(a %p -> b %p -> c) %q -> (a, b) %p -> c
uncurry Mut α' a -> Sink () -> Work α' a t -> Work α' a t
forall (α :: Lifetime) a (t :: * -> *).
Mut α a -> Sink () -> Work α a t -> Work α a t
Process) Work α' a t
cont [(Mut α' a, Sink ())]
ks
        Unite t (Source ())
children Sink ()
sink -> Control.do
          BO α' (t ()) %1 -> BO α' ()
forall (f :: * -> *) a. (Functor f, Consumable a) => f a %1 -> f ()
Control.void (BO α' (t ()) %1 -> BO α' ()) -> BO α' (t ()) %1 -> BO α' ()
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ (Source () %1 -> BO α' ()) -> t (Source ()) %1 -> BO α' (t ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a %1 -> f b) -> t a %1 -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> t a %1 -> f (t b)
Data.traverse Source () %1 -> BO α' ()
forall a (α :: Lifetime). Source a %1 -> BO α a
Once.take t (Source ())
children
          Sink () %1 -> () %1 -> BO α' ()
forall a (α :: Lifetime). Sink a %1 -> a %1 -> BO α ()
Once.put Sink ()
sink ()
          QState α' a t %1 -> BO α' (QState α' a t)
forall a. a %1 -> BO α' a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure QState α' a t
q

concurrentMap_ ::
  forall n a α.
  (a %1 -> BO α ()) ->
  V n a %1 ->
  BO α ()
concurrentMap_ :: forall (n :: Natural) a (α :: Lifetime).
(a %1 -> BO α ()) -> V n a %1 -> BO α ()
concurrentMap_ a %1 -> BO α ()
k = (V n a -> BO α ()) %1 -> V n a %1 -> BO α ()
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear \(V Vector a
ts) -> IO () %1 -> BO α ()
forall a (α :: Lifetime). IO a %1 -> BO α a
unsafeSystemIOToBO do
  (a -> IO Thread) -> Vector a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> Vector a -> m ()
V.mapM_
    (\a
a -> BO α Thread %1 -> IO Thread
forall (α :: Lifetime) a. BO α a %1 -> IO a
unsafeBOToSystemIO (BO α Thread %1 -> IO Thread) -> BO α Thread %1 -> IO Thread
forall a b (p :: Multiplicity) (q :: Multiplicity).
(a %p -> b) %q -> a %p -> b
$ BO α () %1 -> BO α Thread
forall (α :: Lifetime). BO α () %1 -> BO α Thread
forkBO (a %1 -> BO α ()
k a
a))
    Vector a
ts

forkBO :: BO α () %1 -> BO α Thread
forkBO :: forall (α :: Lifetime). BO α () %1 -> BO α Thread
forkBO = (BO α () -> BO α Thread) %1 -> BO α () %1 -> BO α Thread
forall a b (p :: Multiplicity) (x :: Multiplicity).
(a %p -> b) %1 -> a %x -> b
Unsafe.toLinear \BO α ()
bo ->
  IO Thread %1 -> BO α Thread
forall a (α :: Lifetime). IO a %1 -> BO α a
unsafeSystemIOToBO (ThreadId -> Thread
Thread (ThreadId -> Thread) -> IO ThreadId -> IO Thread
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
NonLinear.<$> IO () -> IO ThreadId
forkIO (BO α () %1 -> IO ()
forall (α :: Lifetime) a. BO α a %1 -> IO a
unsafeBOToSystemIO BO α ()
bo))

whileJust_ ::
  (Control.Monad m) =>
  r %1 ->
  (r %1 -> m (Maybe (a, r))) ->
  (r %1 -> a %1 -> m r) ->
  m ()
whileJust_ :: forall (m :: * -> *) r a.
Monad m =>
r %1 -> (r %1 -> m (Maybe (a, r))) -> (r %1 -> a %1 -> m r) -> m ()
whileJust_ r
ini r %1 -> m (Maybe (a, r))
next r %1 -> a %1 -> m r
action = r %1 -> m ()
loop r
ini
  where
    loop :: r %1 -> m ()
loop r
cur = Control.do
      m <- r %1 -> m (Maybe (a, r))
next r
cur
      case m of
        Maybe (a, r)
Nothing -> () %1 -> m ()
forall a. a %1 -> m a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure ()
        Just (!a
x, !r
cur) -> Control.do
          cur <- r %1 -> a %1 -> m r
action r
cur a
x
          loop cur

data Pair a where
  Pair :: !a %1 -> !a %1 -> Pair a
  deriving ((forall x. Pair a -> Rep (Pair a) x)
-> (forall x. Rep (Pair a) x -> Pair a) -> Generic (Pair a)
forall x. Rep (Pair a) x -> Pair a
forall x. Pair a -> Rep (Pair a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Pair a) x -> Pair a
forall a x. Pair a -> Rep (Pair a) x
$cfrom :: forall a x. Pair a -> Rep (Pair a) x
from :: forall x. Pair a -> Rep (Pair a) x
$cto :: forall a x. Rep (Pair a) x -> Pair a
to :: forall x. Rep (Pair a) x -> Pair a
GHC.Generic, (forall a. Pair a -> Rep1 Pair a)
-> (forall a. Rep1 Pair a -> Pair a) -> Generic1 Pair
forall a. Rep1 Pair a -> Pair a
forall a. Pair a -> Rep1 Pair a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. Pair a -> Rep1 Pair a
from1 :: forall a. Pair a -> Rep1 Pair a
$cto1 :: forall a. Rep1 Pair a -> Pair a
to1 :: forall a. Rep1 Pair a -> Pair a
GHC.Generic1)

deriveGenericAnd1 ''Pair

deriving via Generically1 Pair instance Data.Functor Pair

deriving via
  Generically (Pair a)
  instance
    (Consumable a) => Consumable (Pair a)

deriving via
  Generically (Pair a)
  instance
    (Dupable a) => Dupable (Pair a)

deriving via
  GenericallyAffine (Pair a)
  instance
    (Affine a) => Affine (Pair a)

deriving via
  Generically (Pair a)
  instance
    (Movable a) => Movable (Pair a)

instance Data.Traversable Pair where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a %1 -> f b) -> Pair a %1 -> f (Pair b)
traverse = (a %1 -> f b) -> Pair a %1 -> f (Pair b)
forall (t :: * -> *) (f :: * -> *) a b.
(Generic1 t, GTraversable (Rep1 t), Applicative f) =>
(a %1 -> f b) -> t a %1 -> f (t b)
Data.genericTraverse
  {-# INLINE traverse #-}

qsortDC ::
  (Ord a, Copyable a, α >= β) =>
  -- | The # of workers.
  Int ->
  -- | Threshold for the length of vector to switch to sequential sort.
  Int ->
  Mut α (LV.Vector a) %1 ->
  BO β (Mut α (LV.Vector a))
qsortDC :: forall a (α :: Lifetime) (β :: Lifetime).
(Ord a, Copyable a, α >= β) =>
Int -> Int -> Mut α (Vector a) %1 -> BO β (Mut α (Vector a))
qsortDC Int
nwork Int
thresh = Int
-> DivideConquer α Pair (Vector a)
-> Mut α (Vector a)
%1 -> BO β (Mut α (Vector a))
forall (α :: Lifetime) (β :: Lifetime) (t :: * -> *) a.
(Traversable t, Consumable (t ()), α >= β) =>
Int -> DivideConquer α t a -> Mut α a %1 -> BO β (Mut α a)
divideAndConquer Int
nwork (Int -> DivideConquer α Pair (Vector a)
forall a (α :: Lifetime).
(Ord a, Copyable a) =>
Int -> DivideConquer α Pair (Vector a)
qsortDC' Int
thresh)

qsortDC' ::
  (Ord a, Copyable a) =>
  -- | Threshold for the length of vector to switch to sequential sort.
  Int ->
  DivideConquer α Pair (LV.Vector a)
qsortDC' :: forall a (α :: Lifetime).
(Ord a, Copyable a) =>
Int -> DivideConquer α Pair (Vector a)
qsortDC' Int
thresh =
  DivideConquer
    { divide :: forall (β :: Lifetime).
(α >= β) =>
Mut β (Vector a) %1 -> BO β (Result β Pair (Vector a))
divide = \Mut β (Vector a)
vs ->
        case Mut β (Vector a) %1 -> (Ur Int, Mut β (Vector a))
forall (bk :: BorrowKind) (α :: Lifetime) a.
Borrow bk α (Vector a) %1 -> (Ur Int, Borrow bk α (Vector a))
LV.size Mut β (Vector a)
vs of
          (Ur Int
n, Mut β (Vector a)
v)
            | Int
n Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
<= Int
1 ->
                Mut β (Vector a)
v Mut β (Vector a)
%1 -> BO β (Result β Pair (Vector a))
%1 -> BO β (Result β Pair (Vector a))
forall a b. Consumable a => a %1 -> b %1 -> b
`lseq` Result β Pair (Vector a) %1 -> BO β (Result β Pair (Vector a))
forall a. a %1 -> BO β a
forall (f :: * -> *) a. Applicative f => a %1 -> f a
Control.pure Result β Pair (Vector a)
forall (β :: Lifetime) (t :: * -> *) a. Result β t a
Done
            | Int
n Int %1 -> Int %1 -> Bool
forall a. Ord a => a %1 -> a %1 -> Bool
<= Int
thresh ->
                Result β Pair (Vector a)
forall (β :: Lifetime) (t :: * -> *) a. Result β t a
Done Result β Pair (Vector a)
%1 -> BO β () %1 -> BO β (Result β Pair (Vector a))
forall (f :: * -> *) b a.
(Functor f, Consumable b) =>
a %1 -> f b %1 -> f a
Control.<$ Word -> Mut β (Vector a) %1 -> BO β ()
forall a (α :: Lifetime) (β :: Lifetime).
(Ord a, Copyable a, α >= β) =>
Word -> Mut α (Vector a) %1 -> BO β ()
LV.qsort Word
0 Mut β (Vector a)
v
            | Bool
otherwise -> Control.do
                let i :: Int
i = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
                (Ur pivot, v) <- Int -> Mut β (Vector a) %1 -> BO β (Ur a, Mut β (Vector a))
forall a (α :: Lifetime) (β :: Lifetime).
(Copyable a, α >= β) =>
Int -> Mut α (Vector a) %1 -> BO β (Ur a, Mut α (Vector a))
LV.copyAtMut Int
i Mut β (Vector a)
v
                (lo, hi) <- LV.divide pivot v 0 n
                Control.pure $ Continue $ Pair lo hi
    }