Merge branch 'scalaz-seven' of github.com:scalaz/scalaz into scalaz-s…

…even * 'scalaz-seven' of github.com:scalaz/scalaz: Fix up delimiter blocks in Category, Compose Remove alternative from GenTypeClass. Order no longer extends Function2 Some changes to Free examples for `KList` add `KList` aliases for `GenericList` tuned examples Added some Free operations
scalaz · Feb 10, 2012 · 119193b · 119193b
2 parents bb743f4 + bfdb5ba
commit 119193b
Show file tree

Hide file tree

Showing 8 changed files with 124 additions and 55 deletions.
diff --git a/core/src/main/scala/scalaz/Category.scala b/core/src/main/scala/scalaz/Category.scala
@@ -6,7 +6,6 @@ package scalaz
  */
 ////
 trait Category[=>:[_, _]] extends ArrId[=>:] with Compose[=>:] { self =>
-
   ////
   // TODO GeneralizedCategory, GeneralizedFunctor, et al, from Scalaz6 ?
 
@@ -36,5 +35,8 @@ trait Category[=>:[_, _]] extends ArrId[=>:] with Compose[=>:] { self =>
 
 object Category {
   @inline def apply[F[_, _]](implicit F: Category[F]): Category[F] = F
+
+  ////
+  ////
 }
 
diff --git a/core/src/main/scala/scalaz/Compose.scala b/core/src/main/scala/scalaz/Compose.scala
@@ -36,5 +36,8 @@ trait Compose[=>:[_, _]]  { self =>
 
 object Compose {
   @inline def apply[F[_, _]](implicit F: Compose[F]): Compose[F] = F
+
+  ////
+  ////
 }
 
diff --git a/core/src/main/scala/scalaz/Free.scala b/core/src/main/scala/scalaz/Free.scala
@@ -10,13 +10,13 @@ import std.tuple._
 object Free extends FreeFunctions with FreeInstances {
 
   /** Return from the computation with the given value. */
-  case class Return[S[+_], +A](a: A) extends Free[S, A]
+  case class Return[S[+_]: Functor, +A](a: A) extends Free[S, A]
 
   /** Suspend the computation with the given suspension. */
-  case class Suspend[S[+_], +A](a: S[Free[S, A]]) extends Free[S, A]
+  case class Suspend[S[+_]: Functor, +A](a: S[Free[S, A]]) extends Free[S, A]
 
   /** Call a subroutine and continue with the given function. */
-  case class Gosub[S[+_], A, +B](a: Free[S, A],
+  case class Gosub[S[+_]: Functor, A, +B](a: Free[S, A],
                                  f: A => Free[S, B]) extends Free[S, B]
 
   /** A computation that can be stepped through, suspended, and paused */
@@ -33,7 +33,7 @@ object Free extends FreeFunctions with FreeInstances {
 
 /** A free operational monad for some functor `S`. Binding is done using the heap instead of the stack,
   * allowing tail-call elimination. */
-sealed trait Free[S[+_], +A] {
+sealed abstract class Free[S[+_], +A](implicit S: Functor[S]) {
   final def map[B](f: A => B): Free[S, B] =
     flatMap(a => Return(f(a)))
 
@@ -48,48 +48,74 @@ sealed trait Free[S[+_], +A] {
   }
 
   /** Evaluates a single layer of the free monad. */
-  @tailrec final def resume(implicit S: Functor[S]): Either[S[Free[S, A]], A] = this match {
+  @tailrec final def resume: Either[S[Free[S, A]], A] = this match {
     case Return(a)  => Right(a)
     case Suspend(t) => Left(t)
     case a Gosub f  => a match {
       case Return(a)  => f(a).resume
-      case Suspend(t) => Left(S.map(t)(((_: Free[S, Any]) >>= f)))
-      case b Gosub g  => (Gosub(b, (x: Any) => Gosub(g(x), f)): Free[S, A]).resume
+      case Suspend(t) => Left(S.map(t)(((_: Free[S, Any]) flatMap f)))
+      case b Gosub g  => (Gosub(b, (x: Any) => g(x) flatMap f): Free[S, A]).resume
     }
   }
 
-  /** Modifies the suspension with the given natural transformation. */
-  final def mapSuspension[T[+_]](f: S ~> T)(implicit S: Functor[S]): Free[T, A] =
+  /** Changes the suspension functor by the given natural transformation. */
+  final def mapSuspension[T[+_]:Functor](f: S ~> T): Free[T, A] =
     resume match {
       case Left(s)  => Suspend(f(S.map(s)(((_: Free[S, A]) mapSuspension f))))
       case Right(r) => Return(r)
     }
 
-  import Liskov._
+  /** Modifies the first suspension with the given natural transformation. */
+  final def mapFirstSuspension(f: S ~> S): Free[S, A] = resume match {
+    case Left(s) => Suspend(f(s))
+    case Right(r) => Return(r)
+  }
 
-  /** Runs a trampoline all the way to the end, tail-recursively. */
-  def run[B >: A](implicit ev: Free[S, B] <~< Trampoline[B], S: Functor[S]): B = {
-    @tailrec def go(t: Trampoline[B]): B =
-      t.resume match {
-        case Left(s)  => go(s())
-        case Right(a) => a
+  /** Runs a single step, using a function that extracts the resumption from its suspension functor. */
+  final def bounce[AA >: A](f: S[Free[S, A]] => Free[S, AA]): Free[S, AA] = resume match {
+    case Left(s) => f(s)
+    case Right(r) => Return(r)
+  }
+
+  /** Runs to completion, using a function that extracts the resumption from its suspension functor. */
+  final def go[AA >: A](f: S[Free[S, AA]] => Free[S, AA]): AA = {
+    @tailrec def go2(t: Free[S, AA]): AA = t.resume match {
+      case Left(s) => go2(f(s))
+      case Right(r) => r
+    }
+    go2(this)
+  }
+
+  /** Runs to completion, allowing the resumption function to thread an arbitrary state of type `B`. */
+  final def foldRun[B, AA >: A](f: (B, S[Free[S, AA]]) => (B, Free[S, AA]), b: B): (B, AA) = {
+    @tailrec def foldRun2(t: Free[S, AA], z: B): (B, AA) = t.resume match {
+      case Left(s) => {
+        val (b1, s1) = f(z, s)
+        foldRun2(s1, b1) 
       }
-    go(ev(this))
+      case Right(r) => (z, r)
+    }
+    foldRun2(this, b)
   }
 
+  import Liskov._
+
+  /** Runs a trampoline all the way to the end, tail-recursively. */
+  def run[B >: A](implicit ev: Free[S, B] <~< Trampoline[B]): B =
+    ev(this).go(_())
+
   /** Interleave this computation with another, combining the results with the given function. */
-  def zipWith[B, C](tb: Free[S, B], f: (A, B) => C)(implicit S: Functor[S]): Free[S, C] = {
+  def zipWith[B, C](tb: Free[S, B], f: (A, B) => C): Free[S, C] = {
     (resume, tb.resume) match {
       case (Left(a), Left(b))   => Suspend(S.map(a)(x => Suspend(S.map(b)(y => x zipWith(y, f)))))
       case (Left(a), Right(b))  => Suspend(S.map(a)(x => x zipWith(Return(b), f)))
-      case (Right(a), Left(b))  => Suspend(S.map(b)(y => Return(a) zipWith(y, f)))
+      case (Right(a), Left(b))  => Suspend(S.map(b)(y => Return(a)(S) zipWith(y, f)))
       case (Right(a), Right(b)) => Return(f(a, b))
     }
   }
 
   /** Runs a `Source` all the way to the end, tail-recursively, collecting the produced values. */
-  def collect[B, C >: A](implicit ev: Free[S, C] <~< Source[B, C],
-                 S: Functor[S]): (Vector[B], C) = {
+  def collect[B, C >: A](implicit ev: Free[S, C] <~< Source[B, C]): (Vector[B], C) = {
     @tailrec def go(c: Source[B, C], v: Vector[B] = Vector()): (Vector[B], C) =
       c.resume match {
         case Left((b, cont)) => go(cont, v :+ b)
@@ -99,7 +125,7 @@ sealed trait Free[S[+_], +A] {
   }
 
   /** Drive this `Source` with the given Sink. */
-  def drive[E, B, C >: A](sink: Sink[Option[E], B])(implicit ev: Free[S, C] <~< Source[E, C], S: Functor[S]): (C, B) = {
+  def drive[E, B, C >: A](sink: Sink[Option[E], B])(implicit ev: Free[S, C] <~< Source[E, C]): (C, B) = {
     @tailrec def go(src: Source[E, C], snk: Sink[Option[E], B]): (C, B) =
       (src.resume, snk.resume) match {
         case (Left((e, c)), Left(f))  => go(c, f(Some(e)))
@@ -111,7 +137,7 @@ sealed trait Free[S[+_], +A] {
   }
 
   /** Feed the given stream to this `Source`. */
-  def feed[E, C >: A](ss: Stream[E])(implicit ev: Free[S, C] <~< Sink[E, C], S: Functor[S]): C = {
+  def feed[E, C >: A](ss: Stream[E])(implicit ev: Free[S, C] <~< Sink[E, C]): C = {
     @tailrec def go(snk: Sink[E, C], rest: Stream[E]): C = (rest, snk.resume) match {
       case (x #:: xs, Left(f)) => go(f(x), xs)
       case (Stream(), Left(f)) => go(f(sys.error("No more values.")), Stream())
@@ -121,7 +147,7 @@ sealed trait Free[S[+_], +A] {
   }
 
   /** Feed the given source to this `Sink`. */
-  def drain[E, B, C >: A](source: Source[E, B])(implicit ev: Free[S, C] <~< Sink[E, C], S: Functor[S]): (C, B) = {
+  def drain[E, B, C >: A](source: Source[E, B])(implicit ev: Free[S, C] <~< Sink[E, C]): (C, B) = {
     @tailrec def go(src: Source[E, B], snk: Sink[E, C]): (C, B) = (src.resume, snk.resume) match {
       case (Left((e, c)), Left(f))  => go(c, f(e))
       case (Left((e, c)), Right(y)) => go(c, Sink.sinkMonad[E].pure(y))
@@ -170,7 +196,7 @@ trait SourceInstances {
 // Trampoline, Sink, and Source are type aliases. We need to add their type class instances
 // to Free to be part of the implicit scope.
 trait FreeInstances extends TrampolineInstances with SinkInstances with SourceInstances {
-  implicit def freeMonad[S[+_]]: Monad[({type f[x] = Free[S, x]})#f] =
+  implicit def freeMonad[S[+_]:Functor]: Monad[({type f[x] = Free[S, x]})#f] =
     new Monad[({type f[x] = Free[S, x]})#f] {
       def point[A](a: => A) = Return(a)
       override def map[A, B](fa: Free[S, A])(f: A => B) = fa map f

diff --git a/core/src/main/scala/scalaz/Order.scala b/core/src/main/scala/scalaz/Order.scala
@@ -7,7 +7,7 @@ import scala.math.{Ordering => SOrdering}
  *
  */
 ////
-trait Order[F] extends Equal[F] with ((F, F) => Ordering) { self =>
+trait Order[F] extends Equal[F] { self =>
   ////
   def apply(x: F, y: F): Ordering = order(x, y)
 

diff --git a/example/src/main/scala/scalaz/example/TypelevelUsage.scala b/example/src/main/scala/scalaz/example/TypelevelUsage.scala
@@ -5,15 +5,17 @@ import Scalaz._
 import typelevel._
 import Typelevel._
 
-object TypelevelUsage {
+object TypelevelUsage extends App {
+
+  def typed[T](t: T) = ()
 
   object HLists {
 
     val hlist1 = 3 :: HNil
     val hlist2 = "foo" :: hlist1
 
-    val _hlist1: HCons[Int, HNil] = hlist1
-    val _hlist2: HCons[String, HCons[Int, HNil]] = hlist2
+    typed[Int :: HNil](hlist1)
+    typed[String :: Int :: HNil](hlist2)
 
     hlist2 match {
       case str :: n :: _ =>
@@ -25,14 +27,21 @@ object TypelevelUsage {
 
   object KLists {
 
-    val klist1 = None :^: Option(3) :^: Some("foo") :^: GenericNil[Some]
+    val klist1 = None :^: Option(3) :^: Some("foo") :^: KNil
     val klist2 = klist1.append(klist1)
+
+    klist1 match {
+      case optionInt1 :^: optionInt2 :^: someString :^: KNil =>
+        typed[Option[Int]](optionInt1)
+        typed[Option[Int]](optionInt2)
+        typed[Some[String]](someString)
+    }
 
     val klist3 = klist1.fold[Option, GenericList[Option], HFold.Append[Option, klist1.type]](new HFold.Append[Option, klist1.type](klist1))
 
-    val _klist1: GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Some, String, GenericNil[Some]]]] = klist1
-    val _klist2: GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Option, String, GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Some, String, GenericNil[Some]]]]]]] = klist2
-    val _klist3: GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Option, String, GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Some, String, GenericNil[Some]]]]]]] = klist3
+    typed[GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Some, String, GenericNil[Nothing]]]]](klist1)
+    typed[GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Option, String, GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Some, String, GenericNil[Nothing]]]]]]]](klist2)
+    typed[GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Option, String, GenericCons[Option, Nothing, GenericCons[Option, Int, GenericCons[Some, String, GenericNil[Nothing]]]]]]]](klist3)
 
   }
 
@@ -47,17 +56,16 @@ object TypelevelUsage {
     val kleislist2 = f2 :: f1 :: HNil
     val fCompose = kleislist2.compose
 
-    val _frc: Kleisli[Option, Int, Float] = fReverseCompose
-    val _fc: Kleisli[Option, Int, Float] = fCompose
-
+    typed[Kleisli[Option, Int, Float]](fReverseCompose)
+    typed[Kleisli[Option, Int, Float]](fCompose)
 
     val f3: Int => String = { _.toString }
     val f4: String => Float = { _.toFloat }
 
     val kleislist3 = f3 :: f4 :: HNil
     val fIdReverseCompose = kleislist3.reverseCompose
 
-    val _fidr: Kleisli[Id, Int, Float] = fIdReverseCompose
+    typed[Kleisli[Id, Int, Float]](fIdReverseCompose)
 
   }
 
@@ -103,7 +111,7 @@ object TypelevelUsage {
 
     val downed = aplist.down
 
-    val _downed: HCons[Option[Nothing], HCons[Option[Int], HCons[Option[String], HNil]]] = downed
+    typed[Option[Nothing] :: Option[Int] :: Option[String] :: HNil](downed)
 
     assert(downed == aplist)
 
@@ -115,7 +123,7 @@ object TypelevelUsage {
 
     val rev = klist1.fold[Option, GenericList[Option], HFold.Reverse[Option]](new HFold.Reverse[Option])
 
-    val _rev: GenericCons[Option, String, GenericCons[Option, Int, GenericCons[Option, Nothing, GenericNil[Option]]]] = rev
+    typed[GenericCons[Option, String, GenericCons[Option, Int, GenericCons[Option, Nothing, GenericNil[Option]]]]](rev)
 
   }
 
@@ -129,27 +137,24 @@ object TypelevelUsage {
     val e1 = hlist.at(_1)
     val e2 = hlist.at(_2)
 
-    val _e0: String = e0
-    val _e1: Int = e1
-    val _e2: Symbol = e2
+    typed[String](e0)
+    typed[Int](e1)
+    typed[Symbol](e2)
 
-    assert(_e0 == "foo")
-    assert(_e1 == 3)
-    assert(_e2 == 'a)
+    assert(e0 == "foo")
+    assert(e1 == 3)
+    assert(e2 == 'a)
 
     import KLists._
 
-    // Compiling the following snippets takes excessively long, so try to
-    // avoid access by index.
+    // Compiling the following snippets takes quite long, so try to avoid access
+    // by index. It gets even worse if you use an index greater than _4.
 
     val f0 = klist2.at(_4)
-    // val f1 = klist3.at(_4)
 
-    val _f0: Option[Int] = f0
-    // val _f1: Option[Int] = f1
+    typed[Option[Int]](f0)
 
-    assert(_f0 == Some(3))
-    // assert(_f1 == Some(3))
+    assert(f0 === Some(3))
 
   }
 
@@ -165,6 +170,16 @@ object TypelevelUsage {
 
   }
 
+  HLists
+  KLists
+  Kleislists
+  Folding
+  ALists
+  Downed
+  Reversed
+  Naturals
+  Classes
+
 }
 
 // vim: expandtab:ts=2:sw=2

diff --git a/project/GenTypeClass.scala b/project/GenTypeClass.scala
@@ -31,8 +31,6 @@ object TypeClass {
   lazy val pointed = TypeClass("Pointed", *->*, extendsList = Seq(functor))
   lazy val apply: TypeClass = TypeClass("Apply", *->*, extendsList = Seq(functor))
   lazy val applicative = TypeClass("Applicative", *->*, extendsList = Seq(apply, pointed))
-  lazy val alternative = TypeClass("Alternative", *->*, extendsList = Seq(applicative))
-  lazy val alternativeEmpty = TypeClass("AlternativeEmpty", *->*, extendsList = Seq(alternative))
   lazy val bind = TypeClass("Bind", *->*, extendsList = Seq(apply))
   lazy val monad = TypeClass("Monad", *->*, extendsList = Seq(applicative, bind))
   lazy val foldable = TypeClass("Foldable", *->*)

diff --git a/typelevel/src/main/scala/scalaz/typelevel/KList.scala b/typelevel/src/main/scala/scalaz/typelevel/KList.scala
@@ -0,0 +1,24 @@
+package scalaz
+package typelevel
+
+import Typelevel._
+
+trait KLists {
+
+  type KList[M[_]] = GenericList[M]
+  type KCons[M[_], H, +T <: KList[M]] = GenericCons[M, H, T]
+  type KNil[M[_]] = GenericNil[M]
+
+  object _KNil extends KNil[Nothing]
+
+  // This is here to force that `KNil` is of type `KNil.type`,
+  // and not of `object KNil`. Otherwise, there will be a type
+  // mismatch if used in a pattern match.
+  val KNil: _KNil.type = _KNil
+
+  def :^: = GenericCons
+
+}
+
+// vim: expandtab:ts=2:sw=2
+
diff --git a/typelevel/src/main/scala/scalaz/typelevel/Typelevel.scala b/typelevel/src/main/scala/scalaz/typelevel/Typelevel.scala
@@ -6,6 +6,7 @@ object Typelevel extends Typelevels
 trait Typelevels
   extends GenericLists
   with HLists
+  with KLists
   with TypeClasses
   with Numerals