libretto.puro.PuroLib.scala Maven / Gradle / Ivy
The newest version!
package libretto.puro
import libretto.cats.{Bifunctor, Comonad, ContraFunctor, Functor, Monad}
import libretto.lambda.{Category, Extractor, SymmetricMonoidalCategory}
import libretto.lambda.util.SourcePos
import libretto.lambda.util.unapply.*
import libretto.util.{Equal, ∀}
import scala.annotation.tailrec
import scala.collection.immutable.{:: as NonEmptyList}
object PuroLib {
def apply(dsl: Puro): PuroLib[dsl.type] =
new PuroLib(dsl)
}
class PuroLib[DSL <: Puro](val dsl: DSL) { lib =>
import dsl.*
/** Evidence that `A` flowing in one direction is equivalent to to `B` flowing in the opposite direction.
* It must hold that
* ```
* ┏━━━━━┓ ┏━━━━━┓
* ┞─┐ r ┃ ┃ l ┞─┐
* ╎A│ I ┃ ┃ I ╎B│
* ┟─┘ n ┃ ┃ n ┟─┘
* ┏━━━━━┫ v ┃ ┏━━━━━━━━━┓ ┃ v ┣━━━━━┓ ┏━━━━━━━━━┓
* ┃ l ┞─┐ e ┃ ┞─┐ ┞─┐ ┃ e ┞─┐ r ┃ ┞─┐ ┞─┐
* ┃ I ╎B│ r ┃ = ╎A│ id[A] ╎A│ ┃ r ╎A│ I ┃ = ╎B│ id[B] ╎B│
* ┃ n ┟─┘ t ┃ ┟─┘ ┟─┘ ┃ t ┟─┘ n ┃ ┟─┘ ┟─┘
* ┃ v ┣━━━━━┛ ┗━━━━━━━━━┛ ┗━━━━━┫ v ┃ ┗━━━━━━━━━┛
* ┃ e ┞─┐ ┞─┐ e ┃
* ┃ r ╎A│ ╎B│ r ┃
* ┃ t ┟─┘ ┟─┘ t ┃
* ┗━━━━━┛ ┗━━━━━┛
* ```
*/
trait Dual[A, B] {
/** Reverses the input that flows along the `-⚬` arrow (say it is the `A` input) to its dual (`B`) flowing
* against the direction of the arrow.
*
* ```
* ┏━━━━━━━┓
* ┞─┐ r ┃
* ╎A│─┐ I ┃
* ┟─┘ ┆ n ┃
* ┃ ┆ v ┃
* ┞─┐ ┆ e ┃
* ╎B│←┘ r ┃
* ┟─┘ t ┃
* ┗━━━━━━━┛
* ```
*/
val rInvert: (A |*| B) -⚬ One
/** Reverses the output that flows against the `-⚬` arrow (say it is the `B` output) to its dual (`A`) flowing
* in the direction of the arrow.
*
* ```
* ┏━━━━━┓
* ┃ l ┞─┐
* ┃ I ┌─╎B│
* ┃ n ┆ ┟─┘
* ┃ v ┆ ┃
* ┃ e ┆ ┞─┐
* ┃ r └→╎A│
* ┃ t ┟─┘
* ┗━━━━━┛
* ```
*/
val lInvert: One -⚬ (B |*| A)
/** Law stating that [[rInvert]] followed by [[lInvert]] is identity. */
def law_rl_id: Equal[A -⚬ A] =
Equal(
id[A] .to[ A ]
.>(introSnd(lInvert)) .to[ A |*| (B |*| A) ]
.>(assocRL) .to[ (A |*| B) |*| A ]
.>(elimFst(rInvert)) .to[ A ],
id[A]
)
/** Law stating that [[lInvert]] followed by [[rInvert]] is identity. */
def law_lr_id: Equal[B -⚬ B] =
Equal(
id[B] .to[ B ]
.>(introFst(lInvert)) .to[ (B |*| A) |*| B ]
.>(assocLR) .to[ B |*| (A |*| B) ]
.>(elimSnd(rInvert)) .to[ B ],
id[B]
)
}
object Dual {
/** Convenience method to summon instances of [[dsl.Dual]]. */
def apply[A, B](using ev: Dual[A, B]): Dual[A, B] = ev
}
def rInvert[A, B](using ev: Dual[A, B]): (A |*| B) -⚬ One =
ev.rInvert
def lInvert[A, B](using ev: Dual[A, B]): One -⚬ (B |*| A) =
ev.lInvert
type Functor[F[_]] =
libretto.cats.Functor[-⚬, F]
object Functor {
def apply[F[_]: Functor]: Functor[F] =
libretto.cats.Functor[-⚬, F]
}
type ContraFunctor[F[_]] =
libretto.cats.ContraFunctor[-⚬, F]
object ContraFunctor {
def apply[F[_]: ContraFunctor]: ContraFunctor[F] =
libretto.cats.ContraFunctor[-⚬, F]
}
type Bifunctor[F[_, _]] =
libretto.cats.Bifunctor[-⚬, F]
object Bifunctor {
def apply[F[_, _]: Bifunctor]: Bifunctor[F] =
libretto.cats.Bifunctor[-⚬, F]
}
/** Functor from category [[-⚬]] to the category `=>` of Scala functions.
* It takes a morphism `A -⚬ B` internal to the DSL and maps it to a morphism `F[A] => F[B]` in the meta language
* (Scala), i.e. external to the DSL.
*/
trait Externalizer[F[_]] { self =>
def lift[A, B](f: A -⚬ B): F[A] => F[B]
def ∘[G[_]](that: Functor[G]): Externalizer[[x] =>> F[G[x]]] =
new Externalizer[[x] =>> F[G[x]]] {
def lift[A, B](f: A -⚬ B): F[G[A]] => F[G[B]] =
self.lift(that.lift(f))
}
def ∘[G[_]](that: ContraFunctor[G]): ContraExternalizer[[x] =>> F[G[x]]] =
new ContraExternalizer[[x] =>> F[G[x]]] {
def lift[A, B](f: A -⚬ B): F[G[B]] => F[G[A]] =
self.lift(that.lift(f))
}
def ∘[G[_, _]](that: Bifunctor[G]): BiExternalizer[[x, y] =>> F[G[x, y]]] =
new BiExternalizer[[x, y] =>> F[G[x, y]]] {
def lift[A, B, C, D](f: A -⚬ B, g: C -⚬ D): F[G[A, C]] => F[G[B, D]] =
self.lift(that.lift(f, g))
}
}
object Externalizer {
given outportFrom[A]: Externalizer[[x] =>> A -⚬ x] with {
override def lift[B, C](f: B -⚬ C): (A -⚬ B) => (A -⚬ C) =
dsl.andThen(_, f)
}
}
trait BiExternalizer[F[_, _]] { self =>
def lift[A, B, C, D](f: A -⚬ B, g: C -⚬ D): F[A, C] => F[B, D]
def fst[B]: Externalizer[F[*, B]] =
new Externalizer[F[*, B]] {
def lift[A1, A2](f: A1 -⚬ A2): F[A1, B] => F[A2, B] =
self.lift(f, id)
}
def snd[A]: Externalizer[F[A, *]] =
new Externalizer[F[A, *]] {
def lift[B1, B2](g: B1 -⚬ B2): F[A, B1] => F[A, B2] =
self.lift(id, g)
}
}
/** Contravariant functor from category [[-⚬]] to the category `=>` of Scala functions.
* It takes a morphism `A -⚬ B` internal to the DSL and maps it to a morphism `F[B] => F[A]` in the meta language
* (Scala), i.e. external to the DSL.
*/
trait ContraExternalizer[F[_]] { self =>
def lift[A, B](f: A -⚬ B): F[B] => F[A]
def ∘[G[_]](that: Functor[G]): ContraExternalizer[[x] =>> F[G[x]]] =
new ContraExternalizer[[x] =>> F[G[x]]] {
def lift[A, B](f: A -⚬ B): F[G[B]] => F[G[A]] =
self.lift(that.lift(f))
}
def ∘[G[_]](that: ContraFunctor[G]): Externalizer[[x] =>> F[G[x]]] =
new Externalizer[[x] =>> F[G[x]]] {
def lift[A, B](f: A -⚬ B): F[G[A]] => F[G[B]] =
self.lift(that.lift(f))
}
}
object ContraExternalizer {
given inportTo[C]: ContraExternalizer[[x] =>> x -⚬ C] with {
def lift[A, B](f: A -⚬ B): (B -⚬ C) => (A -⚬ C) =
f > _
}
}
/** Expresses the intent that interaction with `A` is (at least partially) obstructed.
* The detention can be ended by receiving a signal.
*
* Note that whether/how much the interaction with `Detained[A]` is actually
* obstructed is completely up to the producer of `Detained[A]`.
*
* Equivalent to `Need |*| A` (or `Done =⚬ A` if the DSL extends [[ClosedDSL]]).
*/
opaque type Detained[A] = Need |*| A
object Detained {
def untilNeed[A, B](f: A -⚬ (Need |*| B)): A -⚬ Detained[B] =
f
def untilDone[A, B](f: (Done |*| A) -⚬ B): A -⚬ Detained[B] =
id[A] > introFst(lInvertSignal) > assocLR > snd(f)
def apply[A, B](f: (Done |*| A) -⚬ B): A -⚬ Detained[B] =
Detained.untilDone(f)
def thunk[A](f: Done -⚬ A): One -⚬ Detained[A] =
lInvertSignal > snd(f)
/** Present the first part of a [[Detained]] pair as non-detained. */
def excludeFst[A, B]: Detained[A |*| B] -⚬ (A |*| Detained[B]) =
XI
/** Present the second part of a [[Detained]] pair as non-detained. */
def excludeSnd[A, B]: Detained[A |*| B] -⚬ (Detained[A] |*| B) =
assocRL
def releaseBy[A]: (Done |*| Detained[A]) -⚬ A =
assocRL > elimFst(rInvertSignal)
def releaseAsap[A]: Detained[A] -⚬ A =
elimFst(need)
/** Subsequent [[releaseBy]] won't have effect until also the given [[Need]] signal arrives. */
def extendDetentionUntilNeed[A]: Detained[A] -⚬ (Need |*| Detained[A]) =
fst(joinNeed) > assocLR
/** Subsequent [[releaseBy]] won't have effect until also the given [[Done]] signal arrives. */
def extendDetentionUntil[A]: (Done |*| Detained[A]) -⚬ Detained[A] =
snd(extendDetentionUntilNeed) > assocRL > elimFst(rInvertSignal)
def notifyReleaseNeg[A]: (Pong |*| Detained[A]) -⚬ Detained[A] =
assocRL > fst(notifyNeedL)
def notifyReleasePos[A]: Detained[A] -⚬ (Ping |*| Detained[A]) =
introFst(lInvertPongPing > swap) > assocLR > snd(notifyReleaseNeg)
/** Signals when it is released, awaiting delays the release. */
given [A]: SignalingJunction.Negative[Detained[A]] =
SignalingJunction.Negative.byFst
given Transportive[Detained] with {
override val category: Category[-⚬] =
dsl.category
override def lift[A, B](f: A -⚬ B): Detained[A] -⚬ Detained[B] =
snd(f)
override def inL[A, B]: (A |*| Detained[B]) -⚬ Detained[A |*| B] =
XI
override def outL[A, B]: Detained[A |*| B] -⚬ (A |*| Detained[B]) =
XI
}
}
extension [A](a: $[Detained[A]]) {
def releaseWhen(trigger: $[Done])(using LambdaContext): $[A] =
Detained.releaseBy(trigger |*| a)
}
/** Like [[Detained]], expresses that interaction with `A` is (at least partially) obstructed,
* but does not have the ability to absorb a non-dismissible signal (namely [[Done]])—the signal
* to resume must be dismissible (namely [[Ping]]).
*/
opaque type Deferred[A] = Pong |*| A
object Deferred {
def untilPong[A, B](f: A -⚬ (Pong |*| B)): A -⚬ Deferred[B] =
f
def untilPing[A, B](f: (Ping |*| A) -⚬ B): A -⚬ Deferred[B] =
id[A] > introFst(lInvertPongPing) > assocLR > snd(f)
def apply[A, B](f: (Ping |*| A) -⚬ B): A -⚬ Deferred[B] =
Deferred.untilPing(f)
def thunk[A](f: Ping -⚬ A): One -⚬ Deferred[A] =
lInvertPongPing > snd(f)
def resumeBy[A]: (Ping |*| Deferred[A]) -⚬ A =
assocRL > elimFst(rInvertPingPong)
def forceResume[A]: Deferred[A] -⚬ A =
elimFst(pong)
def notifyResumeNeg[A]: (Pong |*| Deferred[A]) -⚬ Deferred[A] =
assocRL > fst(forkPong)
def notifyResumePos[A]: Deferred[A] -⚬ (Ping |*| Deferred[A]) =
introFst(lInvertPongPing > swap) > assocLR > snd(notifyResumeNeg)
/** Signals resumption. */
given signalingDeferred[A]: Signaling.Negative[Deferred[A]] =
Signaling.Negative.byFst
/** Defers resumption. */
given deferrableDeferred[A]: Deferrable.Negative[Deferred[A]] =
Deferrable.Negative.byFst
}
extension [A](a: $[Deferred[A]]) {
def resumeWhen(trigger: $[Ping])(using LambdaContext): $[A] =
Deferred.resumeBy(trigger |*| a)
}
object Deferrable {
/** Represents ''a'' way how (part of) `A` can be deferred until a [[Ping]]. */
trait Positive[A] {
def awaitPingFst: (Ping |*| A) -⚬ A
def awaitPingSnd: (A |*| Ping) -⚬ A =
swap > awaitPingFst
/** Alias for [[awaitPingFst]]. */
def awaitPing: (Ping |*| A) -⚬ A =
awaitPingFst
def defer: A -⚬ Deferred[A] =
Deferred.untilPing(awaitPingFst)
def law_awaitPingIdentity: Equal[(One |*| A) -⚬ A] =
Equal(
fst(ping) > awaitPingFst,
elimFst,
)
def law_awaitPingComposition: Equal[(Ping |*| (Ping |*| A)) -⚬ A] =
Equal(
snd(awaitPingFst) > awaitPingFst,
assocRL > fst(joinPing) > awaitPingFst,
)
}
/** Represents ''a'' way how (part of) `A` can be deferred until a [[Pong]]. */
trait Negative[A] {
def awaitPongFst: A -⚬ (Pong |*| A)
def awaitPongSnd: A -⚬ (A |*| Pong) =
awaitPongFst > swap
/** Alias for [[awaitPongFst]]. */
def awaitPong: A -⚬ (Pong |*| A) =
awaitPongFst
def defer: A -⚬ Deferred[A] =
Deferred.untilPong(awaitPongFst)
def law_awaitPongIdentity: Equal[A -⚬ (One |*| A)] =
Equal(
awaitPongFst > fst(pong),
introFst,
)
def law_awaitPongComposition: Equal[A -⚬ (Pong |*| (Pong |*| A))] =
Equal(
awaitPongFst > snd(awaitPongFst),
awaitPongFst > fst(joinPong) > assocLR,
)
}
object Positive {
def from[A](f: (Ping |*| A) -⚬ A): Deferrable.Positive[A] =
new Deferrable.Positive[A] {
override def awaitPingFst: (Ping |*| A) -⚬ A =
f
}
given Deferrable.Positive[Ping] =
from(joinPing)
given Deferrable.Positive[Done] =
Junction.Positive.junctionDone
def byFst[A, B](using A: Deferrable.Positive[A]): Deferrable.Positive[A |*| B] =
from(assocRL > fst(A.awaitPingFst))
def bySnd[A, B](using B: Deferrable.Positive[B]): Deferrable.Positive[A |*| B] =
from(XI > snd(B.awaitPingFst))
}
object Negative {
def from[A](f: A -⚬ (Pong |*| A)): Deferrable.Negative[A] =
new Deferrable.Negative[A] {
override def awaitPongFst: A -⚬ (Pong |*| A) =
f
}
given Deferrable.Negative[Pong] =
from(joinPong)
given Deferrable.Negative[Need] =
Junction.Negative.junctionNeed
def byFst[A, B](using A: Deferrable.Negative[A]): Deferrable.Negative[A |*| B] =
from(fst(A.awaitPongFst) > assocLR)
def bySnd[A, B](using B: Deferrable.Negative[B]): Deferrable.Negative[A |*| B] =
from(snd(B.awaitPongFst) > XI)
}
def invert[A](d: Deferrable.Positive[A]): Deferrable.Negative[A] =
new Deferrable.Negative[A] {
override def awaitPongFst: A -⚬ (Pong |*| A) =
introFst(lInvertPongPing) > assocLR > snd(d.awaitPingFst)
}
def invert[A](d: Deferrable.Negative[A]): Deferrable.Positive[A] =
new Deferrable.Positive[A] {
override def awaitPingFst: (Ping |*| A) -⚬ A =
snd(d.awaitPongFst) > assocRL > elimFst(rInvertPingPong)
}
}
object Junction {
/** Represents ''a'' way how `A` can await (join) a positive (i.e. [[Done]]) signal. */
trait Positive[A] extends Deferrable.Positive[A] {
def awaitPosFst: (Done |*| A) -⚬ A
override def awaitPingFst: (Ping |*| A) -⚬ A =
fst(strengthenPing) > awaitPosFst
def awaitPosSnd: (A |*| Done) -⚬ A =
swap > awaitPosFst
/** Alias for [[awaitPosFst]]. */
def awaitPos: (Done |*| A) -⚬ A =
awaitPosFst
def detain: A -⚬ Detained[A] =
Detained.untilDone(awaitPosFst)
def law_awaitIdentity: Equal[(One |*| A) -⚬ A] =
Equal(
par(done, id) > awaitPosFst,
elimFst,
)
def law_AwaitComposition: Equal[(Done |*| (Done |*| A)) -⚬ A] =
Equal(
par(id, awaitPosFst) > awaitPosFst,
assocRL > par(join, id) > awaitPosFst,
)
}
/** Represents ''a'' way how `A` can await (join) a negative (i.e. [[Need]]) signal. */
trait Negative[A] extends Deferrable.Negative[A] {
def awaitNegFst: A -⚬ (Need |*| A)
override def awaitPongFst: A -⚬ (Pong |*| A) =
awaitNegFst > fst(strengthenPong)
def awaitNegSnd: A -⚬ (A |*| Need) =
awaitNegFst > swap
/** Alias for [[awaitNegFst]]. */
def awaitNeg: A -⚬ (Need |*| A) =
awaitNegFst
def detain: A -⚬ Detained[A] =
Detained.untilNeed(awaitNegFst)
def law_awaitIdentity: Equal[A -⚬ (One |*| A)] =
Equal(
awaitNegFst > par(need, id),
introFst,
)
def law_awaitComposition: Equal[A -⚬ (Need |*| (Need |*| A))] =
Equal(
awaitNegFst > par(id, awaitNegFst),
awaitNegFst > par(joinNeed, id) > assocLR,
)
}
object Positive {
def apply[A](using A: Junction.Positive[A]): Junction.Positive[A] =
A
def from[A](await: (Done |*| A) -⚬ A): Junction.Positive[A] =
new Junction.Positive[A] {
override def awaitPosFst: (Done |*| A) -⚬ A =
await
}
given junctionDone: Junction.Positive[Done] =
from(join)
def byFst[A, B](using A: Junction.Positive[A]): Junction.Positive[A |*| B] =
from(assocRL > fst(A.awaitPosFst))
def bySnd[A, B](using B: Junction.Positive[B]): Junction.Positive[A |*| B] =
from(XI > par(id[A], B.awaitPosFst))
def both[A, B](using A: Junction.Positive[A], B: Junction.Positive[B]): Junction.Positive[A |*| B] =
from(par(fork, id) > IXI > par(A.awaitPosFst, B.awaitPosFst))
def delegateToEither[A, B](using A: Junction.Positive[A], B: Junction.Positive[B]): Junction.Positive[A |+| B] =
from( distributeL[Done, A, B] > |+|.bimap(A.awaitPosFst, B.awaitPosFst) )
def delayEither[A, B](using A: Junction.Positive[A], B: Junction.Positive[B]): Junction.Positive[A |+| B] =
from( delayEitherUntilDone > |+|.bimap(A.awaitPosFst, B.awaitPosFst) )
def delegateToChosen[A, B](using A: Junction.Positive[A], B: Junction.Positive[B]): Junction.Positive[A |&| B] =
from( coFactorL[Done, A, B] > |&|.bimap(A.awaitPosFst, B.awaitPosFst) )
def delayChoice[A, B](using A: Junction.Positive[A], B: Junction.Positive[B]): Junction.Positive[A |&| B] =
from( delayChoiceUntilDone > |&|.bimap(A.awaitPosFst, B.awaitPosFst) )
def rec[F[_]](using F: Junction.Positive[F[Rec[F]]]): Junction.Positive[Rec[F]] =
from(par(id, unpack) > F.awaitPosFst > pack)
def rec[F[_]](using F: ∀[λ[x => Junction.Positive[F[x]]]]): Junction.Positive[Rec[F]] =
rec(using F[Rec[F]])
def rec[F[_]](f: Junction.Positive[Rec[F]] => Junction.Positive[F[Rec[F]]]): Junction.Positive[Rec[F]] =
from(dsl.rec(g => par(id, unpack) > f(from(g)).awaitPosFst > pack))
def insideInversion[A](using A: Junction.Positive[A]): Junction.Positive[-[A]] =
Junction.Positive.from {
λ { case d |*| na =>
demandTogether(dii(d) |*| na)
.contramap[A](λ { a =>
val nd |*| d = constant(forevert[Done])
nd |*| A.awaitPos(d |*| a)
})
}
}
}
object Negative {
def apply[A](using A: Junction.Negative[A]): Junction.Negative[A] =
A
def from[A](await: A -⚬ (Need |*| A)): Junction.Negative[A] =
new Junction.Negative[A] {
override def awaitNegFst: A -⚬ (Need |*| A) =
await
}
given junctionNeed: Junction.Negative[Need] =
from(joinNeed)
def byFst[A, B](using A: Junction.Negative[A]): Junction.Negative[A |*| B] =
from(par(A.awaitNegFst, id[B]) > assocLR)
def bySnd[A, B](using B: Junction.Negative[B]): Junction.Negative[A |*| B] =
from(par(id[A], B.awaitNegFst) > XI)
def both[A, B](using A: Junction.Negative[A], B: Junction.Negative[B]): Junction.Negative[A |*| B] =
from(par(A.awaitNegFst, B.awaitNegFst) > IXI > par(forkNeed, id))
def delegateToEither[A, B](using A: Junction.Negative[A], B: Junction.Negative[B]): Junction.Negative[A |+| B] =
from( |+|.bimap(A.awaitNegFst, B.awaitNegFst) > factorL )
def delayEither[A, B](using A: Junction.Negative[A], B: Junction.Negative[B]): Junction.Negative[A |+| B] =
from( |+|.bimap(A.awaitNegFst, B.awaitNegFst) > delayEitherUntilNeed )
def delegateToChosen[A, B](using A: Junction.Negative[A], B: Junction.Negative[B]): Junction.Negative[A |&| B] =
from( |&|.bimap(A.awaitNegFst, B.awaitNegFst) > coDistributeL )
def delayChoice[A, B](using A: Junction.Negative[A], B: Junction.Negative[B]): Junction.Negative[A |&| B] =
from( |&|.bimap(A.awaitNegFst, B.awaitNegFst) > delayChoiceUntilNeed )
def rec[F[_]](using F: Junction.Negative[F[Rec[F]]]): Junction.Negative[Rec[F]] =
from(unpack[F] > F.awaitNegFst > par(id, pack[F]))
def rec[F[_]](using F: ∀[λ[x => Junction.Negative[F[x]]]]): Junction.Negative[Rec[F]] =
rec(using F[Rec[F]])
def rec[F[_]](f: Junction.Negative[Rec[F]] => Junction.Negative[F[Rec[F]]]): Junction.Negative[Rec[F]] =
from(dsl.rec(g => unpack > f(from(g)).awaitNegFst > par(id, pack)))
def insideInversion[A](using A: Junction.Negative[A]): Junction.Negative[-[A]] =
Junction.Negative.from {
λ { na =>
na.contramap[-[Need] |*| A](λ { case nn |*| a =>
val n |*| a1 = A.awaitNeg(a)
returning(a, n supplyTo nn)
}) |> demandSeparately > fst(die)
}
}
}
/** [[Positive]] junction can be made to await a negative (i.e. [[Need]]) signal,
* by inverting the signal ([[lInvertSignal]]) and awaiting the inverted positive signal.
*/
def invert[A](A: Positive[A]): Negative[A] =
new Negative[A] {
override def awaitNegFst: A -⚬ (Need |*| A) =
id [ A ]
./>(introFst(lInvertSignal)) .to[ (Need |*| Done) |*| A ]
./>(assocLR) .to[ Need |*| (Done |*| A) ]
./>.snd(A.awaitPosFst) .to[ Need |*| A ]
}
/** [[Negative]] junction can be made to await a positive (i.e. [[Done]]) signal,
* by inverting the signal ([[rInvertSignal]]) and awaiting the inverted negative signal.
*/
def invert[A](A: Negative[A]): Positive[A] =
new Positive[A] {
override def awaitPosFst: (Done |*| A) -⚬ A =
id [ Done |*| A ]
./>.snd(A.awaitNegFst) .to[ Done |*| (Need |*| A) ]
./>(assocRL) .to[ (Done |*| Need) |*| A ]
./>(elimFst(rInvertSignal)) .to[ A ]
}
}
object Signaling {
/** Represents ''a'' way how `A` can produce a positive signal (i.e. [[Ping]] or [[Done]]). */
trait Positive[A] {
def notifyPosFst: A -⚬ (Ping |*| A)
def notifyPosSnd: A -⚬ (A |*| Ping) =
notifyPosFst > swap
def signalPosFst: A -⚬ (Done |*| A) =
notifyPosFst > par(strengthenPing, id)
def signalPosSnd: A -⚬ (A |*| Done) =
signalPosFst > swap
/** Alias for [[signalPosFst]]. */
def signalPos: A -⚬ (Done |*| A) =
signalPosFst
/** Alias for [[signalPosSnd]]. */
def signalDone: A -⚬ (A |*| Done) =
signalPosSnd
def law_signalIdentity: Equal[A -⚬ (RTerminus |*| A)] =
Equal(
signalPosFst > par(delayIndefinitely, id),
id[A] > introFst(done > delayIndefinitely),
)
def law_awaitComposition: Equal[A -⚬ (Done |*| (Done |*| A))] =
Equal(
signalPosFst > par(id, signalPosFst),
signalPosFst > par(fork, id) > assocLR,
)
}
/** Represents ''a'' way how `A` can produce a negative signal (i.e. [[Pong]] or [[Need]]). */
trait Negative[A] {
def notifyNegFst: (Pong |*| A) -⚬ A
def notifyNegSnd: (A |*| Pong) -⚬ A =
swap > notifyNegFst
def signalNegFst: (Need |*| A) -⚬ A =
par(strengthenPong, id) > notifyNegFst
def signalNegSnd: (A |*| Need) -⚬ A =
swap > signalNegFst
/** Alias for [[signalNegFst]]. */
def signalNeg: (Need |*| A) -⚬ A =
signalNegFst
def law_signalIdentity: Equal[(LTerminus |*| A) -⚬ A] =
Equal(
par(regressInfinitely, id) > signalNegFst,
id[LTerminus |*| A] > elimFst(regressInfinitely > need),
)
def law_signalComposition: Equal[(Need |*| (Need |*| A)) -⚬ A] =
Equal(
par(id, signalNegFst) > signalNegFst,
assocRL > par(forkNeed, id) > signalNegFst,
)
}
object Positive {
def from[A](notifyFst: A -⚬ (Ping |*| A)): Signaling.Positive[A] =
new Signaling.Positive[A] {
override def notifyPosFst: A -⚬ (Ping |*| A) =
notifyFst
}
given signalingDone: Signaling.Positive[Done] =
from(notifyDoneL)
given Signaling.Positive[Ping] =
from(forkPing)
def byFst[A, B](using A: Signaling.Positive[A]): Signaling.Positive[A |*| B] =
from(par(A.notifyPosFst, id[B]) > assocLR)
def bySnd[A, B](using B: Signaling.Positive[B]): Signaling.Positive[A |*| B] =
from(par(id[A], B.notifyPosFst) > XI)
def both[A, B](using A: Signaling.Positive[A], B: Signaling.Positive[B]): Signaling.Positive[A |*| B] =
from(par(A.notifyPosFst, B.notifyPosFst) > IXI > par(joinPing, id))
/** Signals when it is decided which side of the [[|+|]] is present. */
given either[A, B]: Signaling.Positive[A |+| B] =
from(dsl.notifyEither[A, B])
def either[A, B](A: Signaling.Positive[A], B: Signaling.Positive[B]): Signaling.Positive[A |+| B] =
from(dsl.either(A.notifyPosFst > snd(injectL), B.notifyPosFst > snd(injectR)))
def rec[F[_]](using F: Positive[F[Rec[F]]]): Positive[Rec[F]] =
from(unpack > F.notifyPosFst > par(id, pack))
def rec[F[_]](using F: ∀[λ[x => Positive[F[x]]]]): Positive[Rec[F]] =
rec(using F[Rec[F]])
def rec[F[_]](f: Positive[Rec[F]] => Positive[F[Rec[F]]]): Positive[Rec[F]] =
from(dsl.rec(g => unpack > f(from(g)).notifyPosFst > par(id, pack)))
}
object Negative {
def from[A](notifyFst: (Pong |*| A) -⚬ A): Signaling.Negative[A] =
new Signaling.Negative[A] {
override def notifyNegFst: (Pong |*| A) -⚬ A =
notifyFst
}
given signalingNeed: Signaling.Negative[Need] =
from(notifyNeedL)
given Signaling.Negative[Pong] =
from(forkPong)
def byFst[A, B](using A: Signaling.Negative[A]): Signaling.Negative[A |*| B] =
from(assocRL > fst(A.notifyNegFst))
def bySnd[A, B](using B: Signaling.Negative[B]): Signaling.Negative[A |*| B] =
from(XI > par(id[A], B.notifyNegFst))
def both[A, B](using A: Signaling.Negative[A], B: Signaling.Negative[B]): Signaling.Negative[A |*| B] =
from(par(joinPong, id) > IXI > par(A.notifyNegFst, B.notifyNegFst))
/** Signals when the choice is made between [[A]] and [[B]]. */
given choice[A, B]: Signaling.Negative[A |&| B] =
from(dsl.notifyChoice[A, B])
def choice[A, B](A: Signaling.Negative[A], B: Signaling.Negative[B]): Signaling.Negative[A |&| B] =
from(dsl.choice(snd(chooseL) > A.notifyNegFst, snd(chooseR) > B.notifyNegFst))
def rec[F[_]](using F: Negative[F[Rec[F]]]): Negative[Rec[F]] =
from(par(id, unpack) > F.notifyNegFst > pack)
def rec[F[_]](using F: ∀[λ[x => Negative[F[x]]]]): Negative[Rec[F]] =
rec(using F[Rec[F]])
def rec[F[_]](f: Negative[Rec[F]] => Negative[F[Rec[F]]]): Negative[Rec[F]] =
from(dsl.rec(g => par(id, unpack) > f(from(g)).notifyNegFst > pack))
}
/** [[Signaling.Positive]] can be made to produce a negative (i.e. [[Need]]) signal,
* by inverting the produced signal (via [[rInvertSignal]]).
*/
def invert[A](A: Positive[A]): Negative[A] =
new Negative[A] {
override def notifyNegFst: (Pong |*| A) -⚬ A =
id [ Pong |*| A ]
./>.snd(A.notifyPosFst) .to[ Pong |*| (Ping |*| A) ]
./>(assocRL) .to[ (Pong |*| Ping) |*| A ]
./>(elimFst(swap > rInvertPingPong)) .to[ A ]
}
/** [[Signaling.Negative]] can be made to produce a positive (i.e. [[Done]]) signal,
* by inverting the produced signal (via [[lInvertSignal]]).
*/
def invert[A](A: Negative[A]): Positive[A] =
new Positive[A] {
override def notifyPosFst: A -⚬ (Ping |*| A) =
id [ A ]
./>(introFst(lInvertPongPing > swap)) .to[ (Ping |*| Pong) |*| A ]
./>(assocLR) .to[ Ping |*| (Pong |*| A) ]
./>.snd(A.notifyNegFst) .to[ Ping |*| A ]
}
}
object SignalingJunction {
/** Witnesses that [[A]] can both produce and await a positive (i.e. [[Done]]) signal. */
trait Positive[A] extends Signaling.Positive[A] with Junction.Positive[A] {
def delayUsing(f: Done -⚬ Done): A -⚬ A =
signalPos > par(f, id) > awaitPos
/** Expresses that awaiting one's own signal does not introduce a new causal dependency, i.e. that
* the point of awaiting in [[A]] is causally dependent on the point of signaling in [[A]].
*/
def law_positiveSignalThenAwaitIsId: Equal[A -⚬ A] =
Equal[A -⚬ A](
signalPos > awaitPos,
id[A],
)
/** Expresses that awaiting a signal and then signaling does not speed up the original signal, i.e. that
* the point of signaling in [[A]] is causally dependent on the point of awaiting in [[A]].
*/
def law_positiveAwaitThenSignal: Equal[(Done |*| A) -⚬ (Done |*| A)] =
Equal(
awaitPos > signalPos,
par(fork, id) > assocLR > par(id, awaitPos > signalPos) > assocRL > par(join, id),
)
}
/** Witnesses that [[A]] can both produce and await a negative (i.e. [[Need]]) signal. */
trait Negative[A] extends Signaling.Negative[A] with Junction.Negative[A] {
def delayUsing(f: Need -⚬ Need): A -⚬ A =
awaitNeg > par(f, id) > signalNeg
/** Expresses that awaiting one's own signal does not introduce a new causal dependency, i.e. that
* the point of awaiting in [[A]] is causally dependent on the point of signaling in [[A]].
*/
def law_negativeAwaitThenSignalIsId: Equal[A -⚬ A] =
Equal[A -⚬ A](
awaitNeg > signalNeg,
id[A],
)
/** Expresses that awaiting a signal and then signaling does not speed up the original signal, i.e. that
* the point of signaling in [[A]] is causally dependent on the point of awaiting in [[A]].
*/
def law_negativeSignalThenAwait: Equal[(Need |*| A) -⚬ (Need |*| A)] =
Equal(
signalNeg > awaitNeg,
par(joinNeed, id) > assocLR > par(id, signalNeg > awaitNeg) > assocRL > par(forkNeed, id),
)
}
object Positive {
def from[A](s: Signaling.Positive[A], j: Junction.Positive[A]): SignalingJunction.Positive[A] =
new SignalingJunction.Positive[A] {
override def notifyPosFst: A -⚬ (Ping |*| A) = s.notifyPosFst
override def awaitPosFst: (Done |*| A) -⚬ A = j.awaitPosFst
}
given signalingJunctionPositiveDone: SignalingJunction.Positive[Done] =
Positive.from(
Signaling.Positive.signalingDone,
Junction.Positive.junctionDone,
)
def byFst[A, B](using A: Positive[A]): Positive[A |*| B] =
Positive.from(
Signaling.Positive.byFst[A, B],
Junction.Positive.byFst[A, B],
)
def bySnd[A, B](using B: Positive[B]): Positive[A |*| B] =
Positive.from(
Signaling.Positive.bySnd[A, B],
Junction.Positive.bySnd[A, B],
)
def both[A, B](using A: Positive[A], B: Positive[B]): Positive[A |*| B] =
Positive.from(
Signaling.Positive.both[A, B],
Junction.Positive.both[A, B],
)
/** Signals when the `|+|` is decided, awaiting delays (the publication of) the decision and thed is delegated
* to the respective side.
*/
def eitherPos[A, B](using A: Junction.Positive[A], B: Junction.Positive[B]): Positive[A |+| B] =
Positive.from(
Signaling.Positive.either[A, B],
Junction.Positive.delayEither[A, B],
)
/** Signals when the `|+|` is decided, awaiting delays (the publication of) the decision and then is delegated
* to the respective side, which awaits an inversion of the original signal.
*/
def eitherNeg[A, B](using A: Junction.Negative[A], B: Junction.Negative[B]): Positive[A |+| B] =
Positive.from(
Signaling.Positive.either[A, B],
Junction.Positive.delayEither(using
Junction.invert(A),
Junction.invert(B),
),
)
def rec[F[_]](using F: Positive[F[Rec[F]]]): Positive[Rec[F]] =
Positive.from(
Signaling.Positive.rec(using F),
Junction.Positive.rec(using F),
)
def rec[F[_]](using F: ∀[λ[x => Positive[F[x]]]]): Positive[Rec[F]] =
rec(using F[Rec[F]])
def rec[F[_]](
f: Signaling.Positive[Rec[F]] => Signaling.Positive[F[Rec[F]]],
g: Junction.Positive[Rec[F]] => Junction.Positive[F[Rec[F]]],
): SignalingJunction.Positive[Rec[F]] =
from(Signaling.Positive.rec(f), Junction.Positive.rec(g))
}
object Negative {
def from[A](s: Signaling.Negative[A], j: Junction.Negative[A]): SignalingJunction.Negative[A] =
new SignalingJunction.Negative[A] {
override def notifyNegFst: (Pong |*| A) -⚬ A = s.notifyNegFst
override def awaitNegFst: A -⚬ (Need |*| A) = j.awaitNegFst
}
given SignalingJunction.Negative[Need] =
Negative.from(
Signaling.Negative.signalingNeed,
Junction.Negative.junctionNeed,
)
def byFst[A, B](using A: Negative[A]): Negative[A |*| B] =
Negative.from(
Signaling.Negative.byFst[A, B],
Junction.Negative.byFst[A, B],
)
def bySnd[A, B](using B: Negative[B]): Negative[A |*| B] =
Negative.from(
Signaling.Negative.bySnd[A, B],
Junction.Negative.bySnd[A, B],
)
def both[A, B](using A: Negative[A], B: Negative[B]): Negative[A |*| B] =
Negative.from(
Signaling.Negative.both[A, B],
Junction.Negative.both[A, B],
)
/** Signals when the choice (`|&|`) is made, awaiting delays the choice and then is delegated to the chosen side. */
def choiceNeg[A, B](using A: Junction.Negative[A], B: Junction.Negative[B]): Negative[A |&| B] =
Negative.from(
Signaling.Negative.choice[A, B],
Junction.Negative.delayChoice[A, B],
)
/** Signals when the choice (`|&|`) is made, awaiting delays the choice and then is delegated to the chosen side,
* which awaits inversion of the original signal.
*/
def choicePos[A, B](using A: Junction.Positive[A], B: Junction.Positive[B]): Negative[A |&| B] =
Negative.from(
Signaling.Negative.choice[A, B],
Junction.Negative.delayChoice(using
Junction.invert(A),
Junction.invert(B),
),
)
def rec[F[_]](using F: Negative[F[Rec[F]]]): Negative[Rec[F]] =
Negative.from(
Signaling.Negative.rec(using F),
Junction.Negative.rec(using F),
)
def rec[F[_]](using F: ∀[λ[x => Negative[F[x]]]]): Negative[Rec[F]] =
rec(using F[Rec[F]])
def rec[F[_]](
f: Signaling.Negative[Rec[F]] => Signaling.Negative[F[Rec[F]]],
g: Junction.Negative[Rec[F]] => Junction.Negative[F[Rec[F]]],
): SignalingJunction.Negative[Rec[F]] =
from(Signaling.Negative.rec(f), Junction.Negative.rec(g))
}
}
def notifyPosFst[A](using A: Signaling.Positive[A]): A -⚬ (Ping |*| A) =
A.notifyPosFst
def notifyPosSnd[A](using A: Signaling.Positive[A]): A -⚬ (A |*| Ping) =
A.notifyPosSnd
def notifyNegFst[A](using A: Signaling.Negative[A]): (Pong |*| A) -⚬ A =
A.notifyNegFst
def notifyNegSnd[A](using A: Signaling.Negative[A]): (A |*| Pong) -⚬ A =
A.notifyNegSnd
def signalPosFst[A](using A: Signaling.Positive[A]): A -⚬ (Done |*| A) =
A.signalPosFst
def signalPosSnd[A](using A: Signaling.Positive[A]): A -⚬ (A |*| Done) =
A.signalPosSnd
def signalDone[A](using A: Signaling.Positive[A]): A -⚬ (A |*| Done) =
signalPosSnd
def signalNegFst[A](using A: Signaling.Negative[A]): (Need |*| A) -⚬ A =
A.signalNegFst
def signalNegSnd[A](using A: Signaling.Negative[A]): (A |*| Need) -⚬ A =
A.signalNegSnd
def awaitPingFst[A](using A: Deferrable.Positive[A]): (Ping |*| A) -⚬ A =
A.awaitPingFst
def awaitPingSnd[A](using A: Deferrable.Positive[A]): (A |*| Ping) -⚬ A =
A.awaitPingSnd
def awaitPongFst[A](using A: Deferrable.Negative[A]): A -⚬ (Pong |*| A) =
A.awaitPongFst
def awaitPongSnd[A](using A: Deferrable.Negative[A]): A -⚬ (A |*| Pong) =
A.awaitPongSnd
def awaitPosFst[A](using A: Junction.Positive[A]): (Done |*| A) -⚬ A =
A.awaitPosFst
def awaitPosSnd[A](using A: Junction.Positive[A]): (A |*| Done) -⚬ A =
A.awaitPosSnd
def awaitNegFst[A](using A: Junction.Negative[A]): A -⚬ (Need |*| A) =
A.awaitNegFst
def awaitNegSnd[A](using A: Junction.Negative[A]): A -⚬ (A |*| Need) =
A.awaitNegSnd
def detain[A](using A: Junction.Positive[A]): A -⚬ Detained[A] =
A.detain
def defer[A](using A: Deferrable.Positive[A]): A -⚬ Deferred[A] =
A.defer
def delayUsing[A](f: Done -⚬ Done)(using A: SignalingJunction.Positive[A]): A -⚬ A =
A.delayUsing(f)
def delayUsing[A](f: Need -⚬ Need)(using A: SignalingJunction.Negative[A]): A -⚬ A =
A.delayUsing(f)
/** Obstructs interaction on the out-port (i.e. from the right) until [[Ping]] is received. */
def blockOutportUntilPing[A]: (Ping |*| A) -⚬ A =
injectLOnPing > either(id, id)
/** Obstructs interaction on the in-port (i.e. from the left) until [[Pong]] is received. */
def blockInportUntilPong[A]: A -⚬ (Pong |*| A) =
choice(id, id) > chooseLOnPong
/** Alias for [[sequence_PP]]. */
def sequence[A: Signaling.Positive, B: Deferrable.Positive]: (A |*| B) -⚬ (A |*| B) =
sequence_PP
def sequence_PP[A, B](using A: Signaling.Positive[A], B: Deferrable.Positive[B]): (A |*| B) -⚬ (A |*| B) =
fst(notifyPosSnd) > assocLR > snd(awaitPingFst)
def sequence_PN[A, B](using A: Signaling.Positive[A], B: Deferrable.Negative[B]): (A |*| B) -⚬ (A |*| B) =
fst(notifyPosSnd) > assocLR > snd(Deferrable.invert(B).awaitPingFst)
def sequence_NP[A, B](using A: Signaling.Negative[A], B: Deferrable.Positive[B]): (A |*| B) -⚬ (A |*| B) =
fst(Signaling.invert(A).notifyPosSnd) > assocLR > snd(awaitPingFst)
def sequence_NN[A, B](using A: Signaling.Negative[A], B: Deferrable.Negative[B]): (A |*| B) -⚬ (A |*| B) =
snd(awaitPongFst) > assocRL > fst(notifyNegSnd)
extension [A](a: $[A])(using LambdaContext) {
def sequence[B](b: $[B])(using A: Signaling.Positive[A], B: Deferrable.Positive[B]): $[A |*| B] =
(a |*| b) |> sequence_PP
def sequence[B](f: Done -⚬ B)(using A: Signaling.Positive[A]): $[A |*| B] =
a |> signalPosSnd |> snd(f)
def sequenceAfter[B](b: $[B])(using A: Deferrable.Positive[A], B: Signaling.Positive[B]): $[A |*| B] =
(b |*| a) |> sequence_PP[B, A] |> swap
infix def waitFor(b: $[Done])(using A: Junction.Positive[A]): $[A] =
(a |*| b) |> awaitPosSnd
infix def deferUntil(b: $[Ping])(using A: Deferrable.Positive[A]): $[A] =
(a |*| b) |> awaitPingSnd
/** Obstructs further interaction until a [[Ping]] is received. */
infix def blockUntil(b: $[Ping]): $[A] =
blockOutportUntilPing(b |*| a)
def raceAgainst[B](using SourcePos)(b: $[B])(using
Signaling.Positive[A],
Signaling.Positive[B],
): $[(A |*| B) |+| (A |*| B)] =
lib.race[A, B](a |*| b)
def raceAgainstInv[B](using SourcePos)(b: ??[B])(using
Signaling.Positive[A],
Signaling.Negative[B],
): ($[A |+| A], ??[B]) =
(a |> notifyPosFst) match {
case ping |*| a =>
(notifyNegFst >| b) match {
case pong |*| b =>
( switch ( racePair(ping |*| pong.asInput(lInvertPongPing)) )
.is { case InL(?(_)) => InL(a) }
.is { case InR(?(_)) => InR(a) }
.end
, b
)
}
}
infix def raceAgainstInvWith[B, C](using SourcePos)(b: ??[B])(using
Signaling.Positive[A],
Signaling.Negative[B],
)(f: LambdaContext ?=> Either[($[A], ??[B]), ($[A], ??[B])] => $[C]): $[C] = {
val (aa, bb) = raceAgainstInv[B](b)
switch ( aa )
.is { case InL(a) => f(Left((a, bb))) }
.is { case InR(a) => f(Right((a, bb))) }
.end
}
}
extension [A](a: ??[A]) {
def raceAgainstStraight[B](using SourcePos, LambdaContext)(b: $[B])(using
Signaling.Negative[A],
Signaling.Positive[B],
): (??[A |&| A], $[B]) =
(notifyNegFst >| a) match {
case pong |*| a =>
(b |> notifyPosFst) match {
case ping |*| b =>
((selectPair >| (pong |*| ping.asOutput(rInvertPingPong))) choose {
case Left(one) => (chooseL >| a) alsoElim one
case Right(one) => (chooseR >| a) alsoElim one
}, b)
}
}
infix def raceWith[B, C](using SourcePos, LambdaContext)(b: $[B])(using
Signaling.Negative[A],
Signaling.Positive[B],
)(f: LambdaContext ?=> Either[(??[A], $[B]), (??[A], $[B])] => ??[C]): ??[C] = {
val (aa, bb) = raceAgainstStraight[B](b)
aa choose {
case Left(a) => f(Left((a, bb)))
case Right(a) => f(Right((a, bb)))
}
}
def raceAgainst[B](using SourcePos, LambdaContext)(b: ??[B])(using
Signaling.Negative[A],
Signaling.Negative[B],
): ??[(A |*| B) |&| (A |*| B)] =
lib.select[A, B] >| (a |*| b)
}
def when[A](trigger: $[Done])(f: Done -⚬ A)(using LambdaContext): $[A] =
trigger |> f
/** Races the two [[Done]] signals and
* - produces left if the first signal wins, in which case it returns the second signal that still
* has to be awaited;
* - produces right if the second signal wins, in which case it returns the first signal that still
* has to be awaited.
* It is biased to the left: if both signals have arrived by the time of inquiry, returns left.
*/
def raceDone: (Done |*| Done) -⚬ (Done |+| Done) =
id [ Done |*| Done ]
.>(par(notifyDoneL, notifyDoneL)) .to[ (Ping |*| Done) |*| (Ping |*| Done) ]
.>(IXI) .to[ (Ping |*| Ping) |*| (Done |*| Done) ]
.>(par(racePair, join)) .to[ ( One |+| One ) |*| Done ]
.>(distributeR) .to[ (One |*| Done) |+| (One |*| Done) ]
.>(|+|.bimap(elimFst, elimFst)) .to[ Done |+| Done ]
/** Races two [[Need]] signals, i.e. signals traveling in the negative direction (i.e. opposite the `-⚬` arrow).
* Based on which [[Need]] signal from the out-port wins the race,
* selects one of the two [[Need]] signals from the in-port:
* - If the first signal from the out-port wins the race, selects the left signal from the in-port
* and pipes to it the remaining (i.e. the right) signal from the out-port.
* - If the second signal from the out-port wins the race, selects the right signal from the in-port
* and pipes to it the reamining (i.e. the left) signal from the out-port.
* It is biased to the left: if both signals from the out-port have arrived by the time of inquiry,
* selects the left signal from the in-port.
*/
def selectNeed: (Need |&| Need) -⚬ (Need |*| Need) =
id [ Need |*| Need ]
./<(par(notifyNeedL, notifyNeedL)) .from[ (Pong |*| Need) |*| (Pong |*| Need) ]
./<(IXI) .from[ (Pong |*| Pong) |*| (Need |*| Need) ]
./<(par(selectPair, joinNeed)) .from[ ( One |&| One ) |*| Need ]
./<(coDistributeR) .from[ (One |*| Need) |&| (One |*| Need) ]
./<(|&|.bimap(introFst, introFst)) .from[ Need |&| Need ]
def raceBy[A, B](
notifyA: A -⚬ (Ping |*| A),
notifyB: B -⚬ (Ping |*| B),
): (A |*| B) -⚬ ((A |*| B) |+| (A |*| B)) =
id [ A |*| B ]
./>(par(notifyA, notifyB)) .to[ (Ping |*| A) |*| (Ping |*| B) ]
./>(IXI) .to[ (Ping |*| Ping) |*| (A |*| B) ]
./>.fst(racePair) .to[ ( One |+| One ) |*| (A |*| B) ]
./>(distributeR) .to[ (One |*| (A |*| B)) |+| (One |*| (A |*| B)) ]
./>(|+|.bimap(elimFst, elimFst)) .to[ (A |*| B) |+| (A |*| B) ]
def raceBy[A](
notify: A -⚬ (Ping |*| A),
): (A |*| A) -⚬ ((A |*| A) |+| (A |*| A)) =
raceBy(notify, notify)
def race[A, B](using
A: Signaling.Positive[A],
B: Signaling.Positive[B],
): (A |*| B) -⚬ ((A |*| B) |+| (A |*| B)) =
raceBy(A.notifyPosFst, B.notifyPosFst)
def raceSwitch[A: Signaling.Positive, B: Signaling.Positive, C](
caseFstWins: (A |*| B) -⚬ C,
caseSndWins: (A |*| B) -⚬ C,
): (A |*| B) -⚬ C =
race[A, B] > either(caseFstWins, caseSndWins)
def raceWithL[X, A: Signaling.Positive, B: Signaling.Positive, C](
caseFstWins: (X |*| (A |*| B)) -⚬ C,
caseSndWins: (X |*| (A |*| B)) -⚬ C,
): (X |*| (A |*| B)) -⚬ C =
par(id, race[A, B]) > distributeL > either(caseFstWins, caseSndWins)
def raceWithR[A: Signaling.Positive, B: Signaling.Positive, Y, C](
caseFstWins: ((A |*| B) |*| Y) -⚬ C,
caseSndWins: ((A |*| B) |*| Y) -⚬ C,
): ((A |*| B) |*| Y) -⚬ C =
par(race[A, B], id) > distributeR > either(caseFstWins, caseSndWins)
def raceAgainstDoneL[A](using A: SignalingJunction.Positive[A]): (Done |*| A) -⚬ (A |+| A) =
id [ Done |*| A ]
./>.snd(A.signalPos).>(assocRL) .to[ (Done |*| Done) |*| A ]
./>.fst(raceDone) .to[ (Done |+| Done) |*| A ]
./>(distributeR) .to[ (Done |*| A) |+| (Done |*| A) ]
./>(|+|.bimap(A.awaitPos, A.awaitPos)) .to[ A |+| A ]
def raceAgainstDoneR[A](using A: SignalingJunction.Positive[A]): (A |*| Done) -⚬ (A |+| A) =
swap > raceAgainstDoneL > |+|.swap
def selectBy[A, B](
notifyA: ((Pong |*| A) -⚬ A),
notifyB: ((Pong |*| B) -⚬ B),
): ((A |*| B) |&| (A |*| B)) -⚬ (A |*| B) =
id [ (A |*| B) |&| (A |*| B) ]
./>(|&|.bimap(introFst, introFst)) .to[ (One |*| (A |*| B)) |&| (One |*| (A |*| B)) ]
./>(coDistributeR) .to[ ( One |&| One ) |*| (A |*| B) ]
./>.fst(selectPair) .to[ (Pong |*| Pong) |*| (A |*| B) ]
./>(IXI) .to[ (Pong |*| A) |*| (Pong |*| B) ]
./>(par(notifyA, notifyB)) .to[ A |*| B ]
def selectBy[A](
notify: (Pong |*| A) -⚬ A,
): ((A |*| A) |&| (A |*| A)) -⚬ (A |*| A) =
selectBy(notify, notify)
def select[A, B](using
A: Signaling.Negative[A],
B: Signaling.Negative[B],
): ((A |*| B) |&| (A |*| B)) -⚬ (A |*| B) =
selectBy(A.notifyNegFst, B.notifyNegFst)
def selectWithL[Z, X, A: Signaling.Negative, B: Signaling.Negative](
caseFstWins: Z -⚬ (X |*| (A |*| B)),
caseSndWins: Z -⚬ (X |*| (A |*| B)),
): Z -⚬ (X |*| (A |*| B)) =
choice(caseFstWins, caseSndWins) > coDistributeL > par(id, select[A, B])
def selectWithR[Z, A: Signaling.Negative, B: Signaling.Negative, Y](
caseFstWins: Z -⚬ ((A |*| B) |*| Y),
caseSndWins: Z -⚬ ((A |*| B) |*| Y),
): Z -⚬ ((A |*| B) |*| Y) =
choice(caseFstWins, caseSndWins) > coDistributeR > par(select[A, B], id)
def select[Z, A: Signaling.Negative, B: Signaling.Negative](
caseFstWins: Z -⚬ (A |*| B),
caseSndWins: Z -⚬ (A |*| B),
): Z -⚬ (A |*| B) =
choice(caseFstWins, caseSndWins) > select[A, B]
def selectAgainstL[A](using A: SignalingJunction.Negative[A]): (A |&| A) -⚬ (Need |*| A) =
id [ Need |*| A ]
./<.snd(A.signalNeg)./<(assocLR) .from[ (Need |*| Need) |*| A ]
./<.fst(selectNeed) .from[ (Need |&| Need) |*| A ]
./<(coDistributeR) .from[ (Need |*| A) |&| (Need |*| A) ]
./<(|&|.bimap(A.awaitNeg, A.awaitNeg)) .from[ A |&| A ]
def selectAgainstR[A](using A: SignalingJunction.Negative[A]): (A |&| A) -⚬ (A |*| Need) =
|&|.swap > selectAgainstL > swap
def racePreferred[A, B](using
A: Signaling.Positive[A],
B: Signaling.Positive[B],
): (Ping |*| (A |*| B)) -⚬ ((A |*| B) |+| (A |*| B)) =
λ { case p |*| (a |*| b) =>
switch ( race[Ping, A](p |*| a) )
.is { case InL(?(_) |*| a) => InL(a |*| b) }
.is { case InR(?(_) |*| a) => race[A, B](a |*| b) }
.end
}
def raceHandicap[A, B, C](f: (Ping |*| B) -⚬ C)(using
A: Signaling.Positive[A],
C: Signaling.Positive[C],
): (A |*| (Ping |*| B)) -⚬ ((A |*| B) |+| ((A |*| C) |+| (A |*| C))) =
λ { case a |*| (p |*| b) =>
switch ( race[A, Ping](a |*| p) )
.is { case InL(a |*| ?(_)) => InL(a |*| b) }
.is { case InR(a |*| p) => InR(race[A, C](a |*| f(p |*| b))) }
.end
}
trait Getter[S, A] { self =>
def getL[B](that: Getter[A, B])(using B: Cosemigroup[B]): S -⚬ (B |*| S)
def extendJunction(using Junction.Positive[A]): Junction.Positive[S]
def getL(using A: Cosemigroup[A]): S -⚬ (A |*| S) =
getL(Getter.identity[A])
def getR(using A: Cosemigroup[A]): S -⚬ (S |*| A) =
getL > swap
def awaitFst(using Junction.Positive[A]): (Done |*| S) -⚬ S =
extendJunction.awaitPosFst
def awaitSnd(using Junction.Positive[A]): (S |*| Done) -⚬ S =
swap > awaitFst
infix def andThen[B](that: Getter[A, B]): Getter[S, B] =
new Getter[S, B] {
override def getL[C](next: Getter[B, C])(using C: Cosemigroup[C]): S -⚬ (C |*| S) =
self.getL(that andThen next)
override def extendJunction(using Junction.Positive[B]): Junction.Positive[S] =
self.extendJunction(using that.extendJunction)
}
infix def compose[T](that: Getter[T, S]): Getter[T, A] =
that andThen this
def |+|[T](that: Getter[T, A]): Getter[S |+| T, A] =
new Getter[S |+| T, A] {
override def getL[B](next: Getter[A, B])(using B: Cosemigroup[B]): (S |+| T) -⚬ (B |*| (S |+| T)) =
lib.|+|.bimap(self.getL(next), that.getL(next)) > factorL
override def extendJunction(using Junction.Positive[A]): Junction.Positive[S |+| T] =
new Junction.Positive[S |+| T] {
override def awaitPosFst: (Done |*| (S |+| T)) -⚬ (S |+| T) =
distributeL > lib.|+|.bimap(self.awaitFst, that.awaitFst)
}
}
}
object Getter {
def identity[A]: Getter[A, A] =
new Getter[A, A] {
override def getL[B](that: Getter[A, B])(using B: Cosemigroup[B]): A -⚬ (B |*| A) =
that.getL
override def getL(using A: Cosemigroup[A]): A -⚬ (A |*| A) =
A.split
override def andThen[B](that: Getter[A, B]): Getter[A, B] =
that
override def extendJunction(using A: Junction.Positive[A]): Junction.Positive[A] =
A
}
}
trait Lens[S, A] extends Getter[S, A] {
def modify[X, Y](f: (X |*| A) -⚬ (Y |*| A)): (X |*| S) -⚬ (Y |*| S)
def read[Y](f: A -⚬ (Y |*| A)): S -⚬ (Y |*| S) =
introFst[S] > modify[One, Y](elimFst > f)
def write[X](f: (X |*| A) -⚬ A): (X |*| S) -⚬ S =
modify[X, One](f > introFst) > elimFst
override def getL[B](that: Getter[A, B])(using B: Cosemigroup[B]): S -⚬ (B |*| S) =
read(that.getL)
override def extendJunction(using A: Junction.Positive[A]): Junction.Positive[S] =
new Junction.Positive[S] {
def awaitPosFst: (Done |*| S) -⚬ S = write(A.awaitPosFst)
}
infix def andThen[B](that: Lens[A, B]): Lens[S, B] =
new Lens[S, B] {
def modify[X, Y](f: (X |*| B) -⚬ (Y |*| B)): (X |*| S) -⚬ (Y |*| S) =
Lens.this.modify(that.modify(f))
}
def compose[T](that: Lens[T, S]): Lens[T, A] =
that andThen this
def |+|[T](that: Lens[T, A]): Lens[S |+| T, A] =
new Lens[S |+| T, A] {
def modify[X, Y](f: (X |*| A) -⚬ (Y |*| A)): (X |*| (S |+| T)) -⚬ (Y |*| (S |+| T)) =
distributeL[X, S, T] > lib.|+|.bimap(Lens.this.modify(f), that.modify(f)) > factorL
}
}
object Lens {
def rec[F[_]]: Lens[Rec[F], F[Rec[F]]] =
new Lens[Rec[F], F[Rec[F]]] {
def modify[X, Y](f: (X |*| F[Rec[F]]) -⚬ (Y |*| F[Rec[F]])): (X |*| Rec[F]) -⚬ (Y |*| Rec[F]) =
id[X |*| Rec[F]]
./>.snd(unpack)
./>(f)
./>.snd(pack)
}
}
trait Transportive[F[_]] extends Functor[F] {
def inL[A, B]: (A |*| F[B]) -⚬ F[A |*| B]
def outL[A, B]: F[A |*| B] -⚬ (A |*| F[B])
def inR[A, B]: (F[A] |*| B) -⚬ F[A |*| B] =
swap[F[A], B] > inL > lift(swap[B, A])
def outR[A, B]: F[A |*| B] -⚬ (F[A] |*| B) =
lift(swap[A, B]) > outL > swap[B, F[A]]
/** Alias for [[outL]]. */
def excludeFst[A, B]: F[A |*| B] -⚬ (A |*| F[B]) =
outL
/** Alias for [[outR]]. */
def excludeSnd[A, B]: F[A |*| B] -⚬ (F[A] |*| B) =
outR
/** Alias for [[inL]]. */
def includeFst[A, B]: (A |*| F[B]) -⚬ F[A |*| B] =
inL
/** Alias for [[inR]]. */
def includeSnd[A, B]: (F[A] |*| B) -⚬ F[A |*| B] =
inR
def getL[A](using A: Cosemigroup[A]): F[A] -⚬ (A |*| F[A]) =
lift(A.split) > outL
def getR[A](using A: Cosemigroup[A]): F[A] -⚬ (F[A] |*| A) =
getL[A] > swap
def lens[A]: Lens[F[A], A] = new Lens[F[A], A] {
def modify[X, Y](f: (X |*| A) -⚬ (Y |*| A)): (X |*| F[A]) -⚬ (Y |*| F[A]) =
inL > lift(f) > outL
}
}
object Transportive {
def apply[F[_]](using F: Transportive[F]): Transportive[F] =
F
/** Pair is covariant in the first argument. */
def fst[B]: Transportive[λ[x => x |*| B]] =
new Transportive[λ[x => x |*| B]] {
override val category: Category[-⚬] = dsl.category
def lift[A1, A2](f: A1 -⚬ A2): (A1 |*| B) -⚬ (A2 |*| B) = par(f, id)
def inL[A1, A2]: (A1 |*| (A2 |*| B)) -⚬ ((A1 |*| A2) |*| B) = assocRL
def outL[A1, A2]: ((A1 |*| A2) |*| B) -⚬ (A1 |*| (A2 |*| B)) = assocLR
}
/** Pair is covariant in the second argument. */
def snd[A]: Transportive[λ[x => A |*| x]] =
new Transportive[λ[x => A |*| x]] {
override val category: Category[-⚬] = dsl.category
def lift[B1, B2](f: B1 -⚬ B2): (A |*| B1) -⚬ (A |*| B2) = par(id, f)
def inL[B1, B2]: (B1 |*| (A |*| B2)) -⚬ (A |*| (B1 |*| B2)) =
assocRL[B1, A, B2] > dsl.fst(swap) > assocLR
def outL[B1, B2]: (A |*| (B1 |*| B2)) -⚬ (B1 |*| (A |*| B2)) =
assocRL[A, B1, B2] > dsl.fst(swap) > assocLR
}
}
type Id[A] = A
given Transportive[Id] with {
override val category: Category[-⚬] = dsl.category
def lift[A, B](f: A -⚬ B): Id[A] -⚬ Id[B] = f
def inL[A, B]: (A |*| Id[B]) -⚬ Id[A |*| B] = id
def outL[A, B]: Id[A |*| B] -⚬ (A |*| Id[B]) = id
}
object |+| {
def assocLR[A, B, C]: ((A |+| B) |+| C) -⚬ (A |+| (B |+| C)) =
either(either(injectL, andThen(injectL, injectR)), andThen(injectR, injectR))
def assocRL[A, B, C]: (A |+| (B |+| C)) -⚬ ((A |+| B) |+| C) =
either(andThen(injectL, injectL), either(andThen(injectR, injectL), injectR))
def bimap[A, B, C, D](f: A -⚬ B, g: C -⚬ D): (A |+| C )-⚬ (B |+| D) =
either(f > injectL, g > injectR)
def lmap[A, B, A1](f: A -⚬ A1): (A |+| B) -⚬ (A1 |+| B) =
either(f > injectL, injectR)
def rmap[A, B, B1](f: B -⚬ B1): (A |+| B) -⚬ (A |+| B1) =
either(injectL, f > injectR)
def swap[A, B]: (A |+| B) -⚬ (B |+| A) =
either(injectR, injectL)
def IXI[A, B, C, D]: ((A |+| B) |+| (C |+| D)) -⚬ ((A |+| C) |+| (B |+| D)) =
either(
either(injectL ∘ injectL, injectR ∘ injectL),
either(injectL ∘ injectR, injectR ∘ injectR),
)
def switchWithL[A, B, L, C](
caseLeft: (L |*| A) -⚬ C,
caseRight: (L |*| B) -⚬ C,
): (L |*| (A |+| B)) -⚬ C =
distributeL > either(caseLeft, caseRight)
def switchWithR[A, B, R, C](
caseLeft: (A |*| R) -⚬ C,
caseRight: (B |*| R) -⚬ C,
): ((A |+| B) |*| R) -⚬ C =
distributeR > either(caseLeft, caseRight)
/** Alias for [[notifyEither]]:
* Adds a [[Ping]] that fires when it is decided whether `A |+| B` actually contains the left side or the right side.
*/
def notify[A, B]: (A |+| B) -⚬ (Ping |*| (A |+| B)) =
notifyEither
/** Adds a [[Done]] that completes when it is decided whether `A |+| B` actually contains the left side or the right side. */
def signal[A, B]: (A |+| B) -⚬ (Done |*| (A |+| B)) =
notify > fst(strengthenPing)
/** Adds a [[Ping]] to the left case that fires when the [[|+|]] is decided. */
def notifyL[A, B]: (A |+| B) -⚬ ((Ping |*| A) |+| B) =
notify > distributeL > rmap(elimFst(dismissPing))
/** Adds a [[Ping]] to the right case that fires when the [[|+|]] is decided. */
def notifyR[A, B]: (A |+| B) -⚬ (A |+| (Ping |*| B)) =
notify > distributeL > lmap(elimFst(dismissPing))
/** Adds a [[Done]] to the left case that completes when the [[|+|]] is decided. */
def signalL[A, B]: (A |+| B) -⚬ ((Done |*| A) |+| B) =
notify > distributeL > bimap(fst(strengthenPing), elimFst(dismissPing))
/** Adds a [[Done]] to the right case that completes when the [[|+|]] is decided. */
def signalR[A, B]: (A |+| B) -⚬ (A |+| (Done |*| B)) =
notify > distributeL > bimap(elimFst(dismissPing), fst(strengthenPing))
val bifunctor: Bifunctor[|+|] =
new Bifunctor[|+|] {
override val category =
dsl.category
override def lift[A, B, C, D](f: A -⚬ B, g: C -⚬ D): (A |+| C )-⚬ (B |+| D) =
bimap(f, g)
}
/** Disjoint union is covariant in the left argument. */
def left[B]: Functor[[x] =>> x |+| B] =
bifunctor.fst[B]
/** Disjoint union is covariant in the right argument. */
def right[A]: Monad[[x] =>> A |+| x] =
new Monad[[x] =>> A |+| x] {
override val category: Category[-⚬] =
dsl.category
override def pure[B]: B -⚬ (A |+| B) =
injectR
override def lift[B, C](f: B -⚬ C): (A |+| B) -⚬ (A |+| C) =
rmap(f)
override def flatten[B]: (A |+| (A |+| B)) -⚬ (A |+| B) =
either(injectL, id)
}
}
object |&| {
def assocLR[A, B, C]: ((A |&| B) |&| C) -⚬ (A |&| (B |&| C)) =
choice(andThen(chooseL, chooseL), choice(andThen(chooseL, chooseR), chooseR))
def assocRL[A, B, C]: (A |&| (B |&| C)) -⚬ ((A |&| B) |&| C) =
choice(choice(chooseL, andThen(chooseR, chooseL)), andThen(chooseR, chooseR))
def bimap[A, B, C, D](f: A -⚬ B, g: C -⚬ D): (A |&| C) -⚬ (B |&| D) =
choice(chooseL > f, chooseR > g)
def lmap[A, B, A1](f: A -⚬ A1): (A |&| B) -⚬ (A1 |&| B) =
choice(chooseL > f, chooseR)
def rmap[A, B, B1](f: B -⚬ B1): (A |&| B) -⚬ (A |&| B1) =
choice(chooseL, chooseR > f)
def swap[A, B]: (A |&| B) -⚬ (B |&| A) =
choice(chooseR, chooseL)
def IXI[A, B, C, D]: ((A |&| B) |&| (C |&| D)) -⚬ ((A |&| C) |&| (B |&| D)) =
choice(
choice(chooseL > chooseL, chooseR > chooseL),
choice(chooseL > chooseR, chooseR > chooseR),
)
/** Alias for [[notifyChoice]]:
* Adds a [[Pong]] that fires when it is known which side of the choice (`A |&| B`) has been chosen.
*/
def notify[A, B]: (Pong |*| (A |&| B)) -⚬ (A |&| B) =
notifyChoice
/** Adds a [[Need]] that completes when it is known which side of the choice (`A |&| B`) has been chosen. */
def signal[A, B]: (Need |*| (A |&| B)) -⚬ (A |&| B) =
fst(strengthenPong) > notify
/** Adds a [[Pong]] to the left case that fires when the choice is made. */
def notifyL[A, B]: ((Pong |*| A) |&| B) -⚬ (A |&| B) =
rmap(introFst(dismissPong)) > coDistributeL > notify
/** Adds a [[Pong]] to the right case that fires when the choice is made. */
def notifyR[A, B]: (A |&| (Pong |*| B)) -⚬ (A |&| B) =
lmap(introFst(dismissPong)) > coDistributeL > notify
/** Adds a [[Need]] to the left case that completes when the choice is made. */
def signalL[A, B]: ((Need |*| A) |&| B) -⚬ (A |&| B) =
bimap(fst(strengthenPong), introFst(dismissPong)) > coDistributeL > notify
/** Adds a [[Need]] to the right case that completes when the choice is made. */
def signalR[A, B]: (A |&| (Need |*| B)) -⚬ (A |&| B) =
bimap(introFst(dismissPong), fst(strengthenPong)) > coDistributeL > notify
val bifunctor: Bifunctor[|&|] =
new Bifunctor[|&|] {
override val category =
dsl.category
override def lift[A, B, C, D](f: A -⚬ B, g: C -⚬ D): (A |&| C) -⚬ (B |&| D) =
bimap(f, g)
}
/** Choice is covariant in the left argument. */
def left[B]: Functor[λ[x => x |&| B]] =
bifunctor.fst[B]
/** Choice is covariant in the right argument. */
def right[A]: Functor[λ[x => A |&| x]] =
bifunctor.snd[A]
}
given fstFunctor[B]: Transportive[[x] =>> x |*| B] = Transportive.fst[B]
given sndFunctor[A]: Transportive[[x] =>> A |*| x] = Transportive.snd[A]
given Bifunctor[|+|] = |+|.bifunctor
given Bifunctor[|&|] = |&|.bifunctor
implicit class LinearFunctionOps[A, B](self: A -⚬ B) {
/** No-op used for documentation purposes: explicitly states the input type of this linear function. */
def from[Z](using ev: A =:= Z): Z -⚬ B = ev.substituteCo[λ[x => x -⚬ B]](self)
/** No-op used for documentation purposes: explicitly states the output type of this linear function. */
def to[C](using ev: B =:= C): A -⚬ C = ev.substituteCo(self)
/** No-op used for documentation purposes: explicitly states the full type of this linear function. */
def as[C](using ev: (A -⚬ B) =:= C): C = ev(self)
def ∘[Z](g: Z -⚬ A): Z -⚬ B = dsl.andThen(g, self)
/** Focuses on function's output. */
def /> : FocusedCo[[x] =>> A -⚬ x, B] =
new FocusedCo[[x] =>> A -⚬ x, B](self)
/** Focuses on function's input. */
def /< : FocusedContra[[x] =>> x -⚬ B, A] =
new FocusedContra[[x] =>> x -⚬ B, A](self)
}
/** Focused on `B` in `F[B]`, where `B` is in a covariant position. */
class FocusedCo[F[_], B](f: F[B])(using F: Externalizer[F]) {
def map[C](g: B -⚬ C): F[C] = F.lift(g)(f)
/** Alias for [[map]]. */
def apply[C](g: B -⚬ C): F[C] = map(g)
def subst[C](using ev: B =:= C): F[C] =
ev.substituteCo(f)
def unsubst[C](using ev: C =:= B): F[C] =
ev.substituteContra(f)
def zoomCo[G[_], C](G: Functor[G])(using ev: B =:= G[C]): FocusedCo[λ[x => F[G[x]]], C] =
new FocusedCo[λ[x => F[G[x]]], C](ev.substituteCo(f))(using F ∘ G)
def zoomContra[G[_], C](G: ContraFunctor[G])(using ev: B =:= G[C]): FocusedContra[λ[x => F[G[x]]], C] =
new FocusedContra[λ[x => F[G[x]]], C](ev.substituteCo(f))(using F ∘ G)
def co[G[_]](using G: Functor[G], U: Unapply[B, G]): FocusedCo[λ[x => F[G[x]]], U.A] =
zoomCo[G, U.A](G)(using U.ev)
def contra[G[_]](using G: ContraFunctor[G], U: Unapply[B, G]): FocusedContra[λ[x => F[G[x]]], U.A] =
zoomContra[G, U.A](G)(using U.ev)
def bi[G[_, _]](using G: Bifunctor[G], U: Unapply2[B, G]): FocusedBi[λ[(x, y) => F[G[x, y]]], U.A, U.B] =
new FocusedBi[λ[(x, y) => F[G[x, y]]], U.A, U.B](U.ev.substituteCo(f))(F ∘ G)
}
class FocusedBi[F[_, _], B1, B2](f: F[B1, B2])(F: BiExternalizer[F]) {
def map[C1, C2](g: B1 -⚬ C1, h: B2 -⚬ C2): F[C1, C2] =
F.lift(g, h)(f)
def fst: FocusedCo[F[*, B2], B1] =
new FocusedCo[F[*, B2], B1](f)(using F.fst)
def snd: FocusedCo[F[B1, *], B2] =
new FocusedCo[F[B1, *], B2](f)(using F.snd)
}
implicit class FocusedOnPairCo[F[_], B1, B2](f: FocusedCo[F, B1 |*| B2]) {
def fst: FocusedCo[[x] =>> F[x |*| B2], B1] =
f.zoomCo(Functor[[x] =>> x |*| B2])
def snd: FocusedCo[[x] =>> F[B1 |*| x], B2] =
f.zoomCo(Functor[[x] =>> B1 |*| x])
}
implicit class FocusedOnPlusCo[F[_], B1, B2](f: FocusedCo[F, B1 |+| B2]) {
def left: FocusedCo[λ[x => F[x |+| B2]], B1] =
f.zoomCo(|+|.left[B2])
def right: FocusedCo[λ[x => F[B1 |+| x]], B2] =
f.zoomCo(|+|.right[B1])
}
implicit class FocusedOnChoiceCo[F[_], B1, B2](f: FocusedCo[F, B1 |&| B2]) {
def choiceL: FocusedCo[λ[x => F[x |&| B2]], B1] =
f.zoomCo(|&|.left[B2])
def choiceR: FocusedCo[λ[x => F[B1 |&| x]], B2] =
f.zoomCo(|&|.right[B1])
}
/** Focused on `B` in `F[B]`, where `B` is in a contravariant position. */
class FocusedContra[F[_], B](f: F[B])(using F: ContraExternalizer[F]) {
def contramap[A](g: A -⚬ B): F[A] =
F.lift(g)(f)
/** Alias for [[contramap]]. */
def apply[A](g: A -⚬ B): F[A] =
contramap(g)
def subst[C](using ev: B =:= C): F[C] =
ev.substituteCo(f)
def unsubst[C](using ev: C =:= B): F[C] =
ev.substituteContra(f)
def zoomCo[G[_], C](G: Functor[G])(using ev: B =:= G[C]): FocusedContra[λ[x => F[G[x]]], C] =
new FocusedContra[λ[x => F[G[x]]], C](ev.substituteCo(f))(using F ∘ G)
def zoomContra[G[_], C](G: ContraFunctor[G])(using ev: B =:= G[C]): FocusedCo[λ[x => F[G[x]]], C] =
new FocusedCo[λ[x => F[G[x]]], C](ev.substituteCo(f))(using F ∘ G)
def co[G[_]](using G: Functor[G], U: Unapply[B, G]): FocusedContra[λ[x => F[G[x]]], U.A] =
zoomCo[G, U.A](G)(using U.ev)
def contra[G[_]](using G: ContraFunctor[G], U: Unapply[B, G]): FocusedCo[λ[x => F[G[x]]], U.A] =
zoomContra[G, U.A](G)(using U.ev)
}
implicit class FocusedOnPairContra[A, F[_], B1, B2](f: FocusedContra[F, B1 |*| B2]) {
def fst: FocusedContra[[x] =>> F[x |*| B2], B1] =
f.zoomCo(Functor[[x] =>> x |*| B2])
def snd: FocusedContra[[x] =>> F[B1 |*| x], B2] =
f.zoomCo(Functor[[x] =>> B1 |*| x])
}
/** Extends the focus to the left/right side of the (currently focused) producer choice. */
implicit class FocusedOnPlusContra[A, F[_], B1, B2](f: FocusedContra[F, B1 |+| B2]) {
def left: FocusedContra[λ[x => F[x |+| B2]], B1] =
f.zoomCo(|+|.left[B2])
def right: FocusedContra[λ[x => F[B1 |+| x]], B2] =
f.zoomCo(|+|.right[B1])
}
/** Extends the focus to the left/right side of the (currently focused) consumer choice. */
implicit class FocusedOnChoiceContra[A, F[_], B1, B2](f: FocusedContra[F, B1 |&| B2]) {
def choiceL: FocusedContra[λ[x => F[x |&| B2]], B1] =
f.zoomCo(|&|.left[B2])
def choiceR: FocusedContra[λ[x => F[B1 |&| x]], B2] =
f.zoomCo(|&|.right[B1])
}
def IXI[A, B, C, D]: ((A|*|B)|*|(C|*|D)) -⚬
// | \ / |
// | \ / |
// | X |
// | / \ |
// | / \ |
((A|*|C)|*|(B|*|D)) =
id [ (A |*| B) |*| (C |*| D) ]
./>(assocLR) .to[ A |*| (B |*| (C |*| D)) ]
./>.snd(assocRL) .to[ A |*| ((B |*| C) |*| D) ]
./>.snd.fst(swap) .to[ A |*| ((C |*| B) |*| D) ]
./>.snd(assocLR) .to[ A |*| (C |*| (B |*| D)) ]
./>(assocRL) .to[ (A |*| C) |*| (B |*| D) ]
def IX[A, B, C]: ((A|*|B)|*| C) -⚬
// | \ /
// | \ /
// | X
// | / \
// | / \
((A|*|C)|*| B) =
assocLR[A, B, C] > par(id, swap) > assocRL
def XI[A, B, C]: (A |*|(B|*|C)) -⚬
// \ / |
// \ / |
// X |
// / \ |
// / \ |
(B |*|(A|*|C)) =
assocRL[A, B, C] > par(swap, id) > assocLR
def IV[A, B, C, D](f: (B |*| C) -⚬ D): ( ( A |*| B ) |*| C ) -⚬
// | \ /
// | \ /
// | \ /
( A |*| D ) =
assocLR > snd(f)
def VI[A, B, C, D](f: (A |*| B) -⚬ D): ( A |*| ( B |*| C ) ) -⚬
// \ / |
// \ / |
// \ / |
( D |*| C ) =
assocRL > fst(f)
/** Λ is the uppercase Greek letter lambda. */
def IΛ[A, B, C, D](f: B -⚬ (C |*| D)): ( A |*| B ) -⚬
// | / \
// | / \
// | / \
( ( A |*| C ) |*| D ) =
snd(f) > assocRL
/** Λ is the uppercase Greek letter lambda. */
def ΛI[A, B, C, D](f: A -⚬ (B |*| C)): ( A |*| D ) -⚬
// / \ |
// / \ |
// / \ |
( B |*| ( C |*| D ) ) =
fst(f) > assocLR
/** From the choice ''available'' on the right (`C |&| D`), choose the one corresponding to the choice ''made''
* on the left (`A |+| B`): if on the left there is `A`, choose `C`, if on the left thre is `B`, choose `D`.
*/
def matchingChoiceLR[A, B, C, D]: ((A |+| B) |*| (C |&| D)) -⚬ ((A |*| C) |+| (B |*| D)) =
id[(A |+| B) |*| (C |&| D)]
./>(distributeR) .to[(A |*| (C |&| D)) |+| (B |*| (C |&| D))]
./>.left.snd(chooseL) .to[(A |*| C ) |+| (B |*| (C |&| D))]
./>.right.snd(chooseR) .to[(A |*| C ) |+| (B |*| D )]
/** From the choice ''available'' on the left (`A |&| B`), choose the one corresponding to the choice ''made''
* on the right (`C |+| D`): if on the right there is `C`, choose `A`, if on the right there is `D`, choose `B`.
*/
def matchingChoiceRL[A, B, C, D]: ((A |&| B) |*| (C |+| D)) -⚬ ((A |*| C) |+| (B |*| D)) =
id[(A |&| B) |*| (C |+| D)]
./>(distributeL) .to[((A |&| B) |*| C) |+| ((A |&| B) |*| D)]
./>.left.fst(chooseL) .to[( A |*| C) |+| ((A |&| B) |*| D)]
./>.right.fst(chooseR) .to[( A |*| C) |+| ( B |*| D)]
/** Present a choice between two pairs (`(A |*| B) |&| (C |*| D)`) as a choice (`A |&| C`) between the first
* parts of the respective pairs and on the side provide the other part of the chosen input pair, i.e. either
* `B` or `D` (`B |+| D`).
*/
def subordinateSnd[A, B, C, D]: ((A |*| B) |&| (C |*| D)) -⚬ ((A |&| C) |*| (B |+| D)) =
id [ (A |*| B ) |&| (C |*| D ) ]
./>.choiceL.snd(injectL) .to[ (A |*| (B |+| D)) |&| (C |*| D ) ]
./>.choiceR.snd(injectR) .to[ (A |*| (B |+| D)) |&| (C |*| (B |+| D)) ]
./>(coDistributeR)
/** Present a choice between two pairs (`(A |*| B) |&| (C |*| D)`) as a choice (`B |&| D`) between the second
* parts of the respective pairs and on the side provide the other part of the chosen input pair, i.e. either
* `A` or `C` (`A |+| C`).
*/
def subordinateFst[A, B, C, D]: ((A |*| B) |&| (C |*| D)) -⚬ ((A |+| C) |*| (B |&| D)) =
id [ ( A |*| B) |&| ( C |*| D) ]
./>.choiceL.fst(injectL) .to[ ((A |+| C) |*| B) |&| ( C |*| D) ]
./>.choiceR.fst(injectR) .to[ ((A |+| C) |*| B) |&| ((A |+| C) |*| D) ]
./>(coDistributeL) .to[ (A |+| C) |*| (B |&| D) ]
/** Notifies when the [[|+|]] is decided _and_ the present side notifies using the respective given function. */
def notifyEitherAndSides[A, B](
notifyL: A -⚬ (Ping |*| A),
notifyR: B -⚬ (Ping |*| B),
): (A |+| B) -⚬ (Ping |*| (A |+| B)) =
id [ A |+| B ]
./>(|+|.bimap(notifyL, notifyR)) .to[ (Ping |*| A) |+| (Ping |*| B) ]
./>(notifyEither) .to[ Ping |*| ((Ping |*| A) |+| (Ping |*| B)) ]
./>.snd(factorL) .to[ Ping |*| (Ping |*| (A |+| B)) ]
./>(assocRL) .to[ (Ping |*| Ping) |*| (A |+| B) ]
./>.fst(joinPing) .to[ Ping |*| (A |+| B) ]
/** Notifies when the [[|+|]] is decided _and_ the present side notifies. */
def notifyEitherAndSides[A, B](using
A: Signaling.Positive[A],
B: Signaling.Positive[B],
): (A |+| B) -⚬ (Ping |*| (A |+| B)) =
notifyEitherAndSides(A.notifyPosFst, B.notifyPosFst)
/** Notifies when the [[|+|]] is decided _and_ if it is left, the left side notifies using the given function. */
def notifyEitherAndLeft[A, B](
notifyL: A -⚬ (Ping |*| A),
): (A |+| B) -⚬ (Ping |*| (A |+| B)) =
notifyEitherAndSides(notifyL, introFst(ping))
/** Notifies when the [[|+|]] is decided _and_ if it is left, the left side notifies. */
def notifyEitherAndLeft[A, B](using
A: Signaling.Positive[A],
): (A |+| B) -⚬ (Ping |*| (A |+| B)) =
notifyEitherAndLeft(A.notifyPosFst)
/** Notifies when the [[|+|]] is decided _and_ if it is right, the right side notifies using the given function. */
def notifyEitherAndRight[A, B](
notifyR: B -⚬ (Ping |*| B),
): (A |+| B) -⚬ (Ping |*| (A |+| B)) =
notifyEitherAndSides(introFst(ping), notifyR)
/** Notifies when the [[|+|]] is decided _and_ if it is right, the right side notifies. */
def notifyEitherAndRight[A, B](using
B: Signaling.Positive[B],
): (A |+| B) -⚬ (Ping |*| (A |+| B)) =
notifyEitherAndRight(B.notifyPosFst)
/** Notifies when the choice ([[|&|]]) is made _and_ the chosen side notifies using the respective given function. */
def notifyChoiceAndSides[A, B](
notifyL: (Pong |*| A) -⚬ A,
notifyR: (Pong |*| B) -⚬ B,
): (Pong |*| (A |&| B)) -⚬ (A |&| B) =
id [ A |&| B ]
./<(|&|.bimap(notifyL, notifyR)) .from[ (Pong |*| A) |&| (Pong |*| B) ]
./<(notifyChoice) .from[ Pong |*| ((Pong |*| A) |&| (Pong |*| B)) ]
./<.snd(coFactorL) .from[ Pong |*| (Pong |*| (A |&| B)) ]
./<(assocLR) .from[ (Pong |*| Pong) |*| (A |&| B) ]
./<.fst(joinPong) .from[ Pong |*| (A |&| B) ]
/** Notifies when the choice ([[|&|]]) is made _and_ the chosen side notifies. */
def notifyChoiceAndSides[A, B](using
A: Signaling.Negative[A],
B: Signaling.Negative[B],
): (Pong |*| (A |&| B)) -⚬ (A |&| B) =
notifyChoiceAndSides(A.notifyNegFst, B.notifyNegFst)
/** Notifies when the choice ([[|&|]]) is made _and_ if it is left, the left side notifies using the given function. */
def notifyChoiceAndLeft[A, B](
notifyL: (Pong |*| A) -⚬ A,
): (Pong |*| (A |&| B)) -⚬ (A |&| B) =
notifyChoiceAndSides(notifyL, elimFst(pong))
/** Notifies when the choice ([[|&|]]) is made _and_ if it is left, the left side notifies. */
def notifyChoiceAndLeft[A, B](using
A: Signaling.Negative[A],
): (Pong |*| (A |&| B)) -⚬ (A |&| B) =
notifyChoiceAndLeft(A.notifyNegFst)
/** Notifies when the choice ([[|&|]]) is made _and_ if it is right, the right side notifies using the given function. */
def notifyChoiceAndRight[A, B](
notifyR: (Pong |*| B) -⚬ B,
): (Pong |*| (A |&| B)) -⚬ (A |&| B) =
notifyChoiceAndSides(elimFst(pong), notifyR)
/** Notifies when the choice ([[|&|]]) is made _and_ if it is right, the right side notifies. */
def notifyChoiceAndRight[A, B](using
B: Signaling.Negative[B],
): (Pong |*| (A |&| B)) -⚬ (A |&| B) =
notifyChoiceAndRight(B.notifyNegFst)
def injectLWhenDone[A, B]: (Done |*| A) -⚬ ((Done |*| A) |+| B) =
par(notifyDoneL, id) > assocLR > injectLOnPing
def injectRWhenDone[A, B]: (Done |*| B) -⚬ (A |+| (Done |*| B)) =
par(notifyDoneL, id) > assocLR > injectROnPing
def chooseLWhenNeed[A, B]: ((Need |*| A) |&| B) -⚬ (Need |*| A) =
chooseLOnPong > assocRL > par(notifyNeedL, id)
def chooseRWhenNeed[A, B]: (A |&| (Need |*| B)) -⚬ (Need |*| B) =
chooseROnPong > assocRL > par(notifyNeedL, id)
def injectLOnPong[A, B]: A -⚬ (Pong |*| (A |+| B)) =
id[A] > introFst(lInvertPongPing) > assocLR > snd(injectLOnPing)
def injectROnPong[A, B]: B -⚬ (Pong |*| (A |+| B)) =
id[B] > introFst(lInvertPongPing) > assocLR > snd(injectROnPing)
def chooseLOnPing[A, B]: (Ping |*| (A |&| B)) -⚬ A =
snd(chooseLOnPong) > assocRL > elimFst(rInvertPingPong)
def chooseROnPing[A, B]: (Ping |*| (A |&| B)) -⚬ B =
snd(chooseROnPong) > assocRL > elimFst(rInvertPingPong)
def chooseLWhenDone[A, B]: (Done |*| (A |&| B)) -⚬ (Done |*| A) =
id [ Done |*| ( A |&| B) ]
./>.snd.choiceL(introFst(lInvertSignal) > assocLR) .to[ Done |*| ((Need |*| (Done |*| A)) |&| B) ]
./>.snd(chooseLWhenNeed) .to[ Done |*| (Need |*| (Done |*| A)) ]
./>(assocRL).>(elimFst(rInvertSignal)) .to[ Done |*| A ]
def chooseRWhenDone[A, B]: (Done |*| (A |&| B)) -⚬ (Done |*| B) =
id [ Done |*| (A |&| B ) ]
./>.snd.choiceR(introFst(lInvertSignal) > assocLR) .to[ Done |*| (A |&| (Need |*| (Done |*| B))) ]
./>.snd(chooseRWhenNeed) .to[ Done |*| (Need |*| (Done |*| B)) ]
./>(assocRL > elimFst(rInvertSignal)) .to[ Done |*| B ]
def injectLWhenNeed[A, B]: (Need |*| A) -⚬ (Need |*| (A |+| B)) =
id [ Need |*| A ]
./>(introFst(lInvertSignal)).>(assocLR) .to[ Need |*| (Done |*| (Need |*| A)) ]
./>.snd(injectLWhenDone) .to[ Need |*| ((Done |*| (Need |*| A)) |+| B) ]
./>.snd.left(assocRL > elimFst(rInvertSignal)) .to[ Need |*| ( A |+| B) ]
def injectRWhenNeed[A, B]: (Need |*| B) -⚬ (Need |*| (A |+| B)) =
id [ Need |*| B ]
./>(introFst(lInvertSignal)).>(assocLR) .to[ Need |*| (Done |*| (Need |*| B)) ]
./>.snd(injectRWhenDone) .to[ Need |*| (A |+| (Done |*| (Need |*| B))) ]
./>.snd.right(assocRL > elimFst(rInvertSignal)) .to[ Need |*| (A |+| B ) ]
def delayEitherUntilPing[A, B]: (Ping |*| (A |+| B)) -⚬ (A |+| B) =
distributeL > either(injectLOnPing, injectROnPing)
def delayChoiceUntilPong[A, B]: (A |&| B) -⚬ (Pong |*| (A |&| B)) =
choice(chooseLOnPong, chooseROnPong) > coDistributeL
def delayEitherUntilPong[A, B]: (A |+| B) -⚬ (Pong |*| (A |+| B)) =
either(injectLOnPong, injectROnPong)
def delayChoiceUntilPing[A, B]: (Ping |*| (A |&| B)) -⚬ (A |&| B) =
choice(chooseLOnPing, chooseROnPing)
def delayEitherUntilDone[A, B]: (Done |*| (A |+| B)) -⚬ ((Done |*| A) |+| (Done |*| B)) =
id [ Done |*| (A |+| B) ]
.>(distributeL) .to[ (Done |*| A) |+| (Done |*| B) ]
.>(either(injectLWhenDone, injectRWhenDone)) .to[ (Done |*| A) |+| (Done |*| B) ]
def delayEitherAndSidesUntilDone[A, B](using
A: Junction.Positive[A],
B: Junction.Positive[B],
): (Done |*| (A |+| B)) -⚬ (A |+| B) =
delayEitherUntilDone[A, B] > |+|.bimap(A.awaitPosFst, B.awaitPosFst)
def delayChoiceUntilNeed[A, B]: ((Need |*| A) |&| (Need |*| B)) -⚬ (Need |*| (A |&| B)) =
id [ (Need |*| A) |&| (Need |*| B) ]
.>(choice(chooseLWhenNeed, chooseRWhenNeed)) .to[ (Need |*| A) |&| (Need |*| B) ]
.>(coDistributeL) .to[ Need |*| (A |&| B) ]
def delayChoiceAndSidesUntilNeed[A, B](using
A: Junction.Negative[A],
B: Junction.Negative[B],
): (A |&| B) -⚬ (Need |*| (A |&| B)) =
|&|.bimap(A.awaitNegFst, B.awaitNegFst) > delayChoiceUntilNeed[A, B]
def delayEitherUntilNeed[A, B]: ((Need |*| A) |+| (Need |*| B)) -⚬ (Need |*| (A |+| B)) =
id [ (Need |*| A) |+| (Need |*| B) ]
.>(either(injectLWhenNeed, injectRWhenNeed)) .to[ Need |*| (A |+| B) ]
def delayEitherAndSidesUntilNeed[A, B](using
A: Junction.Negative[A],
B: Junction.Negative[B],
): (A |+| B) -⚬ (Need |*| (A |+| B)) =
|+|.bimap(A.awaitNegFst, B.awaitNegFst) > delayEitherUntilNeed[A, B]
def delayChoiceUntilDone[A, B]: (Done |*| (A |&| B)) -⚬ ((Done |*| A) |&| (Done |*| B)) =
id [ Done |*| (A |&| B) ]
.>(choice(chooseLWhenDone[A, B], chooseRWhenDone[A, B])) .to[ (Done |*| A) |&| (Done |*| B) ]
def delayChoiceAndSidesUntilDone[A, B](using
A: Junction.Positive[A],
B: Junction.Positive[B],
): (Done |*| (A |&| B)) -⚬ (A |&| B) =
delayChoiceUntilDone[A, B] > |&|.bimap(A.awaitPosFst, B.awaitPosFst)
/** Injects `A` from the the second in-port to the left side of the `|+|` in the out-port, but only after
* the `Done` signal from the first in-port arrives. That means that the consumer of `A |+| B` will see it
* as undecided until the `Done` signal arrives. This is different from `awaitPosFst[A] > injectL[A, B]`,
* in which the consumer of `A |+| B` knows immediately that it is the left case.
*
* This is a convenience method on top of [[injectLWhenDone]] that which absorbs the `Done` signal using
* the given [[Junction.Positive]].
*/
def awaitInjectL[A, B](using A: Junction.Positive[A]): (Done |*| A) -⚬ (A |+| B) =
injectLWhenDone./>.left(A.awaitPos)
/** Analogous to [[joinInjectL]], but injects to the right. */
def awaitInjectR[A, B](using B: Junction.Positive[B]): (Done |*| B) -⚬ (A |+| B) =
injectRWhenDone./>.right(B.awaitPos)
/** Chooses the left alternative `A` of the choice `A |&| B`, but only after the `Need` signal from the first
* out-port arrives. Until then, the producer of `A |&| B` will see it as undecided. This is different from
* `chooseL[A, B] > awaitNegFst[A]`, in which the producer of `A |&| B` knows immediately that the left side
* is chosen.
*/
def awaitChooseL[A, B](using A: Junction.Negative[A]): (A |&| B) -⚬ (Need |*| A) =
id[A |&| B]./>.choiceL(A.awaitNeg) > chooseLWhenNeed
/** Analogous to [[awaitChooseL]], but chooses the right side. */
def awaitChooseR[A, B](using B: Junction.Negative[B]): (A |&| B) -⚬ (Need |*| B) =
id[A |&| B]./>.choiceR(B.awaitNeg) > chooseRWhenNeed
/** Analogous to [[awaitChooseL]], but awaits a positive (i.e. [[Done]]) signal. */
def awaitPosChooseL[A, B](using A: Junction.Positive[A]): (Done |*| (A |&| B)) -⚬ A =
par(id, awaitChooseL(using Junction.invert(A))) > assocRL > elimFst(rInvertSignal)
/** Analogous to [[awaitChooseR]], but awaits a positive (i.e. [[Done]]) signal. */
def awaitPosChooseR[A, B](using B: Junction.Positive[B]): (Done |*| (A |&| B)) -⚬ B =
par(id, awaitChooseR(using Junction.invert(B))) > assocRL > elimFst(rInvertSignal)
/** Creates a pair of mutually recursive functions. */
def rec2[A, B, C, D](
f: (A -⚬ B, C -⚬ D) => A -⚬ B,
g: (A -⚬ B, C -⚬ D) => C -⚬ D,
): (A -⚬ B, C -⚬ D) =
(
rec { (ab: A -⚬ B) => f(ab, rec { (cd: C -⚬ D) => g(ab, cd) }) },
rec { (cd: C -⚬ D) => g(rec { (ab: A -⚬ B) => f(ab, cd) }, cd) },
)
def rec2[A, B, C, D](
fs: (A -⚬ B, C -⚬ D) => (A -⚬ B, C -⚬ D),
): (A -⚬ B, C -⚬ D) =
rec2(
(f, g) => fs(f, g)._1,
(f, g) => fs(f, g)._2,
)
def rec3[A, B, C, D, E, F](
f: (A -⚬ B, C -⚬ D, E -⚬ F) => A -⚬ B,
g: (A -⚬ B, C -⚬ D, E -⚬ F) => C -⚬ D,
h: (A -⚬ B, C -⚬ D, E -⚬ F) => E -⚬ F,
): (A -⚬ B, C -⚬ D, E -⚬ F) =
(
rec { (ab: A -⚬ B) =>
f(
ab,
rec { (cd: C -⚬ D) => g(ab, cd, rec { (ef: E -⚬ F) => h(ab, cd, ef) }) },
rec { (ef: E -⚬ F) => h(ab, rec { (cd: C -⚬ D) => g(ab, cd, ef) }, ef) },
)
},
rec { (cd: C -⚬ D) =>
g(
rec { (ab: A -⚬ B) => f(ab, cd, rec { (ef: E -⚬ F) => h(ab, cd, ef) }) },
cd,
rec { (ef: E -⚬ F) => h(rec { (ab: A -⚬ B) => f(ab, cd, ef) }, cd, ef) },
)
},
rec { (ef: E -⚬ F) =>
h(
rec { (ab: A -⚬ B) => f(ab, rec { (cd: C -⚬ D) => g(ab, cd, ef) }, ef) },
rec { (cd: C -⚬ D) => g(rec { (ab: A -⚬ B) => f(ab, cd, ef) }, cd, ef) },
ef,
)
},
)
def rec3[A, B, C, D, E, F](
fs: (A -⚬ B, C -⚬ D, E -⚬ F) => (A -⚬ B, C -⚬ D, E -⚬ F),
): (A -⚬ B, C -⚬ D, E -⚬ F) =
rec3(
(f, g, h) => fs(f, g, h)._1,
(f, g, h) => fs(f, g, h)._2,
(f, g, h) => fs(f, g, h)._3,
)
opaque type Bool = Done |+| Done
object Bool {
val constTrue: Done -⚬ Bool =
injectL
val constFalse: Done -⚬ Bool =
injectR
def switch[R](
caseTrue : Done -⚬ R,
caseFalse: Done -⚬ R,
): Bool -⚬ R =
either(caseTrue, caseFalse)
def switchWithL[A, R](
caseTrue : (A |*| Done) -⚬ R,
caseFalse: (A |*| Done) -⚬ R,
): (A |*| Bool) -⚬ R =
distributeL > either(caseTrue, caseFalse)
def switchWithR[A, R](
caseTrue : (Done |*| A) -⚬ R,
caseFalse: (Done |*| A) -⚬ R,
): (Bool |*| A) -⚬ R =
distributeR > either(caseTrue, caseFalse)
def ifThenElse[A, B, C](ifTrue: (Done |*| A) -⚬ B, ifFalse: (Done |*| A) -⚬ C): (Bool |*| A) -⚬ (B |+| C) =
id [ Bool |*| A ]
.>(distributeR) .to[ (Done |*| A) |+| (Done |*| A) ]
.>(|+|.bimap(ifTrue, ifFalse)) .to[ B |+| C ]
}
def testBy[A, B, K: Cosemigroup: Junction.Positive](
aKey: Getter[A, K],
bKey: Getter[B, K],
pred: (K |*| K) -⚬ Bool,
): (A |*| B) -⚬ ((A |*| B) |+| (A |*| B)) = {
import Bool.*
val awaitL: (Done |*| (A |*| B)) -⚬ (A |*| B) =
(aKey compose Transportive.fst[B].lens[A]).awaitFst
id[A |*| B]
./>(par(aKey.getL, bKey.getL))
./>(IXI)
./>.fst(pred)
./>(ifThenElse(awaitL, awaitL))
}
object Compared {
opaque type Compared[A, B] = (A |*| B) |+| ((A |*| B) |+| (A |*| B))
// constructors
def lt [A, B]: (A |*| B) -⚬ Compared[A, B] = injectL
def equiv[A, B]: (A |*| B) -⚬ Compared[A, B] = injectL > injectR
def gt [A, B]: (A |*| B) -⚬ Compared[A, B] = injectR > injectR
/** Destructor. */
def compared[A, B, C](
caseLt: (A |*| B) -⚬ C,
caseEq: (A |*| B) -⚬ C,
caseGt: (A |*| B) -⚬ C,
): Compared[A, B] -⚬ C =
either(caseLt, either(caseEq, caseGt))
/** Destructor that allows to combine the compared values with another value. */
def elimWith[A, B, C, D](
caseLt: ((A |*| B) |*| C) -⚬ D,
caseEq: ((A |*| B) |*| C) -⚬ D,
caseGt: ((A |*| B) |*| C) -⚬ D,
): (Compared[A, B] |*| C) -⚬ D =
id[ Compared[A, B] |*| C ] .to[ ((A |*| B) |+| ( (A |*| B) |+| (A |*| B))) |*| C ]
./>(distributeR)./>.right(distributeR) .to[ ((A |*| B) |*| C) |+| (((A |*| B) |*| C) |+| ((A |*| B) |*| C)) ]
./>(either(caseLt, either(caseEq, caseGt))) .to[ D ]
def enrichWith[A, B, C, S, T](
f: ((A |*| B) |*| C) -⚬ (S |*| T),
)
: (Compared[A, B] |*| C) -⚬ Compared[S, T] =
id[ Compared[A, B] |*| C ] .to[ ((A |*| B) |+| ( (A |*| B) |+| (A |*| B))) |*| C ]
./>(distributeR)./>.right(distributeR) .to[ ((A |*| B) |*| C) |+| (((A |*| B) |*| C) |+| ((A |*| B) |*| C)) ]
./>(|+|.bimap(f, |+|.bimap(f, f))) .to[ (S |*| T) |+| ( (S |*| T) |+| (S |*| T) ) ]
def bifunctorCompared: Bifunctor[Compared] =
new Bifunctor[Compared] {
override val category =
dsl.category
def lift[A, B, C, D](f: A -⚬ B, g: C -⚬ D): Compared[A, C] -⚬ Compared[B, D] = {
Bifunctor[|+|].lift(
par(f, g),
Bifunctor[|+|].lift(
par(f, g),
par(f, g),
)
)
}
}
}
import Compared.*
def compareBy[A, B, K1 : CloseableCosemigroup : Junction.Positive, K2 : CloseableCosemigroup : Junction.Positive](
aKey: Getter[A, K1],
bKey: Getter[B, K2],
)(using
cmp: Comparable[K1, K2],
): (A |*| B) -⚬ Compared[A, B] = {
cmp.contramap(aKey, bKey).compare
}
trait Comparable[A, B] { self =>
def compare: (A |*| B) -⚬ Compared[A, B]
def contramap[S, T](
f: Getter[S, A],
g: Getter[T, B],
)(using
A: CloseableCosemigroup[A],
B: CloseableCosemigroup[B],
AJ: Junction.Positive[A],
BJ: Junction.Positive[B],
): Comparable[S, T] =
new Comparable[S, T] {
private val absorb: ((A |*| B) |*| (S |*| T)) -⚬ (S |*| T) =
id [ (A |*| B) |*| (S |*| T) ]
./>(IXI) .to[ (A |*| S) |*| (B |*| T) ]
./>.fst.fst(A.close) .to[ (Done |*| S) |*| (B |*| T) ]
./>.snd.fst(B.close) .to[ (Done |*| S) |*| (Done |*| T) ]
./>(par(f.awaitFst, g.awaitFst)) .to[ S |*| T ]
override def compare: (S |*| T) -⚬ Compared[S, T] = {
id[ S |*| T ]
./>(par(f.getL, g.getL))
./>(IXI)
./>.fst(self.compare)
./>(Compared.enrichWith(absorb))
}
}
}
def dualSymmetric[A, B](ev: Dual[A, B]): Dual[B, A] = new Dual[B, A] {
val lInvert: One -⚬ (A |*| B) = andThen(ev.lInvert, swap)
val rInvert: (B |*| A) -⚬ One = andThen(swap, ev.rInvert)
}
given Dual[One, One] with {
val lInvert: One -⚬ (One |*| One) = introSnd
val rInvert: (One |*| One) -⚬ One = elimSnd
}
def rInvertPair[A, B, Ȧ, Ḃ](
rInvertA: (A |*| Ȧ) -⚬ One,
rInvertB: (B |*| Ḃ) -⚬ One,
): ((A |*| B) |*| (Ȧ |*| Ḃ)) -⚬ One =
id[(A |*| B) |*| (Ȧ |*| Ḃ)] .to[ (A |*| B) |*| (Ȧ |*| Ḃ) ]
.>(IXI) .to[ (A |*| Ȧ) |*| (B |*| Ḃ) ]
.>(parToOne(rInvertA, rInvertB)) .to[ One ]
def lInvertPair[A, B, Ȧ, Ḃ](
lInvertA: One -⚬ (Ȧ |*| A),
lInvertB: One -⚬ (Ḃ |*| B),
): One -⚬ ((Ȧ |*| Ḃ) |*| (A |*| B)) =
id[One] .to[ One ]
.>(parFromOne(id, id)) .to[ One |*| One ]
.>(par(lInvertA, lInvertB)) .to[ (Ȧ |*| A) |*| (Ḃ |*| B) ]
.>(IXI) .to[ (Ȧ |*| Ḃ) |*| (A |*| B) ]
given pairDuality[A, B, Ȧ, Ḃ](using a: Dual[A, Ȧ], b: Dual[B, Ḃ]): Dual[A |*| B, Ȧ |*| Ḃ] with {
val lInvert: One -⚬ ((Ȧ |*| Ḃ) |*| (A |*| B)) =
lInvertPair(a.lInvert, b.lInvert)
val rInvert: ((A |*| B) |*| (Ȧ |*| Ḃ)) -⚬ One =
rInvertPair(a.rInvert, b.rInvert)
}
def rInvertEither[A, B, Ȧ, Ḃ](
rInvertA: (A |*| Ȧ) -⚬ One,
rInvertB: (B |*| Ḃ) -⚬ One,
): ((A |+| B) |*| (Ȧ |&| Ḃ)) -⚬ One =
id [ (A |+| B) |*| (Ȧ |&| Ḃ) ]
.>(matchingChoiceLR) .to[ (A |*| Ȧ) |+| (B |*| Ḃ) ]
.>(either(rInvertA, rInvertB)).to[ One ]
def lInvertChoice[A, B, Ȧ, Ḃ](
lInvertA: One -⚬ (Ȧ |*| A),
lInvertB: One -⚬ (Ḃ |*| B),
): One -⚬ ((Ȧ |&| Ḃ) |*| (A |+| B)) =
id [ One ]
.>(choice(lInvertA, lInvertB)).to[ (Ȧ |*| A) |&| (Ḃ |*| B) ]
.>(subordinateSnd) .to[ (Ȧ |&| Ḃ) |*| (A |+| B) ]
given eitherChoiceDuality[A, B, Ȧ, Ḃ](using a: Dual[A, Ȧ], b: Dual[B, Ḃ]): Dual[A |+| B, Ȧ |&| Ḃ] with {
val rInvert: ((A |+| B) |*| (Ȧ |&| Ḃ)) -⚬ One =
rInvertEither(a.rInvert, b.rInvert)
val lInvert: One -⚬ ((Ȧ |&| Ḃ) |*| (A |+| B)) =
lInvertChoice(a.lInvert, b.lInvert)
}
given choiceEitherDuality[A, B, Ȧ, Ḃ](using a: Dual[A, Ȧ], b: Dual[B, Ḃ]): Dual[A |&| B, Ȧ |+| Ḃ] =
dualSymmetric(eitherChoiceDuality(using dualSymmetric(a), dualSymmetric(b)))
given doneNeedDuality: Dual[Done, Need] with {
val rInvert: (Done |*| Need) -⚬ One = rInvertSignal
val lInvert: One -⚬ (Need |*| Done) = lInvertSignal
}
/** Evidence that if `A` is dual to `B`, then `F[A]` is dual to `G[B]`. */
trait Dual1[F[_], G[_]] {
def rInvert[A, Ā](rInvert: (A |*| Ā) -⚬ One): (F[A] |*| G[Ā]) -⚬ One
def lInvert[A, Ā](lInvert: One -⚬ (Ā |*| A)): One -⚬ (G[Ā] |*| F[A])
val rInvertVal: [x, y] => ((x |*| y) -⚬ One) => ((F[x] |*| G[y]) -⚬ One) =
[A, B] => (rInvert: (A |*| B) -⚬ One) => Dual1.this.rInvert(rInvert)
val lInvertVal: [x, y] => (One -⚬ (y |*| x)) => (One -⚬ (G[y] |*| F[x])) =
[A, B] => (lInvert: One -⚬ (B |*| A)) => Dual1.this.lInvert(lInvert)
def rInvertFlippedTAgs: [Ā, A] => (rInvert: (A |*| Ā) -⚬ One) => ((F[A] |*| G[Ā]) -⚬ One) =
[Ā, A] => (rInvert: (A |*| Ā) -⚬ One) => Dual1.this.rInvert[A, Ā](rInvert)
def lInvertFlippedTArgs: [Ā, A] => (lInvert: One -⚬ (Ā |*| A)) => (One -⚬ (G[Ā] |*| F[A])) =
[Ā, A] => (lInvert: One -⚬ (Ā |*| A)) => Dual1.this.lInvert[A, Ā](lInvert)
def apply[A, Ā](ev: Dual[A, Ā]): Dual[F[A], G[Ā]] =
new Dual[F[A], G[Ā]] {
val rInvert: (F[A] |*| G[Ā]) -⚬ One = Dual1.this.rInvert(ev.rInvert)
val lInvert: One -⚬ (G[Ā] |*| F[A]) = Dual1.this.lInvert(ev.lInvert)
}
}
def rInvertRec[F[_], G[_]](
rInvertSub: [x, y] => ((x |*| y) -⚬ One) => ((F[x] |*| G[y]) -⚬ One),
): (Rec[F] |*| Rec[G]) -⚬ One =
rec { self =>
par(unpack, unpack) > rInvertSub(self)
}
def lInvertRec[F[_], G[_]](
lInvertSub: [x, y] => (One -⚬ (x |*| y)) => (One -⚬ (F[x] |*| G[y])),
): One -⚬ (Rec[F] |*| Rec[G]) =
rec { self =>
lInvertSub(self) > par(pack, pack)
}
/** If `F[A]` is dual to `G[B]` for all dual pairs `A`, `B`, then `Rec[F]` is dual to `Rec[G]`. */
def dualRec[F[_], G[_]](ev: Dual1[F, G]): Dual[Rec[F], Rec[G]] =
new Dual[Rec[F], Rec[G]] {
val rInvert: (Rec[F] |*| Rec[G]) -⚬ One =
rInvertRec(ev.rInvertVal)
val lInvert: One -⚬ (Rec[G] |*| Rec[F]) =
lInvertRec(ev.lInvertFlippedTArgs)
}
opaque type Maybe[A] = One |+| A
object Maybe {
def empty[A]: One -⚬ Maybe[A] =
injectL
def just[A]: A -⚬ Maybe[A] =
injectR
def toEither[A]: Maybe[A] -⚬ (One |+| A) =
id
def map[A, B](f: A -⚬ B): Maybe[A] -⚬ Maybe[B] =
|+|.rmap(f)
def getOrElse[A](f: One -⚬ A): Maybe[A] -⚬ A =
either(f, id)
def discard[A](f: A -⚬ One): Maybe[A] -⚬ One =
either(id, f)
def discard[A](using A: Comonoid[A]): Maybe[A] -⚬ One =
discard(A.counit)
def neglect[A](f: A -⚬ Done): Maybe[A] -⚬ Done =
either(done, f)
def switchWithL[A, B, R](
caseNone: A -⚬ R,
caseJust: (A |*| B) -⚬ R,
): (A |*| Maybe[B]) -⚬ R =
distributeL > either(elimSnd > caseNone, caseJust)
def switchWithR[A, B, R](
caseNone: B -⚬ R,
caseJust: (A |*| B) -⚬ R,
): (Maybe[A] |*| B) -⚬ R =
distributeR > either(elimFst > caseNone, caseJust)
given monadMaybe: Monad[Maybe] =
new Monad[Maybe] {
override val category: Category[-⚬] =
dsl.category
override def lift[A, B](f: A -⚬ B): Maybe[A] -⚬ Maybe[B] =
|+|.bimap(id[One], f)
override def flatten[A]: Maybe[Maybe[A]] -⚬ Maybe[A] =
either(injectL, id[Maybe[A]])
override def pure[A]: A -⚬ Maybe[A] =
injectR
}
extension [A](ma: $[Maybe[A]])(using LambdaContext) {
def getOrElse(using pos: SourcePos)(ifEmpty: One -⚬ A): $[A] =
Maybe.getOrElse(ifEmpty)(ma)(using pos)
}
}
opaque type Optionally[A] = One |&| A
object Optionally {
def optOut[A]: Optionally[A] -⚬ One =
chooseL
def optIn[A]: Optionally[A] -⚬ A =
chooseR
def fromChoice[A]: (One |&| A) -⚬ Optionally[A] =
id
def fromDiscardable[A](discard: A -⚬ One): A -⚬ Optionally[A] =
choice(discard, id)
def fromAffine[A](using A: Affine[A]): A -⚬ Optionally[A] =
fromDiscardable(A.discard)
def apply[A](using SourcePos, LambdaContext)(a: $[A])(using A: Affine[A]): $[Optionally[A]] =
fromAffine[A](a) match
case ?(oa) => oa
extension [A](a: $[Optionally[A]])
def get(using SourcePos, LambdaContext): $[A] =
optIn(a)
given Functor[Optionally] with {
override val category = dsl.category
override def lift[A, B](f: A -⚬ B): Optionally[A] -⚬ Optionally[B] =
choice(optOut, optIn > f)
}
given affine[A]: Affine[Optionally[A]] with {
override def discard: Optionally[A] -⚬ One =
optOut[A]
}
}
opaque type PMaybe[A] = Done |+| A
object PMaybe {
def empty[A]: Done -⚬ PMaybe[A] =
injectL
def just[A]: A -⚬ PMaybe[A] =
injectR
def fromEither[A]: (Done |+| A) -⚬ PMaybe[A] =
id
def toEither[A]: PMaybe[A] -⚬ (Done |+| A) =
id
def switch[A, R](
caseNone: Done -⚬ R,
caseSome: A -⚬ R,
): PMaybe[A] -⚬ R =
either(caseNone, caseSome)
def switchWithL[A, B, R](
caseNone: (A |*| Done) -⚬ R,
caseSome: (A |*| B) -⚬ R,
): (A |*| PMaybe[B]) -⚬ R =
distributeL > either(caseNone, caseSome)
def switchWithR[A, B, R](
caseNone: (Done |*| B) -⚬ R,
caseSome: (A |*| B) -⚬ R,
): (PMaybe[A] |*| B) -⚬ R =
distributeR > either(caseNone, caseSome)
def getOrElse[A](f: Done -⚬ A): PMaybe[A] -⚬ A =
either(f, id)
def neglect[A](f: A -⚬ Done): PMaybe[A] -⚬ Done =
either(id, f)
def neglect[A](using A: CloseableCosemigroup[A]): PMaybe[A] -⚬ Done =
neglect(A.close)
def lift[A, B](f: A -⚬ B): PMaybe[A] -⚬ PMaybe[B] =
Bifunctor[|+|].lift(id, f)
}
def parFromOne[A, B](f: One -⚬ A, g: One -⚬ B): One -⚬ (A |*| B) =
introSnd[One] > par(f, g)
def parToOne[A, B](f: A -⚬ One, g: B -⚬ One): (A |*| B) -⚬ One =
par(f, g) > elimSnd[One]
private type MultipleF[A, X] = One |+| (A |+| (X |*| X))
/** Zero or more instances of `A`. The exact multiplicity is determined by the producer.
*
* Similar to [[LList]], but unlike [[LList]], the producer of [[Multiple]] is not required to unveil
* the elements sequentially. There are many different representations (in fact an infinite number)
* of the same sequence of elements of type `A` as `Multiple[A]`, while there is only one representation
* of that sequence as `LList[A]`.
*/
opaque type Multiple[A] = Rec[MultipleF[A, *]]
object Multiple {
def zero[A]: One -⚬ Multiple[A] =
injectL > pack[MultipleF[A, *]]
def one[A]: A -⚬ Multiple[A] =
injectL > injectR > pack[MultipleF[A, *]]
def append[A]: (Multiple[A] |*| Multiple[A]) -⚬ Multiple[A] =
injectR > injectR > pack[MultipleF[A, *]]
def switch[A, R](
case0: One -⚬ R,
case1: A -⚬ R,
caseN: (Multiple[A] |*| Multiple[A]) -⚬ R,
): Multiple[A] -⚬ R =
unpack[MultipleF[A, *]] > either(case0, either(case1, caseN))
def map[A, B](f: A -⚬ B): Multiple[A] -⚬ Multiple[B] = rec { self =>
switch(
case0 = zero,
case1 = f > one,
caseN = par(self, self) > append,
)
}
def flatten[A]: Multiple[Multiple[A]] -⚬ Multiple[A] = rec { self =>
switch(
case0 = zero,
case1 = id,
caseN = par(self, self) > append
)
}
given [A]: Monoid[Multiple[A]] with {
def unit : One -⚬ Multiple[A] = Multiple.zero
def combine : (Multiple[A] |*| Multiple[A]) -⚬ Multiple[A] = Multiple.append
}
given Monad[Multiple] with {
override val category: Category[-⚬] =
dsl.category
override def lift[A, B](f: A -⚬ B): Multiple[A] -⚬ Multiple[B] =
Multiple.map(f)
override def pure[A]: A -⚬ Multiple[A] =
Multiple.one
override def flatten[A]: Multiple[Multiple[A]] -⚬ Multiple[A] =
Multiple.flatten
}
}
private type UnlimitedF[A, X] = One |&| (A |&| (X |*| X))
/** Unlimited supply of `A`s. The consumer chooses how many `A`s to consume. */
opaque type Unlimited[A] = Rec[UnlimitedF[A, *]]
object Unlimited {
def apply[A](using SourcePos, LambdaContext)(a: $[A])(using Comonoid[A]): $[Unlimited[A]] =
fromComonoid[A](a) match
case *(ua) => ua
private def unpack[A]: Unlimited[A] -⚬ UnlimitedF[A, Unlimited[A]] =
dsl.unpack
def fromChoice[A]: (One |&| (A |&| (Unlimited[A] |*| Unlimited[A]))) -⚬ Unlimited[A] =
dsl.pack[UnlimitedF[A, *]]
def toChoice[A]: Unlimited[A] -⚬ (One |&| (A |&| (Unlimited[A] |*| Unlimited[A]))) =
unpack
def discard[A]: Unlimited[A] -⚬ One =
unpack > chooseL
def single[A]: Unlimited[A] -⚬ A =
unpack > chooseR > chooseL
def split[A]: Unlimited[A] -⚬ (Unlimited[A] |*| Unlimited[A]) =
unpack > chooseR > chooseR
def getFst[A]: Unlimited[A] -⚬ (A |*| Unlimited[A]) =
split > fst(single)
def getSnd[A]: Unlimited[A] -⚬ (Unlimited[A] |*| A) =
split > snd(single)
def getSome[A]: Unlimited[A] -⚬ (A |*| Unlimited[A]) =
getFst[A]
def create[X, A](
case0: X -⚬ One,
case1: X -⚬ A,
caseN: X -⚬ (Unlimited[A] |*| Unlimited[A]),
): X -⚬ Unlimited[A] =
choice(case0, choice(case1, caseN)) > pack[UnlimitedF[A, *]]
def createWith[X, A, Y](
case0: X -⚬ Y,
case1: X -⚬ (A |*| Y),
caseN: X -⚬ ((Unlimited[A] |*| Unlimited[A]) |*| Y),
): X -⚬ (Unlimited[A] |*| Y) =
choice(case0 > introFst, choice(case1, caseN) > coDistributeR) > coDistributeR > par(pack[UnlimitedF[A, *]], id)
def createWith[X: Cosemigroup, A, Y: Semigroup](
case0: X -⚬ Y,
case1: X -⚬ (A |*| Y),
): X -⚬ (Unlimited[A] |*| Y) = rec { self =>
createWith[X, A, Y](
case0 = case0,
case1 = case1,
caseN = summon[Cosemigroup[X]].split > par(self, self) > IXI > snd(summon[Semigroup[Y]].combine),
)
}
def fromComonoid[A](using A: Comonoid[A]): A -⚬ Unlimited[A] = rec { self =>
create(
case0 = A.discard,
case1 = id[A],
caseN = A.split > par(self, self),
)
}
def duplicate[A]: Unlimited[A] -⚬ Unlimited[Unlimited[A]] = rec { self =>
create(
case0 = discard,
case1 = id,
caseN = split > par(self, self)
)
}
def map[A, B](f: A -⚬ B): Unlimited[A] -⚬ Unlimited[B] = rec { self =>
create(
case0 = discard,
case1 = single[A] > f,
caseN = split[A] > par(self, self),
)
}
def zip[A, B]: (Unlimited[A] |*| Unlimited[B]) -⚬ Unlimited[A |*| B] = rec { self =>
create(
case0 = parToOne(discard[A], discard[B]),
case1 = par(single[A], single[B]),
caseN = par(split[A], split[B]) > IXI > par(self, self),
)
}
def unfold[S, A](f: S -⚬ (A |*| S)): S -⚬ (Unlimited[A] |*| S) =
id [ S ]
./>(Endless.unfold(f)) .to[ Endless[A] |*| S ]
./>.fst(Endless.toUnlimited[A]) .to[ Unlimited[A] |*| S ]
def discardWhenDone[A]: (Done |*| Unlimited[A]) -⚬ Done =
snd(unpack) > chooseLWhenDone > elimSnd
def singleWhenDone[A]: (Done |*| Unlimited[A]) -⚬ (Done |*| A) =
snd(unpack) > chooseRWhenDone > snd(chooseL)
def splitWhenDone[A]: (Done |*| Unlimited[A]) -⚬ (Done |*| (Unlimited[A] |*| Unlimited[A])) =
snd(unpack) > chooseRWhenDone > snd(chooseR)
def getFstWhenDone[A]: (Done |*| Unlimited[A]) -⚬ (Done |*| (A |*| Unlimited[A])) =
splitWhenDone > snd(fst(single))
def getSndWhenDone[A]: (Done |*| Unlimited[A]) -⚬ (Done |*| (Unlimited[A] |*| A)) =
splitWhenDone > snd(snd(single))
/** Present a non-empty list of resources `A` as an unlimited supply of "borrowed" resources `A ⊗ Ā`,
* where `Ā` is the dual of `A`. A borrowed resource `A ⊗ Ā` must be "returned" by "annihilating"
* `A` and its dual `Ā`, namely via an inversion on the right `A ⊗ Ā -⚬ One`.
* A returned resource will become available for further use when it signals readiness using the
* [[Signaling.Positive]] instance.
*
* When all accesses to the pooled resources (obtained via the `Unlimited[A |*| Ā]` in the first
* out-port) are closed, the resources are returned in the second out-port.
*/
def poolBy[A: Signaling.Positive, Ā](
lInvert: One -⚬ (Ā |*| A),
): LList1[A] -⚬ (Unlimited[A |*| Ā] |*| LList1[A]) =
unfold(LList1.borrow(lInvert))
def pool[A](using Signaling.Positive[A]): LList1[A] -⚬ (Unlimited[A |*| -[A]] |*| LList1[A]) =
Unlimited.poolBy[A, -[A]](forevert[A])
given comonoidUnlimited[A]: Comonoid[Unlimited[A]] with {
def counit : Unlimited[A] -⚬ One = Unlimited.discard
def split : Unlimited[A] -⚬ (Unlimited[A] |*| Unlimited[A]) = Unlimited.split
}
given Comonad[Unlimited] with {
override val category: Category[-⚬] =
dsl.category
override def lift[A, B](f: A -⚬ B): Unlimited[A] -⚬ Unlimited[B] =
Unlimited.map(f)
override def extract[A]: Unlimited[A] -⚬ A =
Unlimited.single
override def duplicate[A]: Unlimited[A] -⚬ Unlimited[Unlimited[A]] =
Unlimited.duplicate
}
/** Signals when the choice is made between [[discard]], [[single]] and [[split]]. */
given signalingUnlimited[A]: Signaling.Negative[Unlimited[A]] = {
val notifyFst: (Pong |*| Unlimited[A]) -⚬ Unlimited[A] =
par(id, unpack) > notifyChoiceAndRight > pack[UnlimitedF[A, *]]
Signaling.Negative.from(notifyFst)
}
given deferrableUnlimited[A]: Deferrable.Negative[Unlimited[A]] with {
override def awaitPongFst: Unlimited[A] -⚬ (Pong |*| Unlimited[A]) =
unpack > delayChoiceUntilPong > snd(pack[UnlimitedF[A, *]])
}
def toOptionally[A]: Unlimited[A] -⚬ Optionally[A] =
unpack > |&|.rmap(chooseL) > Optionally.fromChoice
extension [A](a: $[Unlimited[A]]) {
def optionally(using SourcePos, LambdaContext): $[Optionally[A]] =
import Optionally.affine
toOptionally(a) match { case ?(oa) => oa }
}
}
private type PUnlimitedF[A, X] = Done |&| (A |&| (X |*| X))
opaque type PUnlimited[A] = Rec[PUnlimitedF[A, *]]
object PUnlimited {
def neglect[A]: PUnlimited[A] -⚬ Done =
unpack[PUnlimitedF[A, *]] > chooseL
def single[A]: PUnlimited[A] -⚬ A =
unpack[PUnlimitedF[A, *]] > chooseR > chooseL
def split[A]: PUnlimited[A] -⚬ (PUnlimited[A] |*| PUnlimited[A]) =
unpack[PUnlimitedF[A, *]] > chooseR > chooseR
def getFst[A]: PUnlimited[A] -⚬ (A |*| PUnlimited[A]) =
split > fst(single)
def getSnd[A]: PUnlimited[A] -⚬ (PUnlimited[A] |*| A) =
split > snd(single)
def create[X, A](
case0: X -⚬ Done,
case1: X -⚬ A,
caseN: X -⚬ (PUnlimited[A] |*| PUnlimited[A]),
): X -⚬ PUnlimited[A] =
choice(case0, choice(case1, caseN)) > pack[PUnlimitedF[A, *]]
def createWith[X, A, Y](
case0: X -⚬ (Done |*| Y),
case1: X -⚬ (A |*| Y),
caseN: X -⚬ ((PUnlimited[A] |*| PUnlimited[A]) |*| Y),
): X -⚬ (PUnlimited[A] |*| Y) =
choice(case0, choice(case1, caseN) > coDistributeR) > coDistributeR > par(pack[PUnlimitedF[A, *]], id)
def map[A, B](f: A -⚬ B): PUnlimited[A] -⚬ PUnlimited[B] = rec { self =>
create(
case0 = neglect,
case1 = single > f,
caseN = split > par(self, self)
)
}
def duplicate[A]: PUnlimited[A] -⚬ PUnlimited[PUnlimited[A]] = rec { self =>
create(
case0 = neglect,
case1 = id,
caseN = split > par(self, self)
)
}
given closeableCosemigroupPUnlimited[A]: CloseableCosemigroup[PUnlimited[A]] =
new CloseableCosemigroup[PUnlimited[A]] {
def close : PUnlimited[A] -⚬ Done = PUnlimited.neglect
def split : PUnlimited[A] -⚬ (PUnlimited[A] |*| PUnlimited[A]) = PUnlimited.split
}
given comonadPUnlimited: Comonad[PUnlimited] =
new Comonad[PUnlimited] {
override val category: Category[-⚬] =
dsl.category
override def lift[A, B](f: A -⚬ B): PUnlimited[A] -⚬ PUnlimited[B] =
PUnlimited.map(f)
override def extract[A]: PUnlimited[A] -⚬ A =
PUnlimited.single
override def duplicate[A]: PUnlimited[A] -⚬ PUnlimited[PUnlimited[A]] =
PUnlimited.duplicate
}
}
trait NAffine[A] {
def deflate: A -⚬ Need
}
object NAffine {
def from[A](f: A -⚬ Need): NAffine[A] =
new NAffine[A] {
override def deflate: A -⚬ Need =
f
}
given NAffine[Need] =
from(id)
given [A, B](using A: NAffine[A], B: NAffine[B]): NAffine[A |*| B] =
from(par(A.deflate, B.deflate) > forkNeed)
}
trait Closeable[A] {
def close: A -⚬ Done
}
object Closeable {
def from[A](f: A -⚬ Done): Closeable[A] =
new Closeable[A] {
override def close: A -⚬ Done =
f
}
given fromAffine[A](using A: Affine[A]): Closeable[A] =
from(A.discard > done)
given closeableDone: Closeable[Done] =
from(id)
given closeablePing: Closeable[Ping] =
from(strengthenPing)
given closeablePair[A, B](using A: Closeable[A], B: Closeable[B]): Closeable[A |*| B] =
from(par(A.close, B.close) > join)
given closeableEither[A, B](using A: Closeable[A], B: Closeable[B]): Closeable[A |+| B] =
from(either(A.close, B.close))
}
trait Semigroup[A] {
def combine: (A |*| A) -⚬ A
def law_associativity: Equal[ ((A |*| A) |*| A) -⚬ A ] =
Equal(
par(combine, id[A]) > combine,
assocLR > par(id[A], combine) > combine,
)
}
object Semigroup {
given Semigroup[Done] with {
override def combine: (Done |*| Done) -⚬ Done = join
}
given Semigroup[Ping] with {
override def combine: (Ping |*| Ping) -⚬ Ping = joinPing
}
given Semigroup[Need] with {
override def combine: (Need |*| Need) -⚬ Need = forkNeed
}
given Semigroup[Pong] with {
override def combine: (Pong |*| Pong) -⚬ Pong = forkPong
}
}
def combine[A: Semigroup]: (A |*| A) -⚬ A =
summon[Semigroup[A]].combine
def combineMap[A, B, C: Semigroup](f: A -⚬ C, g: B -⚬ C): (A |*| B) -⚬ C =
par(f, g) > combine[C]
extension [A, C](f: A -⚬ C) {
/** Combines the outputs of left and right operand. */
def \/[B](g: B -⚬ C)(using Semigroup[C]): (A |*| B) -⚬ C =
combineMap(f, g)
}
def split[A: Cosemigroup]: A -⚬ (A |*| A) =
summon[Cosemigroup[A]].split
def splitMap[A: Cosemigroup, B, C](f: A -⚬ B, g: A -⚬ C): A -⚬ (B |*| C) =
split[A] > par(f, g)
extension [A, B](f: A -⚬ B) {
/** Splits the input and pipes the two halves to the left and right operand. */
def /\[C](g: A -⚬ C)(using Cosemigroup[A]): A -⚬ (B |*| C) =
splitMap(f, g)
}
trait Monoid[A] extends Semigroup[A] {
def unit: One -⚬ A
def law_leftUnit: Equal[ (One |*| A) -⚬ A ] =
Equal(
par(unit, id[A]) > this.combine,
elimFst,
)
def law_rightUnit: Equal[ (A |*| One) -⚬ A ] =
Equal(
par(id[A], unit) > this.combine,
elimSnd,
)
}
object Monoid {
given Monoid[One] with {
override def unit : One -⚬ One = id
override def combine: (One |*| One) -⚬ One = elimSnd[One]
}
given Monoid[Done] with {
override def unit : One -⚬ Done = done
override def combine: (Done |*| Done) -⚬ Done = join
}
given Monoid[Ping] with {
override def unit : One -⚬ Ping = ping
override def combine: (Ping |*| Ping) -⚬ Ping = joinPing
}
}
/** A [[Monoid]] whose [[unit]] can be chained after a signal flowing in the '''P'''ositive direction ([[Done]]),
* effectively taking on the responsibility to wait for completion of some computation.
*
* Its dual is [[NComonoid]].
*/
trait PMonoid[A] extends Semigroup[A] {
def unit: Done -⚬ A
def monoid: Monoid[A] = new Monoid[A] {
def combine: (A |*| A) -⚬ A = PMonoid.this.combine
def unit: One -⚬ A = done > PMonoid.this.unit
}
def law_leftUnit: Equal[ (One |*| A) -⚬ A ] =
Equal(
par(done > unit, id[A]) > this.combine,
elimFst,
)
def law_rightUnit: Equal[ (A |*| One) -⚬ A ] =
Equal(
par(id[A], done > unit) > this.combine,
elimSnd,
)
}
/** A [[Comonoid]] whose [[counit]] can be chained before a signal flowing in the '''N'''egative direction ([[Need]]),
* effectively taking on the responsibility to await completion of some computation.
*
* The dual of [[PMonoid]].
*/
trait NComonoid[A] extends Cosemigroup[A] with NAffine[A] {
def counit: A -⚬ Need
override def deflate: A -⚬ Need =
counit
def comonoid: Comonoid[A] = new Comonoid[A] {
def split: A -⚬ (A |*| A) = NComonoid.this.split
def counit: A -⚬ One = NComonoid.this.counit > need
}
def law_leftCounit: Equal[ A -⚬ (One |*| A) ] =
Equal(
this.split > par(counit > need, id[A]),
introFst,
)
def law_rightCounit: Equal[ A -⚬ (A |*| One) ] =
Equal(
this.split > par(id[A], counit > need),
introSnd,
)
}
/** A weaker version of [[Monoid]] whose [[unit]] creates a liability - a signal traveling in the '''N'''egative
* direction ([[Need]]) that eventually needs to be awaited.
*
* Its dual is [[PComonoid]].
*/
trait NMonoid[A] extends Semigroup[A] {
def unit: Need -⚬ A
def law_leftUnit: Equal[ (LTerminus |*| A) -⚬ A ] =
Equal(
par(regressInfinitely > unit, id[A]) > this.combine,
id[LTerminus |*| A] > elimFst(regressInfinitely > need),
)
def law_rightUnit: Equal[ (A |*| LTerminus) -⚬ A ] =
Equal(
par(id[A], regressInfinitely > unit) > this.combine,
id[A |*| LTerminus] > elimSnd(regressInfinitely > need),
)
}
object NMonoid {
given NMonoid[Need] with {
override def combine : (Need |*| Need) -⚬ Need = forkNeed
override def unit : Need -⚬ Need = id
}
}
/** A weaker version of [[Comonoid]] where the input cannot be discarded completely, but can be reduced to
* a signal traveling in the positive direction ([[Done]]) that eventually needs to be awaited.
*
* The dual of [[NMonoid]].
*/
trait CloseableCosemigroup[A] extends Cosemigroup[A] with Closeable[A] {
def law_leftCounit: Equal[ A -⚬ (RTerminus |*| A) ] =
Equal(
this.split > par(close > delayIndefinitely, id[A]),
id[A] > introFst(done > delayIndefinitely),
)
def law_rightCounit: Equal[ A -⚬ (A |*| RTerminus) ] =
Equal(
this.split > par(id[A], close > delayIndefinitely),
id[A] > introSnd(done > delayIndefinitely),
)
}
object CloseableCosemigroup {
given closeableCosemigroupDone: CloseableCosemigroup[Done] with {
override def split : Done -⚬ (Done |*| Done) = fork
override def close : Done -⚬ Done = id
}
}
type Monad[F[_]] =
libretto.cats.Monad[-⚬, F]
type Comonad[F[_]] =
libretto.cats.Comonad[-⚬, F]
def getFst[A, B](using A: Cosemigroup[A]): (A |*| B) -⚬ (A |*| (A |*| B)) =
id [ A |*| B ]
./>.fst(A.split) .to[ (A |*| A) |*| B ]
./>(assocLR) .to[ A |*| (A |*| B) ]
def getSnd[A, B](using B: Cosemigroup[B]): (A |*| B) -⚬ (B |*| (A |*| B)) =
id [ A |*| B ]
./>.snd(B.split) .to[ A |*| (B |*| B) ]
./>(assocRL) .to[ (A |*| B) |*| B ]
./>(swap) .to[ B |*| (A |*| B) ]
def discardFst[A, B](using A: Comonoid[A]): (A |*| B) -⚬ B =
elimFst(A.counit)
def discardSnd[A, B](using B: Comonoid[B]): (A |*| B) -⚬ A =
elimSnd(B.counit)
private type LListF[T, X] = One |+| (T |*| X)
opaque type LList[T] = Rec[LListF[T, *]]
object LList {
def Nil[T] : Extractor[-⚬, |*|, LList[T], One ] = InL.afterUnpack
def Cons[T]: Extractor[-⚬, |*|, LList[T], T |*| LList[T]] = InR.afterUnpack
private def unpack[T]: LList[T] -⚬ LListF[T, LList[T]] = dsl.unpack
private def pack[T] : LListF[T, LList[T]] -⚬ LList[T] = dsl.pack
def nil[T]: One -⚬ LList[T] =
Nil[T].reinject
def cons[T]: (T |*| LList[T]) -⚬ LList[T] =
Cons[T].reinject
def singleton[T]: T -⚬ LList[T] =
λ { t => Cons(t |*| Nil($.one)) }
def uncons[T]: LList[T] -⚬ (One |+| (T |*| LList[T])) =
unpack
/** Signals when it is decided whether the list is empty (nil) or has an element (cons). */
given [T]: Signaling.Positive[LList[T]] =
Signaling.Positive.from(unpack > notifyEither > par(id, pack))
def fromList0[S, T](fs: List[S -⚬ T])(using S: Cosemigroup[S]): S -⚬ (S |*| LList[T]) = {
@tailrec def go(rfs: List[S -⚬ T], acc: S -⚬ (S |*| LList[T])): S -⚬ (S |*| LList[T]) =
rfs match {
case head :: tail => go(tail, S.split > par(id, acc > par(head, id) > cons))
case scala.Nil => acc
}
go(fs.reverse, id[S] > introSnd(nil[T]))
}
def fromList[S, T](fs: List[S -⚬ T])(using S: Comonoid[S]): S -⚬ LList[T] =
fromList0(fs) > discardFst
def fromListU[S, T](fs: List[S -⚬ T]): Unlimited[S] -⚬ LList[T] = {
import Unlimited.given
fromList(fs map (Unlimited.single > _))
}
def of[S, T](fs: (S -⚬ T)*)(using S: Comonoid[S]): S -⚬ LList[T] =
fromList(fs.toList)
def unfold[S, T](f: S -⚬ (One |+| (T |*| S))): S -⚬ LList[T] =
λ.rec { self => s =>
switch ( f(s) )
.is { case InL(u) => Nil(u) }
.is { case InR(t |*| s) => Cons(t |*| self(s)) }
.end
}
def fill[S, T](n: Int)(f: S -⚬ T)(using Comonoid[S]): S -⚬ LList[T] = {
require(n >= 0, s"n must be non-negative, was $n")
fromList(List.fill(n)(f))
}
def fill0[S, T](n: Int)(f: S -⚬ T)(using Cosemigroup[S]): S -⚬ (S |*| LList[T]) = {
require(n >= 0, s"n must be non-negative, was $n")
fromList0(List.fill(n)(f))
}
@deprecated("Use pattern matching")
def switchWithL[A, T, R](
caseNil: A -⚬ R,
caseCons: (A |*| (T |*| LList[T])) -⚬ R,
): (A |*| LList[T]) -⚬ R =
par(id, uncons[T]) > distributeL > either(elimSnd > caseNil, caseCons)
def map[T, U](f: T -⚬ U): LList[T] -⚬ LList[U] =
λ.rec { self => ts =>
switch(ts)
.is { case Nil(u) => Nil(u) }
.is { case Cons(t |*| ts) => Cons(f(t) |*| self(ts)) }
.end
}
def flatMapConcat[A, B](f: A -⚬ LList[B]): LList[A] -⚬ LList[B] =
λ.rec { self => as =>
switch(as)
.is { case Nil(u) => Nil(u) }
.is { case Cons(a |*| as) => concat(f(a) |*| self(as)) }
.end
}
def flatMapMerge[A, B](f: A -⚬ LList[B]): LList[A] -⚬ LList[B] =
λ.rec { self => as =>
switch(as)
.is { case Nil(u) => Nil(u) }
.is { case Cons(a |*| as) => merge(f(a) |*| self(as)) }
.end
}
/** Alias for [[flatMapConcat]]. */
def flatMap[A, B](f: A -⚬ LList[B]): LList[A] -⚬ LList[B] =
flatMapConcat(f)
def mapS[S, T, U](f: (S |*| T) -⚬ (S |*| U)): (S |*| LList[T]) -⚬ (S |*| LList[U]) =
λ.rec { self => { case s |*| ts =>
switch(ts)
.is { case Nil(u) =>
s |*| Nil(u)
}
.is { case Cons(t |*| ts) =>
val s1 |*| u = f(s |*| t)
val s2 |*| us = self(s1 |*| ts)
s2 |*| Cons(u |*| us)
}
.end
}}
def mapSAppend[S, T, U](f: (S |*| T) -⚬ (S |*| U), tail: S -⚬ LList[U]): (S |*| LList[T]) -⚬ LList[U] =
λ.rec { self => { case s |*| ts =>
switch(ts)
.is { case Nil(?(_)) => tail(s) }
.is { case Cons(t |*| ts) =>
val s1 |*| u = f(s |*| t)
val us = self(s1 |*| ts)
Cons(u |*| us)
}
.end
}}
def foldMap0[T, U](f: T -⚬ U)(using U: Semigroup[U]): LList[T] -⚬ Maybe[U] =
λ { ts =>
switch(ts)
.is { case Nil(u) => Maybe.empty[U](u) }
.is { case Cons(t |*| ts) => Maybe.just(foldL[U, T](snd(f) > U.combine)(f(t) |*| ts)) }
.end
}
def foldMap[T, U](f: T -⚬ U)(using U: Monoid[U]): LList[T] -⚬ U =
λ.rec { self => ts =>
switch(ts)
.is { case Nil(u) => U.unit(u) }
.is { case Cons(t |*| ts) => U.combine(f(t) |*| self(ts)) }
.end
}
def fold0[T](using T: Semigroup[T]): LList[T] -⚬ Maybe[T] =
foldMap0(id[T])
def fold[T](using T: Monoid[T]): LList[T] -⚬ T =
foldMap(id[T])
def foldL[S, T](f: (S |*| T) -⚬ S): (S |*| LList[T]) -⚬ S =
λ.rec { self => { case s |*| ts =>
switch(ts)
.is { case Nil(?(_)) => s }
.is { case Cons(t |*| ts) => self(f(s |*| t) |*| ts) }
.end
}}
def concat[T]: (LList[T] |*| LList[T]) -⚬ LList[T] =
λ.rec { self => { case xs |*| ys =>
switch(xs)
.is { case Nil(?(_)) => ys }
.is { case Cons(x |*| xs) => Cons(x |*| self(xs |*| ys)) }
.end
}}
def partition[A, B]: LList[A |+| B] -⚬ (LList[A] |*| LList[B]) =
λ.rec { self => xs =>
switch(xs)
.is { case Nil(?(_)) => constant(nil[A]) |*| constant(nil[B]) }
.is { case Cons(x |*| t) =>
val as |*| bs = self(t)
switch ( x )
.is { case InL(a) => cons(a |*| as) |*| bs }
.is { case InR(b) => as |*| cons(b |*| bs) }
.end
}
.end
}
def consMaybe[T]: (Maybe[T] |*| LList[T]) -⚬ LList[T] =
id[Maybe[T] |*| LList[T]] .to[ (One |+| T) |*| LList[T] ]
.>(distributeR) .to[ (One |*| LList[T]) |+| (T |*| LList[T]) ]
.>(either(elimFst, cons)) .to[ LList[T] ]
def collect[T, U](f: T -⚬ Maybe[U]): LList[T] -⚬ LList[U] =
λ.rec { self => ts =>
switch(ts)
.is { case Nil(u) => Nil(u) }
.is { case Cons(t |*| ts) => consMaybe(f(t) |*| self(ts)) }
.end
}
def transform[T, A, U](f: (A |*| T) -⚬ U)(using A: Comonoid[A]): (A |*| LList[T]) -⚬ LList[U] =
rec { self =>
val caseNil: A -⚬ LList[U] =
A.discard > nil[U]
val caseCons: (A |*| (T |*| LList[T])) -⚬ LList[U] =
par(A.split, id) > IXI > par(f, self) > cons[U]
switchWithL(caseNil, caseCons)
}
def transform0[T, A, U](f: (A |*| T) -⚬ U)(using Cosemigroup[A]): (A |*| LList[T]) -⚬ (A |*| LList[U]) = {
def go: (A |*| (T |*| LList[T])) -⚬ LList[U] =
rec { go =>
assocRL > switchWithL(
f > singleton,
λ { case (+(a) |*| t0) |*| ts1 =>
cons(f(a |*| t0) |*| go(a |*| ts1))
},
)
}
switchWithL(
introSnd(nil[U]),
λ { case (+(a) |*| ts1) => a |*| go(a |*| ts1) }
)
}
def transform1[T, A, U](f: (A |*| T) -⚬ U)(using Cosemigroup[A]): (A |*| LList[T]) -⚬ (A |+| LList1[U]) =
switchWithL(
injectL,
snd(LList1.cons) > LList1.transform(f) > injectR,
)
def transformCollect[T, A, U](f: (A |*| T) -⚬ Maybe[U])(using A: Comonoid[A]): (A |*| LList[T]) -⚬ LList[U] =
rec { self =>
val caseNil: A -⚬ LList[U] =
A.discard > nil[U]
val caseCons: (A |*| (T |*| LList[T])) -⚬ LList[U] =
par(A.split, id) > IXI > par(f, self) > consMaybe[U]
switchWithL(caseNil, caseCons)
}
def unzip[A, B]: LList[A |*| B] -⚬ (LList[A] |*| LList[B]) =
λ.rec { self => xs =>
switch(xs)
.is { case Nil(*(u)) => Nil(u) |*| Nil(u) }
.is { case Cons((a |*| b) |*| xs) =>
val as |*| bs = self(xs)
Cons(a |*| as) |*| Cons(b |*| bs)
}
.end
}
def splitAt[A](i: Int): LList[A] -⚬ (LList[A] |*| LList[A]) = {
require(i >= 0, s"i must not be negative, was $i")
if (i == 0)
introFst(LList.nil[A])
else
uncons > either(
parFromOne(LList.nil[A], LList.nil[A]),
snd(splitAt(i-1)) > assocRL > fst(cons),
)
}
def splitEvenOdd[A]: LList[A] -⚬ (LList[A] |*| LList[A]) =
λ.rec { self => as =>
switch(as)
.is { case Nil(*(u)) => Nil(u) |*| Nil(u) }
.is { case Cons(a |*| Nil(u)) => singleton[A](a) |*| Nil(u) }
.is { case Cons(a0 |*| Cons(a1 |*| as)) =>
val as0 |*| as1 = self(as)
Cons(a0 |*| as0) |*| Cons(a1 |*| as1)
}
.end
}
private def waveL[A, S, B](
init: A -⚬ S,
f: (S |*| A) -⚬ (B |*| S),
last: S -⚬ B,
): LList[A] -⚬ LList[B] =
λ { as =>
switch(as)
.is { case Nil(u) => Nil(u) }
.is { case Cons(a |*| as) =>
val s0 = init(a)
mapSAppend(f > swap, last > singleton)(s0 |*| as)
}
.end
}
/** Shifts all the elements of a list by "half" to the left,
* moving the first half of the first element to the end of the list.
*
* Example:
*
* Before:
* ```
* (a1, b1), (a2, b2), (a3, b3)
* ```
*
* After:
* ```
* (b1, a2), (b2, a3), (b3, a1)
* ```
*/
def halfRotateL[A, B]: LList[A |*| B] -⚬ LList[B |*| A] = {
val f: ((B |*| A) |*| (A |*| B)) -⚬ ((B |*| A) |*| (B |*| A)) =
IXI > snd(swap)
waveL[A |*| B, B |*| A, B |*| A](
init = swap,
f = f,
last = id,
)
}
/** Creates a singleton list that will appear as undecided (between nil and cons)
* until the element signals.
*/
def singletonOnSignal[T](using T: Signaling.Positive[T]): T -⚬ LList[T] =
id [ T ]
.>(T.notifyPosFst) .to[ Ping |*| T ]
.>(par(id, introSnd(nil[T]))) .to[ Ping |*| (T |*| LList[T]) ]
.>(injectROnPing) .to[ One |+| (T |*| LList[T]) ]
.>(pack) .to[ LList[T] ]
/** Merges the two lists as they unfold, i.e. as soon as the next element becomes available in one of the lists,
* it also becomes available as the next element of the result list.
*/
def merge[T]: (LList[T] |*| LList[T]) -⚬ LList[T] = λ.rec { self =>
{ case as |*| bs =>
switch ( race(as |*| bs) )
.is { case InL(as |*| bs) =>
dsl.switch ( uncons(as) )
.is { case InL(?(one)) => bs }
.is { case InR(a |*| as) => cons(a |*| self(as |*| bs)) }
.end
}
.is { case InL(as |*| bs) =>
dsl.switch ( uncons(bs) )
.is { case InL(?(one)) => as }
.is { case InR(b |*| bs) => cons(b |*| self(as |*| bs)) }
.end
}
.end
}
}
/** Inserts an element to a list as soon as the element signals.
* If _m_ elements of the input list become available before the new element signals,
* the new element will appear as the _(m+1)_-th element in the output list.
* Note: The _m_ elements from the input list are not awaited to signal;
* their timely appearence in the input list is sufficient for them to come before
* the inserted element.
*/
def insertBySignal[T](using Signaling.Positive[T]): (T |*| LList[T]) -⚬ LList[T] =
λ.rec { self =>
{ case a |*| as =>
switch ( race[T, LList[T]](a |*| as) )
.is { case InL(a |*| as) =>
cons(a |*| as)
}
.is { case InR(a |*| as) =>
switch ( uncons(as) )
.is { case InL(?(one)) => singletonOnSignal(a) }
.is { case InR(a1 |*| as) => cons(a1 |*| self(a |*| as)) }
.end
}
.end
}
}
/** Make the elements of the input list available in the output list in the order in which they signal. */
def sortBySignal[T](using Signaling.Positive[T]): LList[T] -⚬ LList[T] = rec { self =>
// XXX O(n^2) complexity: if the element at the end of the list signals first, it will take O(n) steps for it
// to bubble to the front. Could be improved to O(log(n)) steps to bubble any element and O(n*log(n)) total
// complexity by using a heap data structure.
λ { as =>
dsl.switch ( uncons(as) )
.is { case InL(one) => nil(one) }
.is { case InR(a |*| as) => insertBySignal(a |*| self(as)) }
.end
}
}
given [A]: Monoid[LList[A]] with {
def unit : One -⚬ LList[A] = nil
def combine : (LList[A] |*| LList[A]) -⚬ LList[A] = concat
}
}
/** Non-empty list, i.e. a list with at least one element. */
opaque type LList1[T] = T |*| LList[T]
object LList1 {
def apply[T](x: $[T], xs: $[T]*)(using LambdaContext): $[LList1[T]] =
fromExprList(x, xs.toList)
def fromExprList[T](h: $[T], t: List[$[T]])(using LambdaContext): $[LList1[T]] =
t match {
case Nil => singleton(h)
case (x :: xs) => cons1(h |*| fromExprList(x, xs))
}
def cons[T]: (T |*| LList[T]) -⚬ LList1[T] =
id
def toLList[T]: LList1[T] -⚬ LList[T] =
LList.cons[T]
def cons1[T]: (T |*| LList1[T]) -⚬ LList1[T] =
par(id, toLList)
def singleton[T]: T -⚬ LList1[T] =
introSnd(LList.nil[T])
def uncons[T]: LList1[T] -⚬ (T |*| LList[T]) =
id
def switch[T, R](
case1: T -⚬ R,
caseN: (T |*| LList1[T]) -⚬ R,
): LList1[T] -⚬ R =
LList.switchWithL(case1, caseN)
def from[S, T](head: S -⚬ T, tail: List[S -⚬ T])(using S: Cosemigroup[S]): S -⚬ LList1[T] =
LList.fromList0(tail) > par(head, id) > cons
def from[S, T](fs: NonEmptyList[S -⚬ T])(using S: Cosemigroup[S]): S -⚬ LList1[T] =
from(fs.head, fs.tail)
def of[S, T](head: S -⚬ T, tail: (S -⚬ T)*)(using S: Cosemigroup[S]): S -⚬ LList1[T] =
from(head, tail.toList)
def unfold[S, T](f: S -⚬ (T |*| Maybe[S])): S -⚬ LList1[T] =
λ { s =>
val (h |*| sOpt) = f(s)
val tail: $[LList[T]] = LList.unfold[Maybe[S], T](Maybe.map(f))(sOpt)
cons(h |*| tail)
}
def fill[S, T](n: Int)(f: S -⚬ T)(using Cosemigroup[S]): S -⚬ LList1[T] = {
require(n >= 1, s"n must be positive, was $n")
from(f, List.fill(n-1)(f))
}
def map[T, U](f: T -⚬ U): LList1[T] -⚬ LList1[U] =
par(f, LList.map(f))
def mapS[S, T, U](f: (S |*| T) -⚬ (S |*| U)): (S |*| LList1[T]) -⚬ (S |*| LList1[U]) =
assocRL > fst(f > swap) > assocLR > snd(LList.mapS(f)) > XI
def mapSAppend[S, T, U](f: (S |*| T) -⚬ (S |*| U), tail: S -⚬ LList[U]): (S |*| LList1[T]) -⚬ LList1[U] =
assocRL > fst(f > swap) > assocLR > snd(LList.mapSAppend(f, tail))
def foldMap[T, U](f: T -⚬ U)(using U: Semigroup[U]): LList1[T] -⚬ U =
par(f, id) > LList.foldL[U, T](par(id, f) > U.combine)
def fold[T](using T: Semigroup[T]): LList1[T] -⚬ T =
LList.foldL[T, T](T.combine)
def closeAll[T](using T: Closeable[T]): LList1[T] -⚬ Done =
foldMap(T.close)
def transform[T, A, U](f: (A |*| T) -⚬ U)(using A: Cosemigroup[A]): (A |*| LList1[T]) -⚬ LList1[U] =
λ { case a |*| (t0 |*| ts) =>
val a1 |*| us = LList.transform0(f)(a |*| ts)
f(a1 |*| t0) |*| us
}
/** Shifts all the elements of a list by "half" to the left,
* moving the first half of the first element to the end of the list.
*
* Example:
*
* Before:
* ```
* (a1, b1), (a2, b2), (a3, b3)
* ```
*
* After:
* ```
* (b1, a2), (b2, a3), (b3, a1)
* ```
*/
def halfRotateL[A, B]: LList1[A |*| B] -⚬ LList1[B |*| A] = {
val f: ((A |*| B) |*| (A |*| B)) -⚬ ((A |*| B) |*| (B |*| A)) =
snd(swap) > IXI
switch(
case1 = swap > singleton[B |*| A],
caseN = mapSAppend[A |*| B, A |*| B, B |*| A](f, swap[A, B] > LList.singleton),
)
}
/** Inserts an element to a list as soon as the element signals.
* If _m_ elements of the input list become available before the new element signals,
* the new element will appear as the _(m+1)_-th element in the output list.
* Note: The _m_ elements from the input list are not awaited to signal;
* their timely appearence in the input list is sufficient for them to come before
* the inserted element.
*/
def insertBySignal[T](using Signaling.Positive[T]): (T |*| LList[T]) -⚬ LList1[T] = {
import LList.given
raceSwitch(
caseFstWins = cons[T],
caseSndWins = LList.switchWithL(
caseNil = singleton[T],
caseCons = XI > par(id, LList.insertBySignal[T]),
),
)
}
def sortBySignal[A](using Signaling.Positive[A]): LList1[A] -⚬ LList1[A] =
λ { case a |*| as => insertBySignal(a |*| LList.sortBySignal(as)) }
def unzip[A, B]: LList1[A |*| B] -⚬ (LList1[A] |*| LList1[B]) =
switch(
par(singleton, singleton),
λ { case (a |*| b) |*| tail =>
val as |*| bs = LList.unzip(LList.cons(tail))
cons(a |*| as) |*| cons(b |*| bs)
}
)
def unzipBy[T, A, B](f: T -⚬ (A |*| B)): LList1[T] -⚬ (LList1[A] |*| LList1[B]) =
map(f) > unzip
def borrow[A, Ā](
lInvert: One -⚬ (Ā |*| A),
)(using
Signaling.Positive[A],
): LList1[A] -⚬ ((A |*| Ā) |*| LList1[A]) =
λ { case a |*| as =>
val na |*| a1 = constant(lInvert)
(a |*| na) |*| insertBySignal(a1 |*| as)
}
def eachNotifyBy[A](notify: A -⚬ (Ping |*| A)): LList1[A] -⚬ (Ping |*| LList1[A]) =
unzipBy(notify) > fst(fold)
def eachNotify[A](using A: Signaling.Positive[A]): LList1[A] -⚬ (Ping |*| LList1[A]) =
eachNotifyBy(A.notifyPosFst)
def eachAwaitBy[A](await: (Done |*| A) -⚬ A): (Done |*| LList1[A]) -⚬ LList1[A] =
transform[A, Done, A](await)
def eachAwait[A](using A: Junction.Positive[A]): (Done |*| LList1[A]) -⚬ LList1[A] =
eachAwaitBy(A.awaitPosFst)
}
/** An endless source of elements, where the consumer decides whether to pull one more element or close.
* Dual to [[LList]], in which the producer decides how many elements will be produced.
*/
opaque type Endless[A] = Rec[[X] =>> One |&| (A |*| X)]
object Endless {
private def pack[A]: (One |&| (A |*| Endless[A])) -⚬ Endless[A] =
dsl.pack[[X] =>> One |&| (A |*| X)]
private def unpack[A]: Endless[A] -⚬ (One |&| (A |*| Endless[A])) =
dsl.unpack
def fromChoice[A]: (One |&| (A |*| Endless[A])) -⚬ Endless[A] =
pack
def toChoice[A]: Endless[A] -⚬ (One |&| (A |*| Endless[A])) =
dsl.unpack
def close[A]: Endless[A] -⚬ One =
unpack > chooseL
def pull[A]: Endless[A] -⚬ (A |*| Endless[A]) =
unpack > chooseR
def pullOnPing[A]: (Ping |*| Endless[A]) -⚬ (A |*| Endless[A]) =
snd(unpack) > delayChoiceUntilPing > chooseR
def create[X, A](
onClose: X -⚬ One,
onPull: X -⚬ (A |*| Endless[A]),
): X -⚬ Endless[A] =
choice(onClose, onPull) > pack[A]
def createWith[X, A, Y](
onClose: X -⚬ Y,
onPull: X -⚬ ((A |*| Endless[A]) |*| Y),
): X -⚬ (Endless[A] |*| Y) =
choice(onClose > introFst, onPull) > coDistributeR > par(pack, id)
def fromUnlimited[A]: Unlimited[A] -⚬ Endless[A] = rec { self =>
create(
onClose = Unlimited.discard,
onPull = Unlimited.getSome > snd(self)
)
}
def unfold[S, A](f: S -⚬ (A |*| S)): S -⚬ (Endless[A] |*| S) = rec { self =>
createWith[S, A, S](
onClose = id[S],
onPull = f > par(id, self) > assocRL,
)
}
/** Signals when the consumer makes a choice, i.e. [[close]] or [[pull]]. */
given [A]: Signaling.Negative[Endless[A]] =
Signaling.Negative.from(par(id, unpack) > notifyChoice > pack)
def split[A]: Endless[A] -⚬ (Endless[A] |*| Endless[A]) = rec { self =>
val onFstAction: Endless[A] -⚬ (Endless[A] |*| Endless[A]) = {
val onClose: Endless[A] -⚬ (One |*| Endless[A]) =
introFst
val onPull: Endless[A] -⚬ ((A |*| Endless[A]) |*| Endless[A]) =
pull > par(id, self) > assocRL
id [ Endless[A] |*| Endless[A] ]
./<.fst(pack) .from[ (One |&| (A |*| Endless[A])) |*| Endless[A] ]
./<(coDistributeR) .from[ (One |*| Endless[A]) |&| ((A |*| Endless[A]) |*| Endless[A]) ]
./<(choice(onClose, onPull)) .from[ Endless[A] ]
}
val onSndAction: Endless[A] -⚬ (Endless[A] |*| Endless[A]) =
onFstAction > swap
select(
caseFstWins = onFstAction,
caseSndWins = onSndAction,
)
}
given [A]: Comonoid[Endless[A]] with {
override def counit: Endless[A] -⚬ One = Endless.close
override def split : Endless[A] -⚬ (Endless[A] |*| Endless[A]) = Endless.split
}
def toUnlimited[A]: Endless[A] -⚬ Unlimited[A] = rec { self =>
Unlimited.create(
case0 = close,
case1 = pull > elimSnd(close),
caseN = split > par(self, self),
)
}
/** Pulls the given amount of elements and returns them in a list.
*
* **Note:** This method assembles a program whose size is proportional to _n_.
*/
def take[A](n: Int): Endless[A] -⚬ LList[A] = {
require(n >= 0, s"n must be non-negative, got $n")
if (n > 0)
pull > par(id, take(n - 1)) > LList.cons
else
close > LList.nil[A]
}
def map[A, B](f: A -⚬ B): Endless[A] -⚬ Endless[B] = rec { self =>
create(
onClose = close,
onPull = pull > par(f, self),
)
}
def delayUntilPing[A]: (Ping |*| Endless[A]) -⚬ Endless[A] =
snd(unpack) > delayChoiceUntilPing > pack
def delayUntilPong[A]: Endless[A] -⚬ (Pong |*| Endless[A]) =
unpack > delayChoiceUntilPong > snd(pack)
/** Delays each next pull until the previously emitted element signalled. */
def sequence[A](using A: Signaling.Positive[A]): Endless[A] -⚬ Endless[A] =
mapSequentially(id)
/** Delays each next pull until the [[Ping]] produced from the previous element. */
def mapSequence[A, B](f: A -⚬ (Ping |*| B)): Endless[A] -⚬ Endless[B] =
rec { self =>
Endless.create(
onClose = close[A],
onPull = λ { as =>
val h |*| t = pull(as)
val pi |*| b = f(h)
val po |*| t1 = delayUntilPong(t)
returning(
b |*| self(t1),
rInvertPingPong(pi |*| po),
)
}
)
}
def mapSequentially[A, B](f: A -⚬ B)(using Signaling.Positive[B]): Endless[A] -⚬ Endless[B] =
mapSequence(f > notifyPosFst)
def foldLeftSequentially[B, A](f: (B |*| A) -⚬ B)(using
Signaling.Positive[B]
): (B |*| Endless[A]) -⚬ B =
rec { self =>
λ { case b |*| as =>
val p |*| b1 = b |> notifyPosFst
switch ( injectLOnPing[Endless[A], One](p |*| as) )
.is { case InL(as) =>
val h |*| t = pull(as)
self(f(b1 |*| h) |*| t)
}
.is { case InR(?(_)) => b1 }
.end
}
}
def foldMapSequentially[A, B](f: A -⚬ B)(using
Signaling.Positive[B],
Semigroup[B],
): Endless[A] -⚬ B = {
val g: (B |*| A) -⚬ B =
snd(f) > summon[Semigroup[B]].combine
pull > fst(f) > foldLeftSequentially[B, A](g)
}
def pullN[A](n: Int): Endless[A] -⚬ (LList1[A] |*| Endless[A]) = {
require(n > 0, s"n must be positive")
pull > λ { case h |*| t =>
if (n == 1)
LList1.singleton(h) |*| t
else
val as |*| t1 = pullN(n-1)(t)
LList1.cons1(h |*| as) |*| t1
}
}
def unpull[A](using A: Affine[A]): (A |*| Endless[A]) -⚬ Endless[A] =
create(
onClose = λ { case ?(_) |*| as => close(as) },
onPull = id,
)
def groups[A](groupSize: Int): Endless[A] -⚬ Endless[LList1[A]] = rec { self =>
require(groupSize > 0, s"group size must be positive")
create(
onClose = close,
onPull = pullN(groupSize) > snd(self),
)
}
def groupMap[A, B](groupSize: Int, f: LList1[A] -⚬ B): Endless[A] -⚬ Endless[B] =
groups(groupSize) > map(f)
def mergePreferred[A](using
A: Signaling.Positive[A],
aff: Affine[A],
): (Endless[A] |*| Endless[A]) -⚬ Endless[A] = {
def go: ((A |*| Endless[A]) |*| Endless[A]) -⚬ Endless[A] = rec { self =>
λ { case (a |*| as) |*| bs =>
val po |*| pi = constant(lInvertPongPing)
val res: $[One |&| (A |*| Endless[A])] =
switch ( race[Ping, A](pi |*| a) )
.is { case InL(?(_) |*| a) =>
(a |*| as |*| bs) |> choice(
λ { case ?(_) |*| as |*| bs => close(as) alsoElim close(bs) },
λ { case a |*| as |*| bs =>
val b |*| bs1 = pull(bs)
switch ( race[A, A](a |*| b) )
.is { case InL(a |*| b) => a |*| self(pull(as) |*| unpull[A](b |*| bs1)) }
.is { case InR(a |*| b) => b |*| self((a |*| as) |*| bs1) }
.end
},
)
}
.is { case InR(?(_) |*| a) =>
(a |*| as |*| bs) |> choice(
λ { case ?(_) |*| as |*| bs => close(as) alsoElim close(bs) },
λ { case a |*| as |*| bs => a |*| self(pull(as) |*| bs) },
)
}
.end
(po |*| res) |> notifyChoice > pack
}
}
fst(pull) > go
}
def mergeEitherPreferred[A, B](using
A: Signaling.Positive[A],
B: Signaling.Positive[B],
affA: Affine[A],
affB: Affine[B],
): (Endless[A] |*| Endless[B]) -⚬ Endless[A |+| B] = {
given Signaling.Positive[A |+| B] = Signaling.Positive.either(A, B)
par(Endless.map(injectL), Endless.map(injectR)) > mergePreferred[A |+| B]
}
def poolBy[A: Signaling.Positive, Ā](
lInvert: One -⚬ (Ā |*| A),
): LList1[A] -⚬ (Endless[A |*| Ā] |*| LList1[A]) =
unfold(LList1.borrow(lInvert))
def pool[A](using Signaling.Positive[A]): LList1[A] -⚬ (Endless[A |*| -[A]] |*| LList1[A]) =
poolBy[A, -[A]](forevert[A])
def poolReset[A, B](reset: B -⚬ A)(using
Signaling.Positive[A]
): LList1[A] -⚬ (Endless[A |*| -[B]] |*| LList1[A]) =
poolBy[A, -[B]](forevert[B] > snd(reset))
}
def listEndlessDuality[A, Ā](ev: Dual[A, Ā]): Dual[LList[A], Endless[Ā]] =
new Dual[LList[A], Endless[Ā]] {
override val rInvert: (LList[A] |*| Endless[Ā]) -⚬ One =
λ.rec { self =>
{ case as |*| ns =>
switch( as )
.is { case LList.Nil(?(_)) => Endless.close(ns) }
.is { case LList.Cons(a |*| as1) =>
val n |*| ns1 = Endless.pull(ns)
returning(self(as1 |*| ns1), ev.rInvert(a |*| n))
}
.end
}
}
override val lInvert: One -⚬ (Endless[Ā] |*| LList[A]) = rec { self =>
Endless.createWith(
onClose = LList.nil[A],
onPull = self > introFst(ev.lInvert) > IXI > snd(LList.cons),
)
}
}
opaque type Lease = Done |*| Need
object Lease {
/** The [[Done]] signal on the outport signals when the lease is released. */
def create: Done -⚬ (Lease |*| Done) =
introSnd(lInvertSignal) > assocRL
def release: Lease -⚬ One =
rInvertSignal
def releaseBy: (Done |*| Lease) -⚬ One =
assocRL > fst(join) > rInvertSignal
def notifyAcquired: Lease -⚬ (Ping |*| Lease) =
fst(notifyDoneL) > assocLR
def deferAcquisition: (Done |*| Lease) -⚬ Lease =
assocRL > fst(join)
def deferRelease: (Done |*| Lease) -⚬ Lease =
λ { case (d |*| (leaseD |*| leaseN)) =>
val (n1 |*| n2) = joinNeed(leaseN)
(leaseD |*| n2) alsoElim rInvertSignal(d |*| n1)
}
}
opaque type LeasePool =
Unlimited[Lease] |*| Done
object LeasePool {
def fromList: LList1[Done] -⚬ LeasePool =
Unlimited.poolBy[Done, Need](lInvertSignal) > snd(LList1.fold[Done])
def allocate(n: Int): Done -⚬ LeasePool =
LList1.fill(n)(id[Done]) > fromList
/** Creates a pool from `S` with as many leases as are unfolded from `S` via `f`. */
def createUnfold[S](f: S -⚬ (Done |*| Maybe[S])): S -⚬ LeasePool =
LList1.unfold(f) > fromList
def acquireLease: LeasePool -⚬ (Lease |*| LeasePool) =
fst(Unlimited.getSome) > assocLR
def close: LeasePool -⚬ Done =
elimFst(Unlimited.discard)
}
/** Represents an acquired "token".
* @tparam X how the interaction continues after returning the acquired token
*/
private type Acquired[X] =
// the acquired token
Done |*|
// continuation after returning the token
Detained[X]
private type LockF[X] =
// result of the close action
( Done |&|
// result of the acquire action
( Acquired[X] |&|
// result of the tryAcquire action
( Acquired[X] |+| X
)))
opaque type Lock =
Rec[LockF]
opaque type AcquiredLock =
Acquired[Lock]
object Lock {
def acquire: Lock -⚬ AcquiredLock =
unpack[LockF] > chooseR > chooseL
def tryAcquire: Lock -⚬ (AcquiredLock |+| Lock) =
unpack[LockF] > chooseR > chooseR
def close: Lock -⚬ Done =
unpack[LockF] > chooseL
def newLock: Done -⚬ Lock =
rec { newLock =>
choice(
id[Done],
choice(
introSnd(Detained.thunk(newLock)),
introSnd(Detained.thunk(newLock)) > injectL,
),
) > pack[LockF]
}
def share: Lock -⚬ (Lock |*| Lock) =
rec { share =>
val branchByFst: Lock -⚬ (Lock |*| Lock) = {
val caseClose: Lock -⚬ (Done |*| Lock) =
introFst(done)
val acquiredByFst: AcquiredLock -⚬ (AcquiredLock |*| Lock) = rec { acquiredByFst =>
val go: Detained[Lock] -⚬ (Detained[Lock] |*| Lock) = rec { go =>
// when the acquired lock is released before action is taken on the other lock handle
val expectRelease: Detained[Lock] -⚬ (Detained[Lock] |*| Lock) =
Detained(Detained.releaseBy > share) > Transportive[Detained].outR
// when action is taken on the other lock handle while lock is acquired by the first handle
val branchBySnd: Detained[Lock] -⚬ (Detained[Lock] |*| Lock) = {
val caseClose: Detained[Lock] -⚬ (Detained[Lock] |*| Done) =
introSnd(done)
val caseAcquire: Detained[Lock] -⚬ (Detained[Lock] |*| AcquiredLock) =
// release and re-acquire, to give chance to others
Detained(Detained.releaseBy > Lock.acquire > acquiredByFst > swap) > Transportive[Detained].outR
val caseTryAcquire: Detained[Lock] -⚬ (Detained[Lock] |*| (AcquiredLock |+| Lock)) =
go > snd(injectR)
choice(
caseClose,
choice(
caseAcquire,
caseTryAcquire,
) > coDistributeL
) > coDistributeL > snd(pack[LockF])
}
choice(expectRelease, branchBySnd) > selectBy(Detained.notifyReleaseNeg, notifyAction)
}
snd(go) > assocRL
}
val caseAcquire: Lock -⚬ (AcquiredLock |*| Lock) =
Lock.acquire > acquiredByFst
val caseTryAcquire: Lock -⚬ ((AcquiredLock |+| Lock) |*| Lock) =
Lock.tryAcquire > either(
acquiredByFst > fst(injectL),
share > fst(injectR),
)
choice(
caseClose,
choice(
caseAcquire,
caseTryAcquire,
) > coDistributeR,
) > coDistributeR > fst(pack[LockF])
}
val branchBySnd: Lock -⚬ (Lock |*| Lock) =
branchByFst > swap
choice(branchByFst, branchBySnd) > selectBy(notifyAction, notifyAction)
}
private def notifyAction: (Pong |*| Lock) -⚬ Lock =
snd(unpack[LockF]) > notifyChoiceAndRight(notifyChoice) > pack[LockF]
given CloseableCosemigroup[Lock] =
new CloseableCosemigroup[Lock] {
override def split: Lock -⚬ (Lock |*| Lock) =
Lock.share
override def close: Lock -⚬ Done =
Lock.close
}
}
object AcquiredLock {
def release: AcquiredLock -⚬ Lock =
Detained.releaseBy
/** Acquisition will not be complete until also the given [[Done]] signal arrives. */
def detainAcquisition: (Done |*| AcquiredLock) -⚬ AcquiredLock =
assocRL > fst(join)
/** Acquisition will not be complete until also the given [[Ping]] signal arrives. */
def deferAcquisition: (Ping |*| AcquiredLock) -⚬ AcquiredLock =
fst(strengthenPing) > detainAcquisition
/** Notifies when the lock is acquired. */
def notifyAcquisition: AcquiredLock -⚬ (Ping |*| AcquiredLock) =
fst(notifyDoneL) > assocLR
/** Subsequent [[release]] won't have effect until also the given [[Done]] signal arrives. */
def detainRelease: (Done |*| AcquiredLock) -⚬ AcquiredLock =
XI > snd(Detained.extendDetentionUntil)
/** Subsequent [[release]] won't have effect until also the given [[Ping]] signal arrives. */
def deferRelease: (Ping |*| AcquiredLock) -⚬ AcquiredLock =
fst(strengthenPing) > detainRelease
given acquisition: SignalingJunction.Positive[AcquiredLock] =
new SignalingJunction.Positive[AcquiredLock] {
override def notifyPosFst: AcquiredLock -⚬ (Ping |*| AcquiredLock) =
notifyAcquisition
override def awaitPosFst: (Done |*| AcquiredLock) -⚬ AcquiredLock =
detainAcquisition
}
}
extension (acquiredLock: $[AcquiredLock])(using LambdaContext) {
infix def deferReleaseUntil(ping: $[Ping]): $[AcquiredLock] =
AcquiredLock.deferRelease(ping |*| acquiredLock)
infix def detainReleaseUntil(done: $[Done]): $[AcquiredLock] =
AcquiredLock.detainRelease(done |*| acquiredLock)
}
/** Function object (internal hom) is contravariant in the input type. */
def input[C]: ContraFunctor[[x] =>> x =⚬ C] =
new ContraFunctor[[x] =>> x =⚬ C] {
override val category =
dsl.category
override def lift[A, B](f: A -⚬ B): (B =⚬ C) -⚬ (A =⚬ C) =
id [ (B =⚬ C) |*| A ]
./>.snd(f) .to[ (B =⚬ C) |*| B ]
./>(eval) .to[ C ]
.as[ ((B =⚬ C) |*| A) -⚬ C ]
.curry
}
/** Function object (internal hom) is covariant in the output type. */
def output[A]: Functor[[x] =>> A =⚬ x] =
new Functor[[x] =>> A =⚬ x] {
override val category =
dsl.category
override def lift[B, C](f: B -⚬ C): (A =⚬ B) -⚬ (A =⚬ C) =
out(f)
}
extension [A, B](f: A -⚬ B) {
def curry[A1, A2](using ev: A =:= (A1 |*| A2)): A1 -⚬ (A2 =⚬ B) =
dsl.curry(ev.substituteCo[λ[x => x -⚬ B]](f))
def uncurry[B1, B2](using ev: B =:= (B1 =⚬ B2)): (A |*| B1) -⚬ B2 =
dsl.uncurry(ev.substituteCo(f))
}
extension [F[_], A, B](f: FocusedCo[F, A =⚬ B]) {
def input: FocusedContra[λ[x => F[x =⚬ B]], A] =
f.zoomContra(lib.input[B])
def output: FocusedCo[λ[x => F[A =⚬ x]], B] =
f.zoomCo(lib.output[A])
}
extension [F[_], A, B](f: FocusedContra[F, A =⚬ B]) {
def input: FocusedCo[λ[x => F[x =⚬ B]], A] =
f.zoomContra(lib.input[B])
def output: FocusedContra[λ[x => F[A =⚬ x]], B] =
f.zoomCo(lib.output[A])
}
def zapPremises[A, Ā, B, C](using ev: Dual[A, Ā]): ((A =⚬ B) |*| (Ā =⚬ C)) -⚬ (B |*| C) = {
id [ (A =⚬ B) |*| (Ā =⚬ C) ]
./>(introSnd(ev.lInvert)) .to[ ((A =⚬ B) |*| (Ā =⚬ C)) |*| (Ā |*| A) ]
./>.snd(swap) .to[ ((A =⚬ B) |*| (Ā =⚬ C)) |*| (A |*| Ā) ]
./>(IXI) .to[ ((A =⚬ B) |*| A) |*| ((Ā =⚬ C) |*| Ā) ]
./>(par(eval, eval)) .to[ B |*| C ]
}
/** Given `A` and `B` concurrently (`A |*| B`), we can suggest that `A` be consumed before `B`
* by turning it into `Ā =⚬ B`, where `Ā` is the dual of `A`.
*/
def unveilSequentially[A, Ā, B](using ev: Dual[A, Ā]): (A |*| B) -⚬ (Ā =⚬ B) =
id[(A |*| B) |*| Ā] .to[ (A |*| B) |*| Ā ]
./>(assocLR) .to[ A |*| (B |*| Ā) ]
./>.snd(swap) .to[ A |*| (Ā |*| B) ]
./>(assocRL) .to[ (A |*| Ā) |*| B ]
./>(elimFst(ev.rInvert)) .to[ B ]
.as[ ((A |*| B) |*| Ā) -⚬ B ]
.curry
/** Make a function `A =⚬ B` ''"absorb"'' a `C` and return it as part of its output, i.e. `A =⚬ (B |*| C)`. */
def absorbR[A, B, C]: ((A =⚬ B) |*| C) -⚬ (A =⚬ (B |*| C)) =
id[((A =⚬ B) |*| C) |*| A] .to[ ((A =⚬ B) |*| C) |*| A ]
./>(assocLR) .to[ (A =⚬ B) |*| (C |*| A) ]
./>.snd(swap) .to[ (A =⚬ B) |*| (A |*| C) ]
./>(assocRL) .to[ ((A =⚬ B) |*| A) |*| C ]
./>.fst(eval) .to[ B |*| C ]
.as[ (((A =⚬ B) |*| C) |*| A) -⚬ (B |*| C) ]
.curry
def inversionDuality[A]: Dual[A, -[A]] =
new Dual[A, -[A]] {
override val rInvert: (A |*| -[A]) -⚬ One = backvert[A]
override val lInvert: One -⚬ (-[A] |*| A) = forevert[A]
}
given ContraFunctor[-] with {
override val category =
dsl.category
override def lift[A, B](f: A -⚬ B): -[B] -⚬ -[A] =
contrapositive(f)
}
}