The beginnings of mutually-recursive support.

core/jvm/src/test/scala/matryoshka/mutu/Common.scala

@@ -0,0 +1,79 @@
+/*
+ * Copyright 2014–2016 SlamData Inc.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *     http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+
+package matryoshka.mutu
+
+import matryoshka.∘
+import matryoshka.mutu.KEqual.ops._
+
+import scala.Int
+
+import scalaz._, Scalaz._
+
+sealed trait Value[A[_], I]
+final case class Lit[A[_]](i: Int) extends Value[A, Int]
+final case class Pair[A[_], I, J](l: A[I], r: A[J]) extends Value[A, (I, J)]
+
+object Value {
+  implicit val htraverse: HTraverse[Value] = new HTraverse[Value] {
+    def htraverse[F[_]: Applicative, A[_], B[_]](natM: A ~> (F ∘ B)#λ) =
+      new (Value[A, ?] ~> (F ∘ Value[B, ?])#λ) {
+        def apply[I](v: Value[A, I]) = v match {
+          case Lit(i) => Applicative[F].point(Lit(i))
+          case Pair(l, r) => (natM(l) ⊛ natM(r))(Pair(_, _))
+        }
+      }
+  }
+
+  implicit val equalhf: EqualHF[Value] = new EqualHF[Value] {
+    def eqHF[G[_]: KEqual, I, J](l: Value[G, I], r: Value[G, J]) =
+      (l, r) match {
+        case (Lit(i1),      Lit(i2))      => i1 ≟ i2
+        case (Pair(l1, r1), Pair(l2, r2)) => l1.keq(l2) && r1.keq(r2)
+        case (_,            _)            => false
+      }
+  }
+}
+
+sealed trait Op[A[_], I]
+final case class Add[A[_]](l: A[Int], r: A[Int]) extends Op[A, Int]
+final case class Mult[A[_]](l: A[Int], r: A[Int]) extends Op[A, Int]
+final case class Fst[A[_], I, J](p: A[(I, J)]) extends Op[A, I]
+final case class Snd[A[_], I, J](p: A[(I, J)]) extends Op[A, J]
+
+object Op {
+  implicit val htraverse: HTraverse[Op] = new HTraverse[Op] {
+    def htraverse[F[_]: Applicative, A[_], B[_]](natM: A ~> (F ∘ B)#λ) =
+      new (Op[A, ?] ~> (F ∘ Op[B, ?])#λ) {
+        def apply[I](v: Op[A, I]) = v match {
+          case Add(l, r) => (natM(l) ⊛ natM(r))(Add(_, _))
+          case Mult(l, r) => (natM(l) ⊛ natM(r))(Add(_, _))
+          case Fst(p) => natM(p).map(Fst(_))
+          case Snd(p) => natM(p).map(Snd(_))
+        }
+      }
+  }
+
+  implicit val equalhf: EqualHF[Op] = new EqualHF[Op] {
+    def eqHF[G[_]: KEqual, I, J](l: Op[G, I], r: Op[G, J]) = (l, r) match {
+      case (Add(l1, r1),  Add(l2, r2))  => l1.keq(l2) && r1.keq(r2)
+      case (Mult(l1, r1), Mult(l2, r2)) => l1.keq(l2) && r1.keq(r2)
+      case (Fst(p1),      Fst(p2))      => p1.keq(p2)
+      case (Snd(p1),      Snd(p2))      => p1.keq(p2)
+      case (_,            _)            => false
+    }
+  }
+}

core/jvm/src/test/scala/matryoshka/mutu/Eval.scala

@@ -0,0 +1,96 @@
+/*
+ * Copyright 2014–2016 SlamData Inc.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *     http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+
+package matryoshka.mutu
+
+import scala.{Int, None, Some}
+
+import org.specs2.mutable._
+
+trait Eval[F[_[_], _], V[_[_], _]] {
+  def eval[T[_[_[_], _], _]: HRecursive: HCorecursive]: Algebra[F, T[V, ?]]
+}
+
+object Eval {
+  def apply[F[_[_], _], V[_[_], _]](implicit E: Eval[F, V]) = E
+
+  implicit def sum[F[_[_], _], G[_[_], _], V[_[_], _]](
+    implicit F: Eval[F, V], G: Eval[G, V]):
+      Eval[(F ^+^ G)#λ, V] =
+    new Eval[(F ^+^ G)#λ, V] {
+      def eval[T[_[_[_], _], _]: HRecursive: HCorecursive] =
+        new Algebra[(F ^+^ G)#λ, T[V, ?]] {
+          def apply[I](fa: (F ^+^ G)#λ[T[V, ?], I]) = fa match {
+            case Inl(f) => F.eval[T].apply(f)
+            case Inr(g) => G.eval[T].apply(g)
+          }
+        }
+    }
+
+  implicit def component[F[_[_], _], V[_[_], _]](implicit F: F ^<^ V):
+      Eval[F, V] =
+    new Eval[F, V] {
+      def eval[T[_[_[_], _], _]: HRecursive: HCorecursive] =
+        new Algebra[F, T[V, ?]] {
+          def apply[I](fa: F[T[V, ?], I]) = HCorecursive[T].hembed(F.inj(fa))
+      }
+    }
+
+  implicit def op[V[_[_], _]](implicit V: Value ^<^ V): Eval[Op, V] =
+    new Eval[Op, V] {
+      def eval[T[_[_[_], _], _]: HRecursive: HCorecursive] =
+        new Algebra[Op, T[V, ?]] {
+          def apply[I](fa: Op[T[V, ?], I]) = fa match {
+            case Add(x, y) =>
+              HCorecursive[T].hembed(V.inj(Lit(projC(x) + projC(y))))
+            case Mult(x, y) =>
+              HCorecursive[T].hembed(V.inj(Lit(projC(x) * projC(y))))
+            case Fst(x) => projP(x)._1
+            case Snd(x) => projP(x)._2
+          }
+        }
+    }
+
+  def projC[T[_[_[_], _], _]: HRecursive, V[_[_], _]](t: T[V, Int])(implicit V: Value ^<^ V): Int =
+    V.prj(HRecursive[T].hproject(t)) match {
+      case Some(Lit(n)) => n
+      case None => scala.sys.error("no way, but gotta fix the types, I guess")
+    }
+
+  // TODO: Show that `None` is impossible
+  def projP[T[_[_[_], _], _]: HRecursive, V[_[_], _], I, J](t: T[V, (I, J)])(implicit V: Value ^<^ V): (T[V, I], T[V, J]) =
+    V.prj(HRecursive[T].hproject(t)) match {
+      case Some(Pair(x, y)) => (x, y)
+      case None => scala.sys.error("no way, but gotta fix the types, I guess")
+    }
+}
+
+class EvalSpec extends Specification {
+  type Sig[H[_], E] = (Op ^+^ Value)#λ[H, E]
+
+  implicit val V = scala.Predef.implicitly[Value ^<^ Sig]
+  implicit val O = scala.Predef.implicitly[Op ^<^ Sig]
+
+  "eval" should {
+    "result in a Value term" in {
+      HRecursive[FixH].cata(Eval[Sig, Value].eval[FixH]).apply(FixH(O.inj(Add(FixH(V.inj(Lit[FixH[Sig, ?]](1))), FixH(O.inj(Mult(FixH(V.inj(Lit[FixH[Sig, ?]](2))), FixH(V.inj(Lit[FixH[Sig, ?]](2)))))))))) must_== FixH(Lit[FixH[Value, ?]](5))
+    }
+
+    "same" in {
+      HRecursive[FixH].cata(Eval[Sig, Value].eval[FixH]).apply(FixH(O.inj(Fst(FixH(V.inj(Pair(FixH(V.inj(Lit[FixH[Sig, ?]](2))), FixH(V.inj(Lit[FixH[Sig, ?]](1)))))))))) must_== FixH(Lit[FixH[Value, ?]](2))
+    }
+  }
+}

core/jvm/src/test/scala/matryoshka/mutu/EvalId.scala

@@ -0,0 +1,74 @@
+/*
+ * Copyright 2014–2016 SlamData Inc.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *     http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+
+package matryoshka.mutu
+
+import org.specs2.mutable._
+import scalaz._, Scalaz._
+
+trait EvalId[F[_[_], _]] {
+  def evalId: Algebra[F, Id]
+}
+object EvalId {
+  def apply[F[_[_], _]](implicit E: EvalId[F]) = E
+
+  implicit def sum[F[_[_], _], G[_[_], _]](implicit F: EvalId[F], G: EvalId[G]):
+      EvalId[(F ^+^ G)#λ] =
+    new EvalId[(F ^+^ G)#λ] {
+      def evalId =
+        new Algebra[(F ^+^ G)#λ, Id] {
+          def apply[I](fa: (F ^+^ G)#λ[Id, I]) = fa match {
+            case Inl(f) => F.evalId(f)
+            case Inr(g) => G.evalId(g)
+          }
+        }
+    }
+
+  implicit val value: EvalId[Value] = new EvalId[Value] {
+    def evalId =
+      new Algebra[Value, Id] {
+        def apply[I](fa: Value[Id, I]) = fa match {
+          case Lit(n)     => n
+          case Pair(x, y) => (x, y)
+        }
+      }
+  }
+
+  implicit val op: EvalId[Op] = new EvalId[Op] {
+    def evalId =
+      new Algebra[Op, Id] {
+        def apply[I](fa: Op[Id, I]) = fa match {
+          case Add(x, y)   => x + y
+          case Mult(x, y)  => x * y
+          case Fst((x, _)) => x
+          case Snd((_, y)) => y
+        }
+      }
+  }
+}
+
+class EvalIdSpec extends Specification {
+  type Sig[H[_], E] = (Op ^+^ Value)#λ[H, E]
+
+  implicit val V = scala.Predef.implicitly[Value ^<^ Sig]
+  implicit val O = scala.Predef.implicitly[Op ^<^ Sig]
+
+  "evalId" should {
+    "result in an integer" in {
+      HRecursive[FixH].cata(EvalId[Sig].evalId).apply(FixH(O.inj(Fst(FixH(V.inj(Pair(FixH(V.inj(Lit[FixH[Sig, ?]](2))), FixH(V.inj(Lit[FixH[Sig, ?]](1)))))))))) must_== 2
+    }
+  }
+}

core/shared/src/main/scala/matryoshka/mutu/Ctx.scala

@@ -0,0 +1,25 @@
+/*
+ * Copyright 2014–2016 SlamData Inc.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *     http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+
+package matryoshka.mutu
+
+sealed trait Ctx[H, F[_[_], _], A[_], I]
+final case class Term[H, F[_[_], _], A[_], I](ft: F[Ctx[H, F, A, ?], I])
+    extends Ctx[H, F, A, I]
+final case class Hole[F[_[_], _], A[_], I](h: A[I]) extends Ctx[HoleX, F, A, I]
+
+trait HoleX
+trait NoHoleX

core/shared/src/main/scala/matryoshka/mutu/HFunctor.scala

@@ -0,0 +1,106 @@
+/*
+ * Copyright 2014–2016 SlamData Inc.
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ *     http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ */
+
+package matryoshka.mutu
+
+import matryoshka.∘
+
+import scala.{Boolean}
+import scala.inline
+
+import scalaz._
+import simulacrum.typeclass
+
+@typeclass trait KEqual[F[_]] {
+  def keq[I, J](l: F[I], r: F[J]): Boolean
+}
+
+// TODO[simulacrum]: These should be typeclasses, but simulacrum doesn’t like
+//                   the shape of them.
+
+// TODO: determine if we need to “delay” this
+trait EqualHF[F[_[_], _]] {
+  def eqHF[G[_]: KEqual, I, J](l: F[G, I], r: F[G, J]): Boolean
+}
+object EqualHF {
+  def apply[F[_[_], _]](implicit F: EqualHF[F]) = F
+
+  implicit def kequal[F[_[_], _]: EqualHF, G[_]: KEqual, I, J]:
+      KEqual[F[G, ?]] =
+    new KEqual[F[G, ?]] {
+      def keq[I, J](l: F[G, I], r: F[G, J]) = EqualHF[F].eqHF(l, r)
+    }
+}
+
+trait HFunctor[H[_[_], _]] {
+  // def fmap[F[_]: Functor, A, B](hfa: H[F, A])(f: A => B): H[F, B]
+  def hmap[F[_], G[_]](f: F ~> G): H[F, ?] ~> H[G, ?]
+}
+object HFunctor {
+  def apply[H[_[_], _]](implicit H: HFunctor[H]) = H
+
+  // implicit def hfunctorFunctor[H[_[_], _]: HFunctor, F[_]: Functor]:
+  //     Functor[H[F, ?]] =
+  //   new Functor[H[F, ?]] {
+  //     def map[A, B](fa: H[F, A])(f: A => B) = HFunctor[H].fmap(fa)(f)
+  //   }
+}
+
+trait HPointed[H[_[_], _]] extends HFunctor[H] {
+  def hpoint[F[_]: Functor, A](fa: F[A]): H[F, A]
+}
+object HPointed {
+  // implicit def hpointedPointed[H[_[_], _]: HPointed, F[_]: Pointed]:
+  //     Pointed[H[F, ?]] =
+  //   new Pointed[H[F, ?]] {
+  //     def point[A](a: A) = HPointed[H].hpoint(a.point[F])
+  //   }
+}
+
+trait HCopointed[H[_[_], _]] extends HFunctor[H] {
+  def hcopoint[F[_]: Functor, A](hf: H[F, A]): F[A]
+}
+object HCopointed {
+  // implicit def hcopointedCopointed[H[_[_], _]: HCopointed, F[_]: Copointed]:
+  //     Copointed[H[F, ?]] =
+  //   new Copointed[H[F, ?]] {
+  //     def copoint[A](hf: H[F, A]) = HCopointed[H].hcopoint(hf).copoint
+  //   }
+}
+
+// trait HFoldable[H[_[_], _]] {
+//   def hfold[M: Monoid]: H[K[M, ?], ?] :=> M = hfoldMap[K[M, ?], M](_.unK)
+
+//   def hfoldMap[A[_], M](f: A :=> M)(implicit M: Monoid[M]): H[A, ?] :=> M =
+//     hfoldr(l => M.append(f(l), _), M.zero)
+
+//   def hfoldr[A[_], B](f: A :=> B => B, z: B): H[A, ?] :=> B =
+//     new (H[A, ?] :=> B) {
+//       def apply[I](t: H[A, I]) = appEndo(hfoldMap(Endo <<< f)(t), z)
+//     }
+// }
+
+trait HTraverse[H[_[_], _]] extends HFunctor[H] // with HFoldable[H]
+{
+  def htraverse[F[_]: Applicative, A[_], B[_]](natM: A ~> (F ∘ B)#λ):
+      H[A, ?] ~> (F ∘ H[B, ?])#λ
+
+  def hmap[F[_], G[_]](f: F ~> G): H[F, ?] ~> H[G, ?] =
+    htraverse[Scalaz.Id, F, G](f)
+}
+object HTraverse {
+  def apply[H [_[_], _]](implicit H: HTraverse[H]) = H
+}