diff --git a/shared/src/main/scala/cps/CpsMonadConversion.scala b/shared/src/main/scala/cps/CpsMonadConversion.scala index cf6c19b8..a2e9cc72 100644 --- a/shared/src/main/scala/cps/CpsMonadConversion.scala +++ b/shared/src/main/scala/cps/CpsMonadConversion.scala @@ -14,5 +14,7 @@ object CpsMonadConversion: given identityConversion[F[_]]: CpsMonadConversion[F,F] with def apply[T](ft:F[T]): F[T] = ft + + end CpsMonadConversion diff --git a/shared/src/test/scala/logic/CpsLogicMonad.scala b/shared/src/test/scala/logic/CpsLogicMonad.scala index 1fe7dcf3..13124b27 100644 --- a/shared/src/test/scala/logic/CpsLogicMonad.scala +++ b/shared/src/test/scala/logic/CpsLogicMonad.scala @@ -4,11 +4,13 @@ import scala.util.* import cps.* -trait CpsLogicMonad[M[+_]] extends CpsTryMonad[M] { +trait CpsLogicMonad[M[_]] extends CpsTryMonad[M] { - def mzero: M[Nothing] + override type Context <: CpsLogicMonadContext[M] - def mplus[A](a: M[A], b: M[A]): M[A] + def mzero[A]: M[A] + + def mplus[A](a: M[A], b: => M[A]): M[A] def msplit[A](c: M[A]): M[Option[(Try[A], M[A])]] @@ -59,7 +61,7 @@ trait CpsLogicMonad[M[+_]] extends CpsTryMonad[M] { type Observer[A] - def observerCpsMonad: CpsMonad[Observer] + def observerCpsMonad: CpsTryMonad[Observer] def mObserveOne[A](ma:M[A]): Observer[Option[A]] @@ -68,7 +70,12 @@ trait CpsLogicMonad[M[+_]] extends CpsTryMonad[M] { observerCpsMonad.flatMap(observer)(seq => observerCpsMonad.map(fa)(a => seq :+ a)) } - def mFoldLeft[A,B](ma:M[A], zero:Observer[B], op: (Observer[B],Observer[A])=>Observer[B]): Observer[B] + def mObserveAll[A](ma: M[A]): Observer[Seq[A]] = + mFoldLeft(ma, observerCpsMonad.pure(IndexedSeq.empty[A])) { (observer, fa) => + observerCpsMonad.flatMap(observer)(seq => observerCpsMonad.map(fa)(a => seq :+ a)) + } + + def mFoldLeft[A,B](ma:M[A], zero:Observer[B])(op: (Observer[B],Observer[A])=>Observer[B]): Observer[B] def mFoldLeftN[A,B](ma: M[A], zero: Observer[B], n: Int)(op: (Observer[B],Observer[A])=>Observer[B]): Observer[B] @@ -83,17 +90,17 @@ object CpsLogicMonad { } -trait CpsLogicMonadContext[M[+_]] extends CpsTryMonadContext[M] { +trait CpsLogicMonadContext[M[_]] extends CpsTryMonadContext[M] { override def monad: CpsLogicMonad[M] } -class CpsLogicMonadInstanceContextBody[M[+_]](m:CpsLogicMonad[M]) extends CpsLogicMonadContext[M] { +class CpsLogicMonadInstanceContextBody[M[_]](m:CpsLogicMonad[M]) extends CpsLogicMonadContext[M] { override def monad: CpsLogicMonad[M] = m } -trait CpsLogicMonadInstanceContext[M[+_]] extends CpsLogicMonad[M] { +trait CpsLogicMonadInstanceContext[M[_]] extends CpsLogicMonad[M] { override type Context = CpsLogicMonadInstanceContextBody[M] @@ -103,7 +110,7 @@ trait CpsLogicMonadInstanceContext[M[+_]] extends CpsLogicMonad[M] { } -def all[M[+_],A](collection: IterableOnce[A])(using m:CpsLogicMonad[M]): M[A] = +def all[M[_],A](collection: IterableOnce[A])(using m:CpsLogicMonad[M]): M[A] = def allIt(it: Iterator[A]): M[A] = if (it.hasNext) { m.mplus(m.pure(it.next()), allIt(it)) @@ -113,7 +120,10 @@ def all[M[+_],A](collection: IterableOnce[A])(using m:CpsLogicMonad[M]): M[A] = allIt(collection.iterator) -extension [M[+_],A](ma: M[A])(using m:CpsLogicMonad[M]) + + + +extension [M[_],A](ma: M[A])(using m:CpsLogicMonad[M]) def filter(p: A => Boolean): M[A] = m.flatMap(m.msplit(ma)) { sc => @@ -133,3 +143,18 @@ extension [M[+_],A](ma: M[A])(using m:CpsLogicMonad[M]) def observeN(n: Int): m.Observer[Seq[A]] = m.mObserveN(ma,n) + + def observeOne: m.Observer[Option[A]] = + m.mObserveOne(ma) + + def observeAll: m.Observer[Seq[A]] = + m.mObserveAll(ma) + + def |+|(mb: =>M[A]): M[A] = + m.mplus(ma,mb) + + +transparent inline def guard[M[_]:CpsLogicMonad](p: =>Boolean)(using mc:CpsLogicMonadContext[M]): Unit = + reflect{ + if (p) mc.monad.pure(()) else mc.monad.mzero + } diff --git a/shared/src/test/scala/logic/GrandParentsTest.scala b/shared/src/test/scala/logic/GrandParentsTest.scala new file mode 100644 index 00000000..b24a5372 --- /dev/null +++ b/shared/src/test/scala/logic/GrandParentsTest.scala @@ -0,0 +1,46 @@ +package logic + +import cps.* +import cps.monads.{*, given} +import logict.{*,given} + +import org.junit.Test + + +class GrandParentsTest { + + @Test + def testLogicM() = { + import GrandParentsTest.* + val r = grandParent[LogicM]("Anne").observeAll + println(s"GrandParentTest: r=$r") + assert(r.size == 2) + assert(r.contains("Sarah")) + assert(r.contains("Arnold")) + } + + + +} + +object GrandParentsTest { + + case class IsParentOf(parent:String, child:String) + + def parents = Seq( + IsParentOf("Sarah", "John"), + IsParentOf("Arnold", "John"), + IsParentOf("John", "Anne"), + ) + + def grandParent[M[_]:CpsLogicMonad](name:String):M[String] = reify[M]{ + // TODO: fill bug report in dotty. + // shopuld be search + import cps.CpsMonadConversion.given + val IsParentOf(p,c) = reflect(all(parents)) + guard(c == name) + val IsParentOf(gp,_) = reflect(all(parents.filter(_.child == p))) + gp + } + +} \ No newline at end of file diff --git a/shared/src/test/scala/logic/LogicTTest.scala b/shared/src/test/scala/logic/LogicTTest.scala new file mode 100644 index 00000000..db25d2c1 --- /dev/null +++ b/shared/src/test/scala/logic/LogicTTest.scala @@ -0,0 +1,41 @@ +package logic + +import scala.concurrent.duration.* +import scala.util.* +import cps.* +import logict.* +import org.junit.Test + +class LogicTTest { + + import LogicTTest.* + + @Test + def testNatCB():Unit = { + + val cbNat = nats[[A] =>> LogicT[ComputationBound,A]] + + val cb4 = cbNat.observeN(4) + assert(cb4.run(1.second) == Success(Seq(1,2,3,4))) + + val cbOdd = odds[[A] =>> LogicT[ComputationBound,A]] + + + + } + + +} + +object LogicTTest { + + def nats[M[_]](using m: CpsLogicMonad[M]): M[Int] = + m.pure(1) |+| reify[M] { 1 + reflect(nats) } + + def odds[M[_]](using m: CpsLogicMonad[M]): M[Int] = + m.pure(1) |+| reify[M] { 2 + reflect(odds) } + + + + +} diff --git a/shared/src/test/scala/logic/QueensTest.scala b/shared/src/test/scala/logic/QueensTest.scala index 736dbcd8..34825e00 100644 --- a/shared/src/test/scala/logic/QueensTest.scala +++ b/shared/src/test/scala/logic/QueensTest.scala @@ -13,7 +13,7 @@ class QueensTest { import QueensTest.* val r = queens[LogicM](8).observeN(2) // observer monad is identity monad here. - + println(s"QueensTest:r=$r") assert(r.size == 2) assert(QueensTest.isCorrect(r(0))) assert(QueensTest.isCorrect(r(1))) diff --git a/shared/src/test/scala/logic/logict/LogicSKFK.scala b/shared/src/test/scala/logic/logict/LogicSKFK.scala new file mode 100644 index 00000000..f0c36661 --- /dev/null +++ b/shared/src/test/scala/logic/logict/LogicSKFK.scala @@ -0,0 +1,204 @@ +package logic.logict + +import cps.* +import cps.monads.{*, given} + +import scala.util.* +import logic.* + +import scala.annotation.tailrec + +type LogicM[A] = LogicT[CpsIdentity,A] + + +given logicMonadM: LogicSKFK.LogicSKFKMonad[CpsIdentity] = LogicSKFK.logicMonadT[CpsIdentity] + + +/** + * Dependency-less port of haskell's LogicT monad transformer. + */ +type LogicT[F[_],+A] = LogicSKFK.CallbackAcceptor[F,A] + +object LogicSKFK { + + + trait SuccessContinuation[F[_],-A,R] { + + def apply(ta: Try[A])(fk: =>F[R]): F[R] + + } + + + trait CallbackAcceptor[F[_], +A] { + /** + * + * @param sk - success continuation (like k wih continuation monad and s for succee) + * @param fk - failure continuation. + * @tparam A - type of value on the time of performing continuation + * @return + */ + def apply[R](sk: SuccessContinuation[F,A,R])(fK: =>F[R]): F[R] + } + + + + class LogicSKFKMonad[F[_]:CpsTryMonad] extends CpsLogicMonad[[X]=>>CallbackAcceptor[F,X]] + with CpsLogicMonadInstanceContext[[X]=>>CallbackAcceptor[F,X]] { + + override type Observer[A] = F[A] + + override def pure[A](a:A): CallbackAcceptor[F,A] = new CallbackAcceptor[F,A] { + override def apply[R](sk: SuccessContinuation[F,A,R])(fk: =>F[R]):F[R] = + sk(Success(a))(fk) + } + + override def error[A](ex: Throwable): CallbackAcceptor[F,A] = new CallbackAcceptor[F,A] { + override def apply[R](sk: SuccessContinuation[F,A,R])(fk: => F[R]): F[R] = + sk(Failure(ex))(fk) + } + + override def map[A, B](fa: CallbackAcceptor[F, A])(f: A => B): CallbackAcceptor[F, B] = + new CallbackAcceptor[F,B] { + override def apply[R](sk: SuccessContinuation[F,B,R])(fk: =>F[R]): F[R] = + fa.apply[R]{ + new SuccessContinuation[F,A,R] { + override def apply(ta: Try[A])(fk: =>F[R]): F[R] = + ta match + case Success(a) => sk(Success(f(a)))(fk) + case Failure(ex) => sk(Failure(ex))(fk) + } + }(fk) + } + + override def flatMap[A, B](fa: CallbackAcceptor[F, A])(f: A => CallbackAcceptor[F, B]): CallbackAcceptor[F, B] = { + flatMapTry(fa) { + case Success(a) => f(a) + case Failure(ex) => error(ex) + } + } + + override def flatMapTry[A,B](fa: CallbackAcceptor[F,A])(f: Try[A] => CallbackAcceptor[F,B]): CallbackAcceptor[F,B] = + new CallbackAcceptor[F,B] { + override def apply[R](sk: SuccessContinuation[F,B,R])(fk: =>F[R]): F[R] = + fa.apply[R]( + new SuccessContinuation[F,A,R] { + override def apply(ta: Try[A])(fk: =>F[R]): F[R] = + f(ta).apply[R](sk)(fk) + } + )(fk) + } + + override def mzero[A]: CallbackAcceptor[F, A] = + new CallbackAcceptor[F,A] { + override def apply[R](sk: SuccessContinuation[F,A,R])(fk: =>F[R]):F[R] = + fk + } + + override def mplus[A](a: CallbackAcceptor[F, A], b: =>CallbackAcceptor[F, A]): CallbackAcceptor[F, A] = + new CallbackAcceptor[F,A] { + override def apply[R](sk: SuccessContinuation[F,A,R])(fk: =>F[R]): F[R] = + a.apply(sk)(b.apply(sk)(fk)) + } + + def lift[A](fa: =>F[A]): CallbackAcceptor[F,A] = + new CallbackAcceptor[F,A] { + override def apply[R](sk: SuccessContinuation[F,A,R])(fk: =>F[R]): F[R] = + summon[CpsMonad[F]].flatMapTry(fa)(ta => sk(ta)(fk)) + } + + + + override def msplit[A](c: CallbackAcceptor[F, A]): CallbackAcceptor[F, Option[(Try[A], CallbackAcceptor[F, A])]] = { + val fcr = c.apply[Option[(Try[A],CallbackAcceptor[F,A])]]( + new SuccessContinuation[F,A,Option[(Try[A],CallbackAcceptor[F,A])]] { + override def apply(ta: Try[A])(fk: =>F[Option[(Try[A],CallbackAcceptor[F,A])]]): F[Option[(Try[A],CallbackAcceptor[F,A])]] = + val next = flatMap(lift(fk)) { + case None => (mzero: CallbackAcceptor[F,A]) + case Some((ta,sa)) => new CallbackAcceptor[F,A] { + override def apply[R](sk: SuccessContinuation[F,A,R])(fk: =>F[R]):F[R] = + sk(ta)(sa.apply(sk)(fk)) + } + } + summon[CpsMonad[F]].pure(Some((ta,next))) + } + )( summon[CpsMonad[F]].pure(None) ) + lift(fcr) + } + + def prepend[A](a: A, c: CallbackAcceptor[F, A]): CallbackAcceptor[F, A] = + new CallbackAcceptor[F,A] { + override def apply[R](sk: SuccessContinuation[F,A,R])(fk: =>F[R]): F[R] = + sk(Success(a))(c.apply(sk)(fk)) + } + + override def observerCpsMonad: CpsTryMonad[F] = summon[CpsTryMonad[F]] + + override def mObserveOne[A](m:CallbackAcceptor[F,A]): F[Option[A]] = { + msplit(m).apply[Option[A]]( + new SuccessContinuation[F,Option[(Try[A],CallbackAcceptor[F,A])],Option[A]] { + override def apply(ta: Try[Option[(Try[A],CallbackAcceptor[F,A])]])(fk: =>F[Option[A]]): F[Option[A]] = + ta match + case Success(v) => v match + case None => fk + case Some((ta,sa)) => + ta match + case Success(a) => + observerCpsMonad.pure(Some(a)) + case Failure(ex) => + observerCpsMonad.error(ex) + case Failure(ex) => + observerCpsMonad.error(ex) + })(summon[CpsMonad[F]].pure(None)) + } + + override def mFoldLeftN[A, B](ma: CallbackAcceptor[F, A], zero: F[B], n: Int)(op: (F[B], F[A]) => F[B]): F[B] = { + if (n<=0) then + zero + else + msplit(ma).apply[B]( + new SuccessContinuation[F,Option[(Try[A],CallbackAcceptor[F,A])],B] { + override def apply(ta: Try[Option[(Try[A],CallbackAcceptor[F,A])]])(fk: =>F[B]): F[B] = + ta match + case Success(v) => v match + case None => fk + case Some((ta,sa)) => + ta match + case Success(a) => + mFoldLeftN(sa,op(zero,observerCpsMonad.pure(a)),n-1)(op) + case Failure(ex) => + observerCpsMonad.error(ex) + case Failure(ex) => + observerCpsMonad.error(ex) + })(zero) + } + + override def mFoldLeft[A, B](ma: CallbackAcceptor[F, A], zero: F[B])(op: (F[B], F[A]) => F[B]): F[B] = { + msplit(ma).apply[B]( + new SuccessContinuation[F,Option[(Try[A],CallbackAcceptor[F,A])],B] { + override def apply(ta: Try[Option[(Try[A],CallbackAcceptor[F,A])]])(fk: =>F[B]): F[B] = + ta match + case Success(v) => v match + case None => fk + case Some((ta,sa)) => + ta match + case Success(a) => + mFoldLeft(sa,op(zero,observerCpsMonad.pure(a)))(op) + case Failure(ex) => + observerCpsMonad.error(ex) + case Failure(ex) => + observerCpsMonad.error(ex) + })(zero) + } + + } + + + + //given logicMonadSKF[F[_]:CpsTryMonad]: CpsLogicMonad[[X]=>>LogicCallbackAcceptor[F,X]] = + // LogicSKFKMonad[F]() + + given logicMonadT[F[_] : CpsTryMonad]: LogicSKFKMonad[F] = + LogicSKFKMonad[F]() + + +} diff --git a/shared/src/test/scala/logic/logict/LogicT.scala b/shared/src/test/scala/logic/logict/LogicT.scala deleted file mode 100644 index 0b069c81..00000000 --- a/shared/src/test/scala/logic/logict/LogicT.scala +++ /dev/null @@ -1,180 +0,0 @@ -package logic.logict - -import cps.* -import cps.monads.{*, given} - -import scala.util.* -import logic.* - -import scala.annotation.tailrec - -type LogicM[A] = LogicT[CpsIdentity,A] - - -given logicMonadM: LogicT.LogicSKFKMonad[CpsIdentity] = LogicT.logicMonadT[CpsIdentity] - - -/** - * Dependency-less port of haskell's LogicT monad transformer. - */ -type LogicT[F[_],+A] = LogicT.LogicCallbackAcceptor[F,A] - -object LogicT { - - - type SuccessContinuation[F[_],A,R] = Try[A]=>F[R]=>F[R] - - - trait LogicCallbackAcceptor[F[_],+A] { - /** - * - * @param sk - success continuation (like k wih continuation monad and s for succee) - * @param fk - failure continuation. - * @tparam A - type of value on the time of performing continuation - * @return - */ - def apply[R](sk: SuccessContinuation[F,A,R]): F[R] => F[R] - } - - - - class LogicSKFKMonad[F[_]:CpsTryMonad] extends CpsLogicMonad[[X]=>>LogicCallbackAcceptor[F,X]] - with CpsLogicMonadInstanceContext[[X]=>>LogicCallbackAcceptor[F,X]] { - - override type Observer[A] = F[A] - - override def pure[A](a:A): LogicCallbackAcceptor[F,A] = new LogicCallbackAcceptor[F,A] { - override def apply[R](sk: SuccessContinuation[F,A,R]): F[R] => F[R] = - sk(Success(a)) - } - - override def error[A](ex: Throwable): LogicCallbackAcceptor[F,A] = new LogicCallbackAcceptor[F,A] { - override def apply[R](sk: SuccessContinuation[F,A,R]): F[R] => F[R] = - sk(Failure(ex)) - } - - override def map[A, B](fa: LogicCallbackAcceptor[F, A])(f: A => B): LogicCallbackAcceptor[F, B] = - new LogicCallbackAcceptor[F,B] { - override def apply[R](sk: SuccessContinuation[F,B,R]): F[R] => F[R] = - fa.apply[R]{ - case Success(a) => sk(Success(f(a))) - case Failure(ex) => sk(Failure(ex)) - } - } - - override def flatMap[A, B](fa: LogicCallbackAcceptor[F, A])(f: A => LogicCallbackAcceptor[F, B]): LogicCallbackAcceptor[F, B] = { - flatMapTry(fa) { - case Success(a) => f(a) - case Failure(ex) => error(ex) - } - } - - override def flatMapTry[A,B](fa: LogicCallbackAcceptor[F,A])(f: Try[A] => LogicCallbackAcceptor[F,B]): LogicCallbackAcceptor[F,B] = - new LogicCallbackAcceptor[F,B] { - override def apply[R](sk: SuccessContinuation[F,B,R]): F[R] => F[R] = - fa.apply[R]( - { - case Success(a) => f(Success(a)).apply(sk) - case Failure(ex) => sk(Failure(ex)) - } - ) - } - - override def mzero: LogicCallbackAcceptor[F, Nothing] = - new LogicCallbackAcceptor[F,Nothing] { - override def apply[R](sk: SuccessContinuation[F,Nothing,R]): (F[R] => F[R]) = - identity[F[R]] - } - - override def mplus[A](a: LogicCallbackAcceptor[F, A], b: LogicCallbackAcceptor[F, A]): LogicCallbackAcceptor[F, A] = - new LogicCallbackAcceptor[F,A] { - override def apply[R](sk: SuccessContinuation[F,A,R]): (F[R] => F[R]) = - fk => a.apply(sk)(b.apply(sk)(fk)) - } - - def lift[A](fa:F[A]): LogicCallbackAcceptor[F,A] = - new LogicCallbackAcceptor[F,A] { - override def apply[R](sk: SuccessContinuation[F,A,R]): F[R] => F[R] = - fk => summon[CpsMonad[F]].flatMapTry(fa)(ta => sk(ta)(fk)) - } - - - - override def msplit[A](c: LogicCallbackAcceptor[F, A]): LogicCallbackAcceptor[F, Option[(Try[A], LogicCallbackAcceptor[F, A])]] = { - val fcr = c.apply[Option[(Try[A],LogicCallbackAcceptor[F,A])]]( - { c => cfk => - val next = flatMap(lift(cfk)) { - case None => (mzero: LogicCallbackAcceptor[F,A]) - case Some((ta,sa)) => new LogicCallbackAcceptor[F,A] { - override def apply[R](sk: SuccessContinuation[F,A,R]): (F[R] => F[R]) = - fk => sk(ta)(sa.apply(sk)(fk)) - } - } - summon[CpsMonad[F]].pure(Some((c,next))) - } - )( summon[CpsMonad[F]].pure(None) ) - lift(fcr) - } - - def prepend[A](a: A, c: LogicCallbackAcceptor[F, A]): LogicCallbackAcceptor[F, A] = - new LogicCallbackAcceptor[F,A] { - override def apply[R](sk: SuccessContinuation[F,A,R]): (F[R] => F[R]) = - fk => sk(Success(a))(c.apply(sk)(fk)) - } - - override def observerCpsMonad: CpsTryMonad[F] = summon[CpsTryMonad[F]] - - override def mObserveOne[A](m:LogicCallbackAcceptor[F,A]): F[Option[A]] = { - msplit(m).apply[Option[A]] { - case Success(v) => v match - case None => fk => fk - case Some((ta,sa)) => fk => - ta match - case Success(a) => observerCpsMonad.pure(Some(a)) - case Failure(ex) => observerCpsMonad.error(ex) - case Failure(ex) => fk => summon[CpsTryMonad[F]].error(ex) - }(summon[CpsMonad[F]].pure(None)) - } - - override def mFoldLeftN[A, B](ma: LogicCallbackAcceptor[F, A], zero: F[B], n: Int)(op: (F[B], F[A]) => F[B]): F[B] = { - if (n<=0) then - zero - else - msplit(ma).apply[B] { - case Success(v) => v match - case None => fk => fk - case Some((ta,sa)) => - ta match - case Success(a) => - fk => mFoldLeftN(sa, op(fk,observerCpsMonad.pure(a)), n-1)(op) - case Failure(ex) => - fk => observerCpsMonad.error(ex) - }(zero) - } - - override def mFoldLeft[A, B](ma: LogicCallbackAcceptor[F, A], zero: F[B], op: (F[B], F[A]) => F[B]): F[B] = { - msplit(ma).apply[B] { - case Success(v) => v match - case None => fk => fk - case Some((ta,sa)) => fk => - ta match - case Success(a) => - mFoldLeft(sa, op(fk,observerCpsMonad.pure(a)), op) - case Failure(ex) => - observerCpsMonad.error(ex) - case Failure(ex) => fk => observerCpsMonad.error(ex) - }(zero) - } - - } - - - - //given logicMonadSKF[F[_]:CpsTryMonad]: CpsLogicMonad[[X]=>>LogicCallbackAcceptor[F,X]] = - // LogicSKFKMonad[F]() - - given logicMonadT[F[_] : CpsTryMonad]: LogicSKFKMonad[F] = - LogicSKFKMonad[F]() - - -}