From 285a314c4db6c52f80414598c04872fd252e829d Mon Sep 17 00:00:00 2001
From: Stewart Stewart <stewinsalot@gmail.com>
Date: Mon, 10 Aug 2015 22:54:31 -0700
Subject: Initial commit.

---
 .gitignore                 |   1 +
 CLTerms.scala              |  53 ++++++++++++
 build.sbt                  |   5 ++
 src/test/scala/Tests.scala | 203 +++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 262 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 CLTerms.scala
 create mode 100644 build.sbt
 create mode 100644 src/test/scala/Tests.scala

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..2f7896d
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+target/
diff --git a/CLTerms.scala b/CLTerms.scala
new file mode 100644
index 0000000..5822428
--- /dev/null
+++ b/CLTerms.scala
@@ -0,0 +1,53 @@
+package object cl {
+  sealed trait Term {
+    def *(that: Term) = cl.*(this, that)
+
+    // Given a term M and variable x, M.extract(x) returns a term
+    // without x, M', s.t. (M' * x) evaluates the same way as M
+    def extract(x: Var): Term = this match {
+      case a: Atom if a != x => K * a
+      case a: Atom if a == x => I
+      case l * r => S * l.extract(x) * r.extract(x)
+    }
+
+    def contains(x: Var): Boolean = ???
+  }
+
+  case class *(left: Term, right: Term) extends Term {
+    override def toString = this match {
+      case p * (q * r) => s"$p(${q * r})"
+      case _ => s"$left$right"
+    }
+  }
+
+  def eval(t: Term): Term = ???
+
+  def bracketAbstraction(f: Term => Term): Term = {
+    val x = Var("variable")
+    f(x).extract(x)
+  }
+
+  def bracketAbstraction(f: (Term, Term) => Term): Term = {
+    val x = Var("variable-x")
+    val y = Var("variable-y")
+    f(x, y).extract(y).extract(x)
+  }
+
+  sealed trait Atom extends Term
+  sealed trait Const extends Atom
+  case object S extends Const
+  case object K extends Const
+  case object I extends Const
+  case object B extends Const
+  case object C extends Const
+  case object W extends Const
+  case object Bp extends Const
+  case object Cp extends Const
+  case object Sp extends Const
+
+  case class Var(name: String) extends Atom {
+    override def toString = name
+  }
+
+  implicit def symbolToVar(s: Symbol) = new Var(s.name)
+}
diff --git a/build.sbt b/build.sbt
new file mode 100644
index 0000000..ed95091
--- /dev/null
+++ b/build.sbt
@@ -0,0 +1,5 @@
+scalaVersion:="2.11.7"
+
+libraryDependencies += "com.lihaoyi" %% "utest" % "0.3.1"
+
+testFrameworks += new TestFramework("utest.runner.Framework")
diff --git a/src/test/scala/Tests.scala b/src/test/scala/Tests.scala
new file mode 100644
index 0000000..1c28875
--- /dev/null
+++ b/src/test/scala/Tests.scala
@@ -0,0 +1,203 @@
+import utest._
+import utest.ExecutionContext
+import cl._
+
+object Tests extends TestSuite {
+  val tests = TestSuite {
+    val p: Var = 'p
+    val q: Var = 'q
+    val r: Var = 'r
+    val s: Var = 's
+
+    'usage {
+      val pq = p * q
+      val pqr = p * q * r
+      val pqrs = p * q * r * s
+      val parens = p * (q * r) * s
+      val nested = p * (parens) * s
+      val nestedLeft = (((p * q) * r) * s)
+      val nestedRight = (p * (q * (r * s)))
+
+      'toString {
+        assert(
+          pq.toString == "pq",
+          pqr.toString == "pqr",
+          pqrs.toString == "pqrs",
+          parens.toString == "p(qr)s",
+          nested.toString == "p(p(qr)s)s",
+          nestedLeft.toString == "pqrs",
+          nestedRight.toString == "p(q(rs))"
+        )
+      }
+
+      'equality {
+        "non-commutative"-{
+          assert(
+            p * q == p * q,
+            p * q != q * p
+          )
+        }
+
+        "non-associative"-{
+          assert(p * (q*r) != (p*q) * r)
+        }
+
+        "left-associative"-{
+          assert(
+            p * q * r * s == (((p*q) * r) * s),
+            p * q * r * s != (p * (q * (r*s)))
+          )
+        }
+      }
+
+      "contains"-{
+        assert(
+          pq.contains(p),
+          pq.contains(q),
+          !pq.contains(r),
+          nestedRight.contains(s)
+        )
+      }
+    }
+
+    "reduction"-{
+      /*
+      "Evaluation is complete when..."-{
+        "...the term begins with a var"-{
+          val vars = s*s*s*s*s*s
+          assert(
+            eval(s) == s,
+            eval(s*s) == s*s,
+            eval(vars) == (vars),
+            eval(s * K * p * q) == (s * K * p * q)
+          )
+        }
+
+        "...the leading combinator has too few arguments for reduction"-{
+          assert(
+            eval(K) == K,
+            eval(K * p) == K * p,
+            eval(K * p * p) == p
+          )
+        }
+      }
+
+      "basic combinators"-{
+        assert(
+          eval(I * p) == p,
+          eval(K * p * q) == p,
+          eval(S * p * q * r) == p * r * (q * r)
+        )
+      }
+
+      "head reduction"-{
+        // NOTE: Implementing head reduction separately is optional,
+        // but could be a helpful first step.
+        assert(
+          //evalHead(K * p * q * r * s) == p * r * s,
+          //evalHead(K * p * q * K * p * q) == p * K * p * q,
+          //evalHead(K * I * p * q) == I * q
+        )
+      }
+
+      "step by step reduction"-{
+        /*assert(
+          evalHead(S * (K * S) * K * p * q * r) == (S * (K * S) * K * p * q),
+          evalHead(S * (K * S) * K * p * q)     == (K * S * p * (K * p) * q),
+          evalHead(K * S * p * (K * p) * q)     == (S * (K * p) * q),
+          evalHead(S * (K * p) * q)             == (S * (K * p) * q * r),
+          evalHead(S * (K * p) * q * r)         == (K * p * r * (q * r)),
+          evalHead(K * p * r * (q * r))         == (p * (q * r))
+        )*/
+      }
+
+      "complete reduction"-{
+        assert(
+          eval(S * (K * S) * K * p * q * r) == p * (q * r),
+          eval(Sp * K * I * I * s) == s,
+          eval(B * (B * S) * B * K * I * I * s) == s,
+          eval(S*(K*S)*K * (S*(K*S)*K * S) * (S*(K*S)*K) * K * (S*K*K) * I * s) == s
+        )
+      }
+       */
+    }
+
+    "bracket abstraction"-{
+      /*
+      val TRUE = K
+      val FALSE = K*I
+
+      def evalBool(bool: Term): Boolean = {
+        val p: Var = 'P
+        val q: Var = 'Q
+        // if bool then p else q
+        eval(bool * p * q) match {
+          case x if x == p => true
+          case x if x == q => false
+        }
+      }
+
+      "Booleans evaluating properly"-{
+        assert(
+          evalBool(TRUE),
+          !evalBool(FALSE)
+        )
+      }
+
+      def not = (p: Term) => p * FALSE * TRUE
+      def and = (p: Term, q: Term) => p * q * FALSE
+      def or = (p: Term, q: Term) => p * TRUE * q
+
+      "basic boolean functions"-{
+        assert(
+          evalBool(not(FALSE)),
+          !evalBool(not(TRUE)),
+
+          evalBool(and(TRUE, TRUE)),
+          !evalBool(and(TRUE, FALSE)),
+          !evalBool(and(FALSE, TRUE)),
+          !evalBool(and(FALSE, FALSE)),
+
+          evalBool(or(TRUE, TRUE)),
+          evalBool(or(TRUE, FALSE)),
+          evalBool(or(FALSE, TRUE)),
+          !evalBool(or(FALSE, FALSE))
+        )
+      }
+
+      "variable extraction"-{
+        val x: Var = 'x
+        val term = not(x).extract(x)
+
+        assert(
+          not(x).contains(x),
+          !term.contains(x),
+          evalBool(term * TRUE) == evalBool(not(TRUE)),
+          evalBool(term * FALSE) == evalBool(not(FALSE))
+        )
+      }
+
+      "boolean functions abstracted"-{
+        val NOT: Term = bracketAbstraction(not)
+        val AND: Term = bracketAbstraction(and)
+        val OR: Term = bracketAbstraction(or)
+
+        assert(
+          evalBool(NOT * FALSE),
+          !evalBool(NOT * TRUE),
+
+          evalBool(AND * TRUE * TRUE),
+          !evalBool(AND * TRUE * FALSE),
+          !evalBool(AND * FALSE * TRUE),
+          !evalBool(AND * FALSE * FALSE),
+
+          evalBool(OR * TRUE * TRUE),
+          evalBool(OR * TRUE * FALSE),
+          evalBool(OR * FALSE * TRUE),
+          !evalBool(OR * FALSE * FALSE)
+        )
+      }
+      */
+    }
+  }
+}
-- 
cgit v1.2.3