Last active
April 11, 2024 09:47
-
-
Save kitlangton/e8c412ec70bb7d6542f313c45164f3e3 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
package tttt | |
// Awesome 😄 That looks great. It maintains all of the properties of the Frank (or, Langton style 😛) encoding—where one can recurse with different handlers and short-circuit trivially—without losing the tail-recursive stack safety. And I fully trust you when it comes to the JIT-ability of it all! | |
// The only issues are minor UX ones, in that it could be confusing for the user to know whether to call | |
import izumi.reflect.Tag | |
type Id[T] = T | |
type Const[T] = [U] =>> T | |
type MX[T] = Any | |
////////////// | |
// KYO CORE // | |
////////////// | |
object core: | |
import internal.* | |
opaque type <[+T, -S] >: T = T | Kyo[T, S] | |
extension [T, S](self: T < S) | |
def map[U, S2](f: T => U < S2): U < (S & S2) = | |
flatMap(f) | |
def flatMap[U, S2](k: T => U < S2): U < (S & S2) = | |
def flatMapLoop(v: T < S): U < (S & S2) = | |
v match | |
case kyo: Suspend[MX, Any, T, S] @unchecked => | |
new Continue[MX, Any, U, S & S2](kyo): | |
def apply(v: Any) = flatMapLoop(kyo(v)) | |
case v: T @unchecked => | |
k(v) | |
end flatMapLoop | |
flatMapLoop(self) | |
end flatMap | |
end extension | |
case class Handle[Command[_], Result[_], E, T, S]( | |
h: ResultHandler[Command, Result, E], | |
v: T < (E & S) | |
) | |
abstract class ResultHandler[Command[_], Result[_], E](using val tag: Tag[E]): | |
def pure[T](v: T): Result[T] | |
opaque type Handled[T, S] = Result[T] < S | Handle[Command, Result, E, T, S] | |
protected inline def halt[T, S](v: Result[T] < S): Handled[T, S] = v | |
protected inline def handle[T, S](v: T < (E & S)): Handled[T, S] = Handle(this, v) | |
protected inline def handle[T, S](h: ResultHandler[Command, Result, E], v: T < (E & S)): Handled[T, S] = | |
Handle(h, v) | |
def apply[T, U, S]( | |
command: Command[T], | |
k: T => U < (E & S) | |
): Handled[U, S] | |
final def run[T, S](value: T < (E & S)): Result[T] < S = | |
def runLoop( | |
handler: ResultHandler[Command, Result, E], | |
value: T < (E & S) | |
): Result[T] < S = | |
value match | |
case suspend: Suspend[Command, Any, T, S] @unchecked if suspend.tag.tag == tag.tag => | |
handler(suspend.command, suspend) match | |
case r: Handle[Command, Result, E, T, S] @unchecked => | |
runLoop(r.h, r.v) | |
case v => | |
v.asInstanceOf[Result[T] < S] | |
case suspend: Suspend[MX, Any, T, S] @unchecked => | |
new Continue[MX, Any, Result[T], S](suspend): | |
def apply(v: Any) = | |
run(suspend(v)) | |
case v: T @unchecked => | |
pure(v) | |
runLoop(this, value) | |
end run | |
end ResultHandler | |
abstract class Handler[Command[_], E](using override val tag: Tag[E]) extends ResultHandler[Command, Id, E]: | |
def pure[T](v: T): Id[T] = v | |
end Handler | |
abstract class Effect[E](using val tag: Tag[E]): | |
type Command[_] | |
def suspend[T](command: Command[T]): T < E = Root(command, tag) | |
end Effect | |
private object internal: | |
sealed abstract class Kyo[+T, -S] | |
sealed abstract class Suspend[Command[_], T, U, S] extends Kyo[U, S] with Function1[T, U < S]: | |
def command: Command[T] | |
def tag: Tag[?] | |
def apply(v: T): U < S | |
end Suspend | |
sealed abstract class Continue[Command[_], T, U, S]( | |
s: Suspend[Command, T, ?, ?] | |
) extends Suspend[Command, T, U, S]: | |
val command = s.command | |
val tag = s.tag | |
end Continue | |
final class Root[Command[_], T, E]( | |
val command: Command[T], | |
val tag: Tag[E] | |
) extends Suspend[Command, T, T, E]: | |
def apply(v: T): T < E = v | |
end Root | |
end internal | |
end core | |
import core.* | |
//////////// | |
// ABORTS // | |
//////////// | |
class Aborts[E: Tag] extends Effect[Aborts[E]]: | |
override type Command[T] = Left[E, Nothing] | |
object Aborts: | |
def abort[E: Tag](value: E): Nothing < Aborts[E] = | |
Aborts[E].suspend(Left(value)) | |
def when[E: Tag](b: Boolean)(value: E): Unit < Aborts[E] = | |
if b then abort(value) | |
else () | |
def fromEither[E: Tag, T, S](either: Either[E, T] < S): T < (Aborts[E] & S) = | |
either.map { | |
case Right(value) => value | |
case Left(e) => abort(e) | |
} | |
def handler[E: Tag] = | |
new ResultHandler[Const[Left[E, Nothing]], [T] =>> Either[E, T], Aborts[E]]: | |
def pure[T](v: T) = Right(v) | |
def apply[T, U, S]( | |
command: Left[E, Nothing], | |
k: T => U < (Aborts[E] & S) | |
): Handled[U, S] = | |
halt(command) | |
def run[E: Tag, T, S](value: T < (Aborts[E] & S)): Either[E, T] < S = | |
handler[E].run(value) | |
end Aborts | |
////////// | |
// ENVS // | |
////////// | |
class Envs[R: Tag] extends Effect[Envs[R]]: | |
override type Command[T] = Envs.Input[T] | |
object Envs: | |
object Input | |
type Input[T] = Input.type | |
def get[R: Tag]: R < Envs[R] = Envs[R].suspend(Input) | |
def run[R: Tag, T, S](env: R)(value: T < (Envs[R] & S)): T < S = | |
val handler = new Handler[Input, Envs[R]]: | |
def apply[T, U, S](command: Input[T], k: T => U < (Envs[R] & S)) = | |
handle(k(env.asInstanceOf[T])) | |
handler.run(value) | |
end run | |
end Envs | |
//////////// | |
// STATES // | |
//////////// | |
class States[S: Tag] extends Effect[States[S]]: | |
override type Command[T] = States.Command[S, T] | |
object States: | |
enum Command[+S, +T]: | |
case Get[S]() extends Command[S, S] | |
case Set[S](value: S) extends Command[S, Unit] | |
def get[S: Tag]: S < States[S] = States[S].suspend(Command.Get()) | |
def set[S: Tag](value: S): Unit < States[S] = States[S].suspend(Command.Set(value)) | |
def modify[S: Tag](f: S => S): Unit < States[S] = get[S].flatMap(s => set(f(s))) | |
def handler[S: Tag](state: S): Handler[[T] =>> Command[S, T], States[S]] = | |
new Handler[[T] =>> Command[S, T], States[S]]: | |
def apply[T, U, S2](command: Command[S, T], k: T => U < (States[S] & S2)) = | |
command match | |
case Command.Set(v) => | |
handle(handler(v), k(())) | |
case _: Command.Get[S] @unchecked => | |
handle(k(state)) | |
def run[S: Tag, T, S2](state: S)(value: T < (States[S] & S2)): T < S2 = | |
handler(state).run(value) | |
end run | |
end States | |
object StateExample extends App: | |
def dump = | |
var s = "***********\n" | |
val t = Thread.currentThread().getStackTrace() | |
s += s"Depth: ${t.size}" | |
// s += t.mkString("\n") | |
println(s) | |
end dump | |
def program: Unit < States[Int] = | |
for | |
n1 <- States.get[Int] | |
_ <- dump | |
_ <- States.set(n1 + 1) | |
_ <- dump | |
n2 <- States.get[Int] | |
_ <- dump | |
_ <- States.set(n2 + 1) | |
_ <- dump | |
_ <- States.set(n2 + 1) | |
_ <- dump | |
_ <- States.set(n2 + 1) | |
_ <- dump | |
_ = println(s"n1 = $n1, n2 = $n2") | |
yield () | |
States.run(0)(program) | |
end StateExample |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment