# HG changeset patch
# User Christian Urban <christian dot urban at kcl dot ac dot uk>
# Date 1383146054 0
# Node ID 47b5c91eff470b2dbb2ae7c96b675dd42d44d2ef
# Parent  8db273a410ccf86edbcc5d5d6b050f3598711de8
added

diff -r 8db273a410cc -r 47b5c91eff47 progs/comb1.scala
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/progs/comb1.scala	Wed Oct 30 15:14:14 2013 +0000
@@ -0,0 +1,100 @@
+import scala.language.implicitConversions
+import scala.language.reflectiveCalls
+
+abstract class Parser[I <% Seq[_], T] {
+  def parse(ts: I): Set[(T, I)]
+
+  def parse_all(ts: I) : Set[T] =
+    for ((head, tail) <- parse(ts); if (tail.isEmpty)) yield head
+}
+
+class SeqParser[I <% Seq[_], T, S](p: => Parser[I, T], q: => Parser[I, S]) extends Parser[I, (T, S)] {
+  def parse(sb: I) = 
+    for ((head1, tail1) <- p.parse(sb); 
+         (head2, tail2) <- q.parse(tail1)) yield ((head1, head2), tail2)
+}
+
+class AltParser[I <% Seq[_], T](p: => Parser[I, T], q: => Parser[I, T]) extends Parser[I, T] {
+  def parse(sb: I) = p.parse(sb) ++ q.parse(sb)   
+}
+
+class FunParser[I <% Seq[_], T, S](p: => Parser[I, T], f: T => S) extends Parser[I, S] {
+  def parse(sb: I) = 
+    for ((head, tail) <- p.parse(sb)) yield (f(head), tail)
+}
+
+// atomic parsers
+case class StringParser(s: String) extends Parser[String, String] {
+  def parse(sb: String) = {
+    val (prefix, suffix) = sb.splitAt(s.length)
+    if (prefix == s) Set((prefix, suffix)) else Set()
+  }
+}
+
+case object NumParser extends Parser[String, String] {
+  val reg = "[0-9]+".r
+  def parse(sb: String) = reg.findPrefixOf(sb) match {
+    case None => Set()
+    case Some(s) => Set(sb.splitAt(s.length)) 
+  }
+}
+
+
+implicit def string2parser(s : String) = StringParser(s)
+
+implicit def ParserOps[I<% Seq[_], T](p: Parser[I, T]) = new {
+  def || (q : => Parser[I, T]) = new AltParser[I, T](p, q)
+  def ==>[S] (f: => T => S) = new FunParser[I, T, S](p, f)
+  def ~[S] (q : => Parser[I, S]) = new SeqParser[I, T, S](p, q)
+}
+
+implicit def StringOps(s: String) = new {
+  def || (q : => Parser[String, String]) = new AltParser[String, String](s, q)
+  def || (r: String) = new AltParser[String, String](s, r)
+  def ==>[S] (f: => String => S) = new FunParser[String, String, S](s, f)
+  def ~[S] (q : => Parser[String, S]) = 
+    new SeqParser[String, String, S](s, q)
+  def ~ (r: String) = 
+    new SeqParser[String, String, String](s, r)
+}
+
+
+
+
+lazy val Pal : Parser[String, String] = 
+  (("a" ~ Pal ~ "a") ==> { case ((x, y), z) => x + y + z } ||
+   ("b" ~ Pal ~ "b") ==> { case ((x, y), z) => x + y + z } || "")
+
+Pal.parse_all("ababbaba")
+
+
+lazy val P : Parser[String, String] = 
+  "(" ~ P ~ ")" ~ P ==> { case (((u, x), y), z) => "{" + x + "}" + z } || ""
+
+P.parse_all("(((()()))())")
+P.parse_all("(((()()))()))")
+P.parse_all(")(")
+
+lazy val E: Parser[String, String] = 
+  (F ~ "*" ~ F) ==> { case ((x, y), z) => x + y + z } || F  
+lazy val F: Parser[String, String] = 
+  ((T ~ "+" ~ T) ==> { case ((x, y), z) => x + y + z } ||
+   (T ~ "-" ~ T) ==> { case ((x, y), z) => x + y + z } || T)
+lazy val T: Parser[String, String] = 
+  ("(" ~ E ~ ")") ==> { case ((x, y), z) => x + y + z } || NumParser
+
+
+println(E.parse_all("1+2+3"))
+
+
+
+// non-ambiguous vs ambiguous
+lazy val U : Parser[String, String] =
+  ("1" ~ U) ==> { case (x, y) => x + y } || ""
+
+U.parse_all("1" * 100 + "0")
+
+lazy val S : Parser[String, String] =
+  ("1" ~ S ~ S) ==> { case ((x, y), z) => x + y + z } || ""
+
+S.parse_all("1" * 15)
diff -r 8db273a410cc -r 47b5c91eff47 progs/comb2.scala
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/progs/comb2.scala	Wed Oct 30 15:14:14 2013 +0000
@@ -0,0 +1,193 @@
+import scala.language.implicitConversions
+import scala.language.reflectiveCalls
+
+abstract class Parser[I <% Seq[_], T] {
+  def parse(ts: I): Set[(T, I)]
+
+  def parse_all(ts: I) : Set[T] =
+    for ((head, tail) <- parse(ts); if (tail.isEmpty)) yield head
+}
+
+class SeqParser[I <% Seq[_], T, S](p: => Parser[I, T], q: => Parser[I, S]) extends Parser[I, (T, S)] {
+  def parse(sb: I) = 
+    for ((head1, tail1) <- p.parse(sb); 
+         (head2, tail2) <- q.parse(tail1)) yield ((head1, head2), tail2)
+}
+
+class AltParser[I <% Seq[_], T](p: => Parser[I, T], q: => Parser[I, T]) extends Parser[I, T] {
+  def parse(sb: I) = p.parse(sb) ++ q.parse(sb)   
+}
+
+class FunParser[I <% Seq[_], T, S](p: => Parser[I, T], f: T => S) extends Parser[I, S] {
+  def parse(sb: I) = 
+    for ((head, tail) <- p.parse(sb)) yield (f(head), tail)
+}
+
+case class StringParser(s: String) extends Parser[String, String] {
+  def parse(sb: String) = {
+    val (prefix, suffix) = sb.splitAt(s.length)
+    if (prefix == s) Set((prefix, suffix)) else Set()
+  }
+}
+
+case object NumParser extends Parser[String, Int] {
+  val reg = "[0-9]+".r
+  def parse(sb: String) = reg.findPrefixOf(sb) match {
+    case None => Set()
+    case Some(s) => {
+      val (head, tail) = sb.splitAt(s.length)
+      Set((head.toInt, tail)) 
+    }
+  }
+}
+
+
+implicit def string2parser(s : String) = StringParser(s)
+
+implicit def ParserOps[I<% Seq[_], T](p: Parser[I, T]) = new {
+  def || (q : => Parser[I, T]) = new AltParser[I, T](p, q)
+  def ==>[S] (f: => T => S) = new FunParser[I, T, S](p, f)
+  def ~[S] (q : => Parser[I, S]) = new SeqParser[I, T, S](p, q)
+}
+
+implicit def StringOps(s: String) = new {
+  def || (q : => Parser[String, String]) = new AltParser[String, String](s, q)
+  def || (r: String) = new AltParser[String, String](s, r)
+  def ==>[S] (f: => String => S) = new FunParser[String, String, S](s, f)
+  def ~[S](q : => Parser[String, S]) = 
+    new SeqParser[String, String, S](s, q)
+  def ~ (r: String) = 
+    new SeqParser[String, String, String](s, r)
+}
+
+lazy val E: Parser[String, Int] = 
+  (T ~ "+" ~ E) ==> { case ((x, y), z) => x + z} || T  
+lazy val T: Parser[String, Int] = 
+  (F ~ "*" ~ T) ==> { case ((x, y), z) => x * z} || F
+lazy val F: Parser[String, Int] = 
+  ("(" ~ E ~ ")") ==> { case ((x, y), z) => y} || NumParser
+
+println(E.parse_all("1+2+3"))
+println(E.parse_all("1+2*3+1"))
+
+
+// no left-recursion allowed
+lazy val EL: Parser[String, Int] = 
+  ((EL ~ "+" ~ EL) ==> { case ((x, y), z) => x + z} || 
+   (EL ~ "*" ~ EL) ==> { case ((x, y), z) => x * z} ||
+   ("(" ~ EL ~ ")") ==> { case ((x, y), z) => y} ||
+   NumParser)
+
+//println(E.parse_all("1+2+3"))
+
+
+// the abstract syntax trees for the WHILE language
+abstract class Stmt
+abstract class AExp
+abstract class BExp 
+
+type Block = List[Stmt]
+
+case object Skip extends Stmt
+case class If(a: BExp, bl1: Block, bl2: Block) extends Stmt
+case class While(b: BExp, bl: Block) extends Stmt
+case class Assign(s: String, a: AExp) extends Stmt
+
+case class Var(s: String) extends AExp
+case class Num(i: Int) extends AExp
+case class Aop(o: String, a1: AExp, a2: AExp) extends AExp
+
+case object True extends BExp
+case object False extends BExp
+case class Bop(o: String, a1: AExp, a2: AExp) extends BExp
+
+
+case object IdParser extends Parser[String, String] {
+  val reg = "[a-z][a-z,0-9]*".r
+  def parse(sb: String) = reg.findPrefixOf(sb) match {
+    case None => Set()
+    case Some(s) => Set(sb.splitAt(s.length))
+  }
+}
+
+lazy val AExp: Parser[String, AExp] = 
+  ((Te ~ "+" ~ AExp) ==> { case ((x, y), z) => Aop("+", x, z): AExp } ||
+   (Te ~ "-" ~ AExp) ==> { case ((x, y), z) => Aop("-", x, z): AExp } || Te)  
+lazy val Te: Parser[String, AExp] = 
+  (Fa ~ "*" ~ Te) ==> { case ((x, y), z) => Aop("*", x, z): AExp } || Fa
+lazy val Fa: Parser[String, AExp] = 
+  (("(" ~ AExp ~ ")") ==> { case ((x, y), z) => y } || 
+   IdParser ==> ((s:String) => Var(s) :AExp) || 
+   NumParser ==> ((i:Int) => Num(i) :AExp))
+
+// boolean expressions
+lazy val BExp: Parser[String, BExp] = 
+  ((AExp ~ "=" ~ AExp) ==> { case ((x, y), z) => Bop("=", x, z): BExp } || 
+   (AExp ~ "!=" ~ AExp) ==> { case ((x, y), z) => Bop("!=", x, z): BExp } || 
+   (AExp ~ "<" ~ AExp) ==> { case ((x, y), z) => Bop("<", x, z): BExp } || 
+   (AExp ~ ">" ~ AExp) ==> { case ((x, y), z) => Bop(">", x, z): BExp } || 
+   ("true" ==> ((_) => True: BExp)) || 
+   ("false" ==> ((_) => False: BExp)) ||
+   ("(" ~ BExp ~ ")") ==> { case ((x, y), z) => y})
+
+lazy val Stmt: Parser[String, Stmt] =
+  (("skip" ==> ((_) => Skip: Stmt)) ||
+   (IdParser ~ ":=" ~ AExp) ==> { case ((x, y), z) => Assign(x, z): Stmt } ||
+   ("if" ~ BExp ~ "then" ~ Block ~ "else" ~ Block) ==>
+    { case (((((x,y),z),u),v),w) => If(y, u, w): Stmt } ||
+   ("while" ~ BExp ~ "do" ~ Block) ==> { case (((x, y), z), w) => While(y, w) }) 
+ 
+lazy val Stmts: Parser[String, Block] =
+  (Stmt ~ ";" ~ Stmts) ==> { case ((x, y), z) => x :: z : Block } ||
+  (Stmt ==> ((s) => List(s) : Block))
+
+lazy val Block: Parser[String, Block] =
+  (("{" ~ Stmts ~ "}") ==> { case ((x, y), z) => y} || 
+   (Stmt ==> ((s) => List(s))))
+
+
+Block.parse_all("x2:=5")
+Block.parse_all("{x:=5;y:=8}")
+Block.parse_all("if(false)then{x:=5}else{x:=10}")
+
+val fib = """{n:=10;minus1:=0;minus2:=1;temp:=0;while(n>0)do{temp:=minus2;minus2:=minus1+minus2;minus1:=temp;n:=n-1};result:=minus2}"""
+
+Block.parse_all(fib)
+
+// an interpreter for the WHILE language
+type Env = Map[String, Int]
+
+def eval_aexp(a: AExp, env : Env) : Int = a match {
+  case Num(i) => i
+  case Var(s) => env(s)
+  case Aop("+", a1, a2) => eval_aexp(a1, env) + eval_aexp(a2, env)
+  case Aop("-", a1, a2) => eval_aexp(a1, env) - eval_aexp(a2, env)
+  case Aop("*", a1, a2) => eval_aexp(a1, env) * eval_aexp(a2, env)
+}
+
+def eval_bexp(b: BExp, env: Env) : Boolean = b match {
+  case True => true
+  case False => false
+  case Bop("=", a1, a2) => eval_aexp(a1, env) == eval_aexp(a2, env)
+  case Bop("!=", a1, a2) => !(eval_aexp(a1, env) == eval_aexp(a2, env))
+  case Bop(">", a1, a2) => eval_aexp(a1, env) > eval_aexp(a2, env)
+  case Bop("<", a1, a2) => eval_aexp(a1, env) < eval_aexp(a2, env)
+}
+
+def eval_stmt(s: Stmt, env: Env) : Env = s match {
+  case Skip => env
+  case Assign(x, a) => env + (x -> eval_aexp(a, env))
+  case If(b, bl1, bl2) => if (eval_bexp(b, env)) eval_bl(bl1, env) else eval_bl(bl2, env) 
+  case While(b, bl) => 
+    if (eval_bexp(b, env)) eval_stmt(While(b, bl), eval_bl(bl, env))
+    else env
+}
+
+def eval_bl(bl: Block, env: Env) : Env = bl match {
+  case Nil => env
+  case s::bl => eval_bl(bl, eval_stmt(s, env))
+}
+
+def eval(bl: Block) : Env = eval_bl(bl, Map())
+
+eval(Block.parse_all(fib).head)("result")