{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Stream.Supply
-- Copyright   :  (C) 2008-2011 Edward Kmett,
--                (C) 2008 Iavor S. Diatchki
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- This library can be used to generate values (for example, new names)
-- without the need to thread state.  This means that functions that
-- need to generate new values only need a supply object as an argument,
-- and they do not need to return a new supply object as a result.
-- This decreases the number of data-dependencies in a program, which
-- makes it easier to exploit parallelism.
--
-- The technique for generating new values is based on the paper
-- ''On Generating Unique Names'' by Lennart Augustsson, Mikael Rittri,
-- and Dan Synek.
----------------------------------------------------------------------------
module Data.Stream.Supply
  ( Supply
  , newSupply
  , newEnumSupply
  , newNumSupply
  , newDupableSupply
  , newDupableEnumSupply
  , newDupableNumSupply
  , leftSupply
  , rightSupply
  , split
  , splits
  , splitSkew
  , split2
  , split3
  , split4
  ) where

import Control.Comonad
import Data.Data
import Data.Functor.Apply
import Data.Functor.Extend
import Data.Functor.Rep
import Data.IORef(newIORef, atomicModifyIORef)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup
#endif
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import System.IO.Unsafe (unsafeInterleaveIO)
import Data.Stream.Infinite
import qualified Data.Stream.Infinite.Skew as Skew
import GHC.IO(unsafeDupableInterleaveIO)

data Supply a = Supply a (Supply a) (Supply a) deriving
  (Int -> Supply a -> ShowS
[Supply a] -> ShowS
Supply a -> String
(Int -> Supply a -> ShowS)
-> (Supply a -> String) -> ([Supply a] -> ShowS) -> Show (Supply a)
forall a. Show a => Int -> Supply a -> ShowS
forall a. Show a => [Supply a] -> ShowS
forall a. Show a => Supply a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Supply a -> ShowS
showsPrec :: Int -> Supply a -> ShowS
$cshow :: forall a. Show a => Supply a -> String
show :: Supply a -> String
$cshowList :: forall a. Show a => [Supply a] -> ShowS
showList :: [Supply a] -> ShowS
Show, ReadPrec [Supply a]
ReadPrec (Supply a)
Int -> ReadS (Supply a)
ReadS [Supply a]
(Int -> ReadS (Supply a))
-> ReadS [Supply a]
-> ReadPrec (Supply a)
-> ReadPrec [Supply a]
-> Read (Supply a)
forall a. Read a => ReadPrec [Supply a]
forall a. Read a => ReadPrec (Supply a)
forall a. Read a => Int -> ReadS (Supply a)
forall a. Read a => ReadS [Supply a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Supply a)
readsPrec :: Int -> ReadS (Supply a)
$creadList :: forall a. Read a => ReadS [Supply a]
readList :: ReadS [Supply a]
$creadPrec :: forall a. Read a => ReadPrec (Supply a)
readPrec :: ReadPrec (Supply a)
$creadListPrec :: forall a. Read a => ReadPrec [Supply a]
readListPrec :: ReadPrec [Supply a]
Read, Supply a -> Supply a -> Bool
(Supply a -> Supply a -> Bool)
-> (Supply a -> Supply a -> Bool) -> Eq (Supply a)
forall a. Eq a => Supply a -> Supply a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Supply a -> Supply a -> Bool
== :: Supply a -> Supply a -> Bool
$c/= :: forall a. Eq a => Supply a -> Supply a -> Bool
/= :: Supply a -> Supply a -> Bool
Eq, Eq (Supply a)
Eq (Supply a) =>
(Supply a -> Supply a -> Ordering)
-> (Supply a -> Supply a -> Bool)
-> (Supply a -> Supply a -> Bool)
-> (Supply a -> Supply a -> Bool)
-> (Supply a -> Supply a -> Bool)
-> (Supply a -> Supply a -> Supply a)
-> (Supply a -> Supply a -> Supply a)
-> Ord (Supply a)
Supply a -> Supply a -> Bool
Supply a -> Supply a -> Ordering
Supply a -> Supply a -> Supply a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Supply a)
forall a. Ord a => Supply a -> Supply a -> Bool
forall a. Ord a => Supply a -> Supply a -> Ordering
forall a. Ord a => Supply a -> Supply a -> Supply a
$ccompare :: forall a. Ord a => Supply a -> Supply a -> Ordering
compare :: Supply a -> Supply a -> Ordering
$c< :: forall a. Ord a => Supply a -> Supply a -> Bool
< :: Supply a -> Supply a -> Bool
$c<= :: forall a. Ord a => Supply a -> Supply a -> Bool
<= :: Supply a -> Supply a -> Bool
$c> :: forall a. Ord a => Supply a -> Supply a -> Bool
> :: Supply a -> Supply a -> Bool
$c>= :: forall a. Ord a => Supply a -> Supply a -> Bool
>= :: Supply a -> Supply a -> Bool
$cmax :: forall a. Ord a => Supply a -> Supply a -> Supply a
max :: Supply a -> Supply a -> Supply a
$cmin :: forall a. Ord a => Supply a -> Supply a -> Supply a
min :: Supply a -> Supply a -> Supply a
Ord, Typeable (Supply a)
Typeable (Supply a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Supply a -> c (Supply a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Supply a))
-> (Supply a -> Constr)
-> (Supply a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Supply a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Supply a)))
-> ((forall b. Data b => b -> b) -> Supply a -> Supply a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Supply a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Supply a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Supply a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Supply a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Supply a -> m (Supply a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Supply a -> m (Supply a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Supply a -> m (Supply a))
-> Data (Supply a)
Supply a -> Constr
Supply a -> DataType
(forall b. Data b => b -> b) -> Supply a -> Supply a
forall a. Data a => Typeable (Supply a)
forall a. Data a => Supply a -> Constr
forall a. Data a => Supply a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Supply a -> Supply a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Supply a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Supply a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Supply a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Supply a -> c (Supply a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Supply a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Supply a))
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Supply a -> u
forall u. (forall d. Data d => d -> u) -> Supply a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Supply a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Supply a -> c (Supply a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Supply a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Supply a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Supply a -> c (Supply a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Supply a -> c (Supply a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Supply a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Supply a)
$ctoConstr :: forall a. Data a => Supply a -> Constr
toConstr :: Supply a -> Constr
$cdataTypeOf :: forall a. Data a => Supply a -> DataType
dataTypeOf :: Supply a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Supply a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Supply a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Supply a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Supply a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Supply a -> Supply a
gmapT :: (forall b. Data b => b -> b) -> Supply a -> Supply a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Supply a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Supply a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Supply a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Supply a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Supply a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Supply a -> m (Supply a)
Data)

instance Functor Supply where
  fmap :: forall a b. (a -> b) -> Supply a -> Supply b
fmap a -> b
f (Supply a
a Supply a
l Supply a
r) = b -> Supply b -> Supply b -> Supply b
forall a. a -> Supply a -> Supply a -> Supply a
Supply (a -> b
f a
a) ((a -> b) -> Supply a -> Supply b
forall a b. (a -> b) -> Supply a -> Supply b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Supply a
l) ((a -> b) -> Supply a -> Supply b
forall a b. (a -> b) -> Supply a -> Supply b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Supply a
r)
  a
a <$ :: forall a b. a -> Supply b -> Supply a
<$ Supply b
_ = a -> Supply a
forall a. a -> Supply a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

instance Extend Supply where
  extended :: forall a b. (Supply a -> b) -> Supply a -> Supply b
extended Supply a -> b
f s :: Supply a
s@(Supply a
_ Supply a
l Supply a
r) = b -> Supply b -> Supply b -> Supply b
forall a. a -> Supply a -> Supply a -> Supply a
Supply (Supply a -> b
f Supply a
s) ((Supply a -> b) -> Supply a -> Supply b
forall a b. (Supply a -> b) -> Supply a -> Supply b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended Supply a -> b
f Supply a
l) ((Supply a -> b) -> Supply a -> Supply b
forall a b. (Supply a -> b) -> Supply a -> Supply b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended Supply a -> b
f Supply a
r)
  duplicated :: forall a. Supply a -> Supply (Supply a)
duplicated s :: Supply a
s@(Supply a
_ Supply a
l Supply a
r) = Supply a
-> Supply (Supply a) -> Supply (Supply a) -> Supply (Supply a)
forall a. a -> Supply a -> Supply a -> Supply a
Supply Supply a
s (Supply a -> Supply (Supply a)
forall a. Supply a -> Supply (Supply a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated Supply a
l) (Supply a -> Supply (Supply a)
forall a. Supply a -> Supply (Supply a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated Supply a
r)

instance Comonad Supply where
  extend :: forall a b. (Supply a -> b) -> Supply a -> Supply b
extend Supply a -> b
f s :: Supply a
s@(Supply a
_ Supply a
l Supply a
r) = b -> Supply b -> Supply b -> Supply b
forall a. a -> Supply a -> Supply a -> Supply a
Supply (Supply a -> b
f Supply a
s) ((Supply a -> b) -> Supply a -> Supply b
forall a b. (Supply a -> b) -> Supply a -> Supply b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Supply a -> b
f Supply a
l) ((Supply a -> b) -> Supply a -> Supply b
forall a b. (Supply a -> b) -> Supply a -> Supply b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend Supply a -> b
f Supply a
r)
  duplicate :: forall a. Supply a -> Supply (Supply a)
duplicate s :: Supply a
s@(Supply a
_ Supply a
l Supply a
r) = Supply a
-> Supply (Supply a) -> Supply (Supply a) -> Supply (Supply a)
forall a. a -> Supply a -> Supply a -> Supply a
Supply Supply a
s (Supply a -> Supply (Supply a)
forall a. Supply a -> Supply (Supply a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Supply a
l) (Supply a -> Supply (Supply a)
forall a. Supply a -> Supply (Supply a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate Supply a
r)
  extract :: forall a. Supply a -> a
extract (Supply a
a Supply a
_ Supply a
_) = a
a

instance Apply Supply where
  Supply a -> b
f Supply (a -> b)
fl Supply (a -> b)
fr <.> :: forall a b. Supply (a -> b) -> Supply a -> Supply b
<.> Supply a
a Supply a
al Supply a
ar = b -> Supply b -> Supply b -> Supply b
forall a. a -> Supply a -> Supply a -> Supply a
Supply (a -> b
f a
a) (Supply (a -> b)
fl Supply (a -> b) -> Supply a -> Supply b
forall a b. Supply (a -> b) -> Supply a -> Supply b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> Supply a
al) (Supply (a -> b)
fr Supply (a -> b) -> Supply a -> Supply b
forall a b. Supply (a -> b) -> Supply a -> Supply b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> Supply a
ar)
  Supply a
a <. :: forall a b. Supply a -> Supply b -> Supply a
<. Supply b
_ = Supply a
a
  Supply a
_ .> :: forall a b. Supply a -> Supply b -> Supply b
.> Supply b
a = Supply b
a

instance Applicative Supply where
  pure :: forall a. a -> Supply a
pure a
a = Supply a
as where as :: Supply a
as = a -> Supply a -> Supply a -> Supply a
forall a. a -> Supply a -> Supply a -> Supply a
Supply a
a Supply a
as Supply a
as
  Supply a -> b
f Supply (a -> b)
fl Supply (a -> b)
fr <*> :: forall a b. Supply (a -> b) -> Supply a -> Supply b
<*> Supply a
a Supply a
al Supply a
ar = b -> Supply b -> Supply b -> Supply b
forall a. a -> Supply a -> Supply a -> Supply a
Supply (a -> b
f a
a) (Supply (a -> b)
fl Supply (a -> b) -> Supply a -> Supply b
forall a b. Supply (a -> b) -> Supply a -> Supply b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Supply a
al) (Supply (a -> b)
fr Supply (a -> b) -> Supply a -> Supply b
forall a b. Supply (a -> b) -> Supply a -> Supply b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Supply a
ar)
  Supply a
a <* :: forall a b. Supply a -> Supply b -> Supply a
<* Supply b
_ = Supply a
a
  Supply a
_ *> :: forall a b. Supply a -> Supply b -> Supply b
*> Supply b
a = Supply b
a

instance Foldable Supply where
  foldMap :: forall m a. Monoid m => (a -> m) -> Supply a -> m
foldMap a -> m
f (Supply a
a Supply a
l Supply a
r) = a -> m
f a
a m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Supply a -> m
forall m a. Monoid m => (a -> m) -> Supply a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Supply a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> Supply a -> m
forall m a. Monoid m => (a -> m) -> Supply a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f Supply a
r

instance Foldable1 Supply where
  foldMap1 :: forall m a. Semigroup m => (a -> m) -> Supply a -> m
foldMap1 a -> m
f (Supply a
a Supply a
l Supply a
r) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Supply a -> m
forall m a. Semigroup m => (a -> m) -> Supply a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f Supply a
l m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> Supply a -> m
forall m a. Semigroup m => (a -> m) -> Supply a -> m
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
foldMap1 a -> m
f Supply a
r

instance Traversable Supply where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Supply a -> f (Supply b)
traverse a -> f b
f (Supply a
a Supply a
l Supply a
r) = b -> Supply b -> Supply b -> Supply b
forall a. a -> Supply a -> Supply a -> Supply a
Supply (b -> Supply b -> Supply b -> Supply b)
-> f b -> f (Supply b -> Supply b -> Supply b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (Supply b -> Supply b -> Supply b)
-> f (Supply b) -> f (Supply b -> Supply b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Supply a -> f (Supply b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Supply a -> f (Supply b)
traverse a -> f b
f Supply a
l f (Supply b -> Supply b) -> f (Supply b) -> f (Supply b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b) -> Supply a -> f (Supply b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Supply a -> f (Supply b)
traverse a -> f b
f Supply a
r

instance Traversable1 Supply where
  traverse1 :: forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Supply a -> f (Supply b)
traverse1 a -> f b
f (Supply a
a Supply a
l Supply a
r) = b -> Supply b -> Supply b -> Supply b
forall a. a -> Supply a -> Supply a -> Supply a
Supply (b -> Supply b -> Supply b -> Supply b)
-> f b -> f (Supply b -> Supply b -> Supply b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (Supply b -> Supply b -> Supply b)
-> f (Supply b) -> f (Supply b -> Supply b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> f b) -> Supply a -> f (Supply b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Supply a -> f (Supply b)
traverse1 a -> f b
f Supply a
l f (Supply b -> Supply b) -> f (Supply b) -> f (Supply b)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Apply f => f (a -> b) -> f a -> f b
<.> (a -> f b) -> Supply a -> f (Supply b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable1 t, Apply f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Apply f =>
(a -> f b) -> Supply a -> f (Supply b)
traverse1 a -> f b
f Supply a
r

leftSupply :: Supply a -> Supply a
leftSupply :: forall a. Supply a -> Supply a
leftSupply (Supply a
_ Supply a
l Supply a
_) = Supply a
l

rightSupply :: Supply a -> Supply a
rightSupply :: forall a. Supply a -> Supply a
rightSupply (Supply a
_ Supply a
_ Supply a
r) = Supply a
r

-- unfoldsW :: (Comonad w, Functor f) => (w a -> (b, f a)) -> w a -> StreamT f w b
newSupply :: (a -> a) -> a -> IO (Supply a)
newSupply :: forall a. (a -> a) -> a -> IO (Supply a)
newSupply a -> a
f a
x = IORef a -> IO (Supply a)
gen (IORef a -> IO (Supply a)) -> IO (IORef a) -> IO (Supply a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
x
  where gen :: IORef a -> IO (Supply a)
gen IORef a
r = IO (Supply a) -> IO (Supply a)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Supply a) -> IO (Supply a)) -> IO (Supply a) -> IO (Supply a)
forall a b. (a -> b) -> a -> b
$
          a -> Supply a -> Supply a -> Supply a
forall a. a -> Supply a -> Supply a -> Supply a
Supply (a -> Supply a -> Supply a -> Supply a)
-> IO a -> IO (Supply a -> Supply a -> Supply a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO a
forall a. IO a -> IO a
unsafeInterleaveIO (IORef a -> (a -> (a, a)) -> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
r a -> (a, a)
update)
                 IO (Supply a -> Supply a -> Supply a)
-> IO (Supply a) -> IO (Supply a -> Supply a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IORef a -> IO (Supply a)
gen IORef a
r
                 IO (Supply a -> Supply a) -> IO (Supply a) -> IO (Supply a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IORef a -> IO (Supply a)
gen IORef a
r
        update :: a -> (a, a)
update a
a = a
b a -> (a, a) -> (a, a)
forall a b. a -> b -> b
`seq` (a
b, a
a) where b :: a
b = a -> a
f a
a
{-# INLINE newSupply #-}

newDupableSupply :: (a -> a) -> a -> IO (Supply a)
newDupableSupply :: forall a. (a -> a) -> a -> IO (Supply a)
newDupableSupply a -> a
f a
x = IORef a -> IO (Supply a)
gen (IORef a -> IO (Supply a)) -> IO (IORef a) -> IO (Supply a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> IO (IORef a)
forall a. a -> IO (IORef a)
newIORef a
x
  where gen :: IORef a -> IO (Supply a)
gen IORef a
r = IO (Supply a) -> IO (Supply a)
forall a. IO a -> IO a
unsafeDupableInterleaveIO (IO (Supply a) -> IO (Supply a)) -> IO (Supply a) -> IO (Supply a)
forall a b. (a -> b) -> a -> b
$
          a -> Supply a -> Supply a -> Supply a
forall a. a -> Supply a -> Supply a -> Supply a
Supply (a -> Supply a -> Supply a -> Supply a)
-> IO a -> IO (Supply a -> Supply a -> Supply a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> IO a
forall a. IO a -> IO a
unsafeDupableInterleaveIO (IORef a -> (a -> (a, a)) -> IO a
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef a
r a -> (a, a)
update)
                 IO (Supply a -> Supply a -> Supply a)
-> IO (Supply a) -> IO (Supply a -> Supply a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IORef a -> IO (Supply a)
gen IORef a
r
                 IO (Supply a -> Supply a) -> IO (Supply a) -> IO (Supply a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IORef a -> IO (Supply a)
gen IORef a
r
        update :: a -> (a, a)
update a
a = a
b a -> (a, a) -> (a, a)
forall a b. a -> b -> b
`seq` (a
b, a
a) where b :: a
b = a -> a
f a
a
{-# INLINE newDupableSupply #-}

newEnumSupply :: Enum a => IO (Supply a)
newEnumSupply :: forall a. Enum a => IO (Supply a)
newEnumSupply = (a -> a) -> a -> IO (Supply a)
forall a. (a -> a) -> a -> IO (Supply a)
newSupply a -> a
forall a. Enum a => a -> a
succ (Int -> a
forall a. Enum a => Int -> a
toEnum Int
0)
{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-}

newNumSupply :: Num a => IO (Supply a)
newNumSupply :: forall a. Num a => IO (Supply a)
newNumSupply = (a -> a) -> a -> IO (Supply a)
forall a. (a -> a) -> a -> IO (Supply a)
newSupply (a
1a -> a -> a
forall a. Num a => a -> a -> a
+) a
0
{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-}

newDupableEnumSupply :: Enum a => IO (Supply a)
newDupableEnumSupply :: forall a. Enum a => IO (Supply a)
newDupableEnumSupply = (a -> a) -> a -> IO (Supply a)
forall a. (a -> a) -> a -> IO (Supply a)
newSupply a -> a
forall a. Enum a => a -> a
succ (Int -> a
forall a. Enum a => Int -> a
toEnum Int
0)
{-# SPECIALIZE newEnumSupply :: IO (Supply Int) #-}

newDupableNumSupply :: Num a => IO (Supply a)
newDupableNumSupply :: forall a. Num a => IO (Supply a)
newDupableNumSupply = (a -> a) -> a -> IO (Supply a)
forall a. (a -> a) -> a -> IO (Supply a)
newSupply (a
1a -> a -> a
forall a. Num a => a -> a -> a
+) a
0
{-# SPECIALIZE newNumSupply :: IO (Supply Int) #-}

split :: Supply a -> Stream (Supply a)
split :: forall a. Supply a -> Stream (Supply a)
split (Supply a
_ Supply a
l Supply a
r) = Supply a
l Supply a -> Stream (Supply a) -> Stream (Supply a)
forall a. a -> Stream a -> Stream a
:> Supply a -> Stream (Supply a)
forall a. Supply a -> Stream (Supply a)
split Supply a
r

splits :: Integral b => Supply a -> b -> Supply a
splits :: forall b a. Integral b => Supply a -> b -> Supply a
splits (Supply a
_ Supply a
l Supply a
r) b
n = case b
n b -> b -> (b, b)
forall a. Integral a => a -> a -> (a, a)
`quotRem` b
2 of
  (b
0,b
0)  -> Supply a -> Supply a
forall a. Supply a -> Supply a
leftSupply Supply a
l
  (b
q,-1) -> Supply a -> b -> Supply a
forall b a. Integral b => Supply a -> b -> Supply a
splits (Supply a -> Supply a
forall a. Supply a -> Supply a
rightSupply Supply a
l) b
q
  (b
q,b
0)  -> Supply a -> b -> Supply a
forall b a. Integral b => Supply a -> b -> Supply a
splits (Supply a -> Supply a
forall a. Supply a -> Supply a
leftSupply Supply a
r) b
q
  (b
q,b
1)  -> Supply a -> b -> Supply a
forall b a. Integral b => Supply a -> b -> Supply a
splits (Supply a -> Supply a
forall a. Supply a -> Supply a
rightSupply Supply a
r) b
q
  (b
_,b
_)  -> String -> Supply a
forall a. HasCallStack => String -> a
error String
"quotRem: impossible result"
{-# SPECIALIZE splits :: Supply a -> Int -> Supply a #-}
{-# SPECIALIZE splits :: Supply a -> Integer -> Supply a #-}

splitSkew :: Supply a -> Skew.Stream (Supply a)
splitSkew :: forall a. Supply a -> Stream (Supply a)
splitSkew = (Integer -> Supply a) -> Stream (Supply a)
(Rep Stream -> Supply a) -> Stream (Supply a)
forall a. (Rep Stream -> a) -> Stream a
forall (f :: * -> *) a. Representable f => (Rep f -> a) -> f a
tabulate ((Integer -> Supply a) -> Stream (Supply a))
-> (Supply a -> Integer -> Supply a)
-> Supply a
-> Stream (Supply a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Supply a -> Integer -> Supply a
forall b a. Integral b => Supply a -> b -> Supply a
splits

split2 :: Supply a -> (Supply a, Supply a)
split2 :: forall a. Supply a -> (Supply a, Supply a)
split2 (Supply a
_ Supply a
l Supply a
r) = (Supply a
l, Supply a
r)

split3 :: Supply a -> (Supply a, Supply a, Supply a)
split3 :: forall a. Supply a -> (Supply a, Supply a, Supply a)
split3 (Supply a
_ Supply a
a (Supply a
_ Supply a
b Supply a
c)) = (Supply a
a, Supply a
b, Supply a
c)

split4 :: Supply a -> (Supply a, Supply a, Supply a, Supply a)
split4 :: forall a. Supply a -> (Supply a, Supply a, Supply a, Supply a)
split4 (Supply a
_ (Supply a
_ Supply a
a Supply a
b) (Supply a
_ Supply a
c Supply a
d)) = (Supply a
a, Supply a
b, Supply a
c, Supply a
d)