Commit 8ae06c27 authored by Sapphie's avatar Sapphie
Browse files

Import assignment1 skeleton

parent e094738f
package l3
import l3.{ L3Primitive => L3 }
object CL3ToCPSTranslator extends (Any => Nothing) {
def apply(tree: Any): Nothing =
???
}
package l3
import scala.annotation.tailrec
import scala.collection.mutable.{ Map => MutableMap }
import IO._
/**
* A tree-based interpreter for the CPS languages.
*
* @author Michel Schinz <Michel.Schinz@epfl.ch>
*/
sealed abstract class CPSInterpreter[M <: CPSTreeModule](
protected val treeModule: M,
log: M#Tree => Unit = { _ : M#Tree => () }) {
import treeModule._
def apply(tree: Tree): TerminalPhaseResult =
Right((eval(tree, emptyEnv), None))
protected sealed trait Value
protected case class FunV(retC: Name, args: Seq[Name], body: Tree, env: Env)
extends Value
protected case class CntV(args: Seq[Name], body: Tree, env: Env)
extends Value
protected type Env = PartialFunction[Name, Value]
protected val emptyEnv: Env = Map.empty
@tailrec
private def eval(tree: Tree, env: Env): Int = {
def resolve(a: Atom): Value = a match {
case AtomN(n) => env(n)
case AtomL(l) => evalLit(l)
}
log(tree)
(tree: @unchecked) match {
case LetP(name, prim, args, body) =>
eval(body, Map(name->evalValuePrim(prim, args map resolve)) orElse env)
case LetC(cnts, body) =>
val recEnv = MutableMap[Name, Value]()
val env1 = recEnv orElse env
for (Cnt(name, args, body) <- cnts)
recEnv(name) = CntV(args, body, env1)
eval(body, env1)
case LetF(funs, body) =>
val recEnv = MutableMap[Name, Value]()
val env1 = recEnv orElse env
for (Fun(name, retC, args, body) <- funs)
recEnv(name) = wrapFunV(FunV(retC, args, body, env1))
eval(body, env1)
case AppC(cnt, args) =>
val CntV(cArgs, cBody, cEnv) = env(cnt)
assume(cArgs.length == args.length)
eval(cBody, (cArgs zip (args map resolve)).toMap orElse cEnv)
case AppF(fun, retC, args) =>
val FunV(fRetC, fArgs, fBody, fEnv) = unwrapFunV(resolve(fun))
assume(fArgs.length == args.length)
val rArgs = args map resolve
val env1 = ((fRetC +: fArgs) zip (env(retC) +: rArgs)).toMap orElse fEnv
eval(fBody, env1)
case If(cond, args, thenC, elseC) =>
val cnt = if (evalTestPrim(cond, args map resolve)) thenC else elseC
val cntV = env(cnt).asInstanceOf[CntV]
eval(cntV.body, cntV.env)
case Halt(name) =>
extractInt(resolve(name))
}
}
protected def extractInt(v: Value): Int
protected def wrapFunV(funV: FunV): Value
protected def unwrapFunV(v: Value): FunV
protected def evalLit(l: Literal): Value
protected def evalValuePrim(p: ValuePrimitive, args: Seq[Value]): Value
protected def evalTestPrim(p: TestPrimitive, args: Seq[Value]): Boolean
}
object CPSInterpreterHigh extends CPSInterpreter(SymbolicCPSTreeModule)
with (SymbolicCPSTreeModule.Tree => TerminalPhaseResult) {
import treeModule._
import L3Primitive._
private case class BlockV(tag: L3BlockTag, contents: Array[Value])
extends Value
private case class IntV(value: L3Int) extends Value
private case class CharV(value: L3Char) extends Value
private case class BooleanV(value: Boolean) extends Value
private case object UnitV extends Value
protected def extractInt(v: Value): Int = v match { case IntV(i) => i.toInt }
protected def wrapFunV(funV: FunV): Value =
BlockV(l3.BlockTag.Function.id, Array(funV))
protected def unwrapFunV(v: Value): FunV = v match {
case BlockV(id, Array(funV: FunV)) if id == l3.BlockTag.Function.id => funV
}
protected def evalLit(l: Literal): Value = l match {
case IntLit(i) => IntV(i)
case CharLit(c) => CharV(c)
case BooleanLit(b) => BooleanV(b)
case UnitLit => UnitV
}
protected def evalValuePrim(p: ValuePrimitive, args: Seq[Value]): Value =
(p, args) match {
case (BlockAlloc(t), Seq(IntV(i))) =>
BlockV(t, Array.fill(i.toInt)(UnitV))
case (BlockTag, Seq(BlockV(t, _))) => IntV(L3Int(t))
case (BlockLength, Seq(BlockV(_, c))) => IntV(L3Int(c.length))
case (BlockGet, Seq(BlockV(_, v), IntV(i))) => v(i.toInt)
case (BlockSet, Seq(BlockV(_, v), IntV(i), o)) => v(i.toInt) = o; UnitV
case (IntAdd, Seq(IntV(v1), IntV(v2))) => IntV(v1 + v2)
case (IntSub, Seq(IntV(v1), IntV(v2))) => IntV(v1 - v2)
case (IntMul, Seq(IntV(v1), IntV(v2))) => IntV(v1 * v2)
case (IntDiv, Seq(IntV(v1), IntV(v2))) => IntV(v1 / v2)
case (IntMod, Seq(IntV(v1), IntV(v2))) => IntV(v1 % v2)
case (IntToChar, Seq(IntV(v))) => CharV(v.toInt)
case (IntShiftLeft, Seq(IntV(v1), IntV(v2))) => IntV(v1 << v2)
case (IntShiftRight, Seq(IntV(v1), IntV(v2))) => IntV(v1 >> v2)
case (IntBitwiseAnd, Seq(IntV(v1), IntV(v2))) => IntV(v1 & v2)
case (IntBitwiseOr, Seq(IntV(v1), IntV(v2))) => IntV(v1 | v2)
case (IntBitwiseXOr, Seq(IntV(v1), IntV(v2))) => IntV(v1 ^ v2)
case (ByteRead, Seq()) => IntV(L3Int(readByte()))
case (ByteWrite, Seq(IntV(c))) => writeByte(c.toInt); UnitV
case (CharToInt, Seq(CharV(c))) => IntV(L3Int(c))
case (Id, Seq(v)) => v
}
protected def evalTestPrim(p: TestPrimitive, args: Seq[Value]): Boolean =
(p, args) match {
case (BlockP, Seq(BlockV(_, _))) => true
case (BlockP, Seq(_)) => false
case (IntP, Seq(IntV(_))) => true
case (IntP, Seq(_)) => false
case (IntLt, Seq(IntV(v1), IntV(v2))) => v1 < v2
case (IntLe, Seq(IntV(v1), IntV(v2))) => v1 <= v2
case (CharP, Seq(CharV(_))) => true
case (CharP, Seq(_)) => false
case (BoolP, Seq(BooleanV(_))) => true
case (BoolP, Seq(_)) => false
case (UnitP, Seq(UnitV)) => true
case (UnitP, Seq(_)) => false
case (Eq, Seq(v1, v2)) => v1 == v2
}
}
package l3
/**
* A module for CPS trees.
*
* @author Michel Schinz <Michel.Schinz@epfl.ch>
*/
trait CPSTreeModule {
type Name
type Literal
type ValuePrimitive
type TestPrimitive
sealed trait Atom extends Product {
def asName: Option[Name]
def asLiteral: Option[Literal]
}
case class AtomN(n: Name) extends Atom {
override def asName: Option[Name] = Some(n)
override def asLiteral: Option[Literal] = None
override def toString: String = n.toString
}
case class AtomL(l: Literal) extends Atom {
override def asName: Option[Name] = None
override def asLiteral: Option[Literal] = Some(l)
override def toString: String = l.toString
}
sealed trait Tree
case class LetP(name: Name, prim: ValuePrimitive, args: Seq[Atom], body:Tree)
extends Tree
case class LetC(cnts: Seq[Cnt], body: Tree) extends Tree
case class LetF(funs: Seq[Fun], body: Tree) extends Tree
case class AppC(cnt: Name, args: Seq[Atom]) extends Tree
case class AppF(fun: Atom, retC: Name, args: Seq[Atom]) extends Tree
case class If(cond: TestPrimitive, args: Seq[Atom], thenC: Name, elseC: Name)
extends Tree
case class Halt(arg: Atom) extends Tree
case class Cnt(name: Name, args: Seq[Name], body: Tree)
case class Fun(name: Name, retC: Name, args: Seq[Name], body: Tree)
}
/**
* Module for "high-level" CPS trees: the full L3 literals and
* primitives are available.
*/
object SymbolicCPSTreeModule extends CPSTreeModule {
type Name = Symbol
type Literal = CL3Literal
type ValuePrimitive = L3ValuePrimitive
type TestPrimitive = L3TestPrimitive
}
package l3
/**
* Tree checker for CPS languages. Verifies that:
* 1. names are globally unique (no name is bound more than once),
* 2. names are used in their scope.
*
* @author Michel Schinz <Michel.Schinz@epfl.ch>
*/
abstract class CPSTreeChecker[T <: CPSTreeModule](treeModule: T)
extends (T#Tree => Unit) {
import treeModule._
def apply(t: T#Tree): Unit = {
val allNames = scala.collection.mutable.Set[Name]()
def recordUniqueName(n: Name): Unit = {
if (allNames contains n)
error(s"Name ${n} is bound more than once (not globally unique).")
else
allNames += n
}
def checkName(n: Name, env: Set[Name]): Unit = {
if (! (env contains n))
error(s"Name ${n} is unbound.")
}
def checkAtom(a: Atom, env: Set[Name]): Unit = a match {
case AtomN(n) => checkName(n, env)
case _ =>
}
def checkT(t: T#Tree, cEnv: Set[Name], vEnv: Set[Name]): Unit =
(t: @unchecked) match {
case LetP(name, _, args, body) =>
recordUniqueName(name)
args.foreach(checkAtom(_, vEnv))
checkT(body, cEnv, vEnv + name)
case LetC(cnts, body) =>
val cEnv1 = cEnv ++ (cnts map (_.name))
cnts.foreach(checkC(_, cEnv1, vEnv))
checkT(body, cEnv1, vEnv)
case LetF(funs, body) =>
val vEnv1 = vEnv ++ (funs map (_.name))
funs.foreach(checkF(_, vEnv1))
checkT(body, cEnv, vEnv1)
case AppC(cnt, args) =>
checkName(cnt, cEnv)
args.foreach(checkAtom(_, vEnv))
case AppF(fun, retC, args) =>
checkAtom(fun, vEnv)
checkName(retC, cEnv)
args.foreach(checkAtom(_, vEnv))
case If(_, args, thenC, elseC) =>
args.foreach(checkAtom(_, vEnv))
checkName(thenC, cEnv)
checkName(elseC, cEnv)
case Halt(arg) =>
checkAtom(arg, vEnv)
}
def checkC(cnt: Cnt, cEnv: Set[Name], vEnv: Set[Name]): Unit = {
recordUniqueName(cnt.name)
cnt.args.foreach(recordUniqueName)
checkT(cnt.body, cEnv, vEnv ++ cnt.args)
}
def checkF(fun: Fun, vEnv: Set[Name]): Unit = {
recordUniqueName(fun.name)
recordUniqueName(fun.retC)
fun.args.foreach(recordUniqueName)
checkT(fun.body, Set(fun.retC), vEnv ++ fun.args)
}
checkT(t, Set(), Set())
}
private def error(msg: String): Unit = {
Console.println(s"Error: ${msg}")
}
}
object CPSTreeChecker {
implicit object SymbolicCPSTreeChecker
extends CPSTreeChecker(SymbolicCPSTreeModule)
}
package l3
import org.typelevel.paiges.Doc
class CPSTreeFormatter[T <: CPSTreeModule](treeModule: T)
extends Formatter[T#Tree] {
import Formatter.par, treeModule._
def toDoc(tree: T#Tree): Doc = {
def pullLets(tree: T#Tree): (Seq[(T#Name, Doc)], Doc) = tree match {
case LetP(name, prim, args, body) =>
val (bdgs, bodyDoc) = pullLets(body)
val pDoc = par(1, Doc.text(s"@$prim") +: (args map Doc.str))
((name, pDoc) +: bdgs, bodyDoc)
case LetC(cnts, body) =>
val (bdgs, bodyDoc) = pullLets(body)
def toBdg(c: Cnt): (T#Name, Doc) =
(c.name,
par("cnt", 2, par(1, c.args map Doc.str), toDoc(c.body)))
((cnts map toBdg) ++ bdgs, bodyDoc)
case LetF(funs, body) =>
val (bdgs, bodyDoc) = pullLets(body)
def toBdg(f: Fun): (T#Name, Doc) =
(f.name,
par("fun", 2, par(1, (f.retC +: f.args) map Doc.str), toDoc(f.body)))
((funs map toBdg) ++ bdgs, bodyDoc)
case other =>
(Seq(), toDoc(other))
}
(tree: @unchecked) match {
case LetP(_, _, _, _) | LetC(_, _) | LetF(_, _) =>
val (bdgs, bodyDoc) = pullLets(tree)
val tag = if (bdgs.length > 1) "let*" else "let"
val bdgsDoc = par(1, bdgs map (b => par(1, Doc.str(b._1), b._2)))
par(tag, 2, bdgsDoc, bodyDoc)
case AppF(fun, retC, args) =>
par(1, (fun +: retC +: args) map Doc.str)
case AppC(cont, args) =>
par(1, (cont +: args) map Doc.str)
case If(p, args, thenC, elseC) =>
val pDoc = par(1, Doc.text(s"@$p") +: (args map Doc.str))
par("if", 2, pDoc, Doc.str(thenC), Doc.str(elseC))
case Halt(arg) =>
par("halt", 2, Doc.str(arg))
}
}
}
object CPSTreeFormatter {
implicit object SymbolicCPSTreeFormatter
extends CPSTreeFormatter(SymbolicCPSTreeModule)
}
......@@ -167,7 +167,7 @@ object L3Parser {
.map { case (i, e) => sBegin(e)(i) })
private def cond[_: P] = P(
iPar(kCond ~/ par(expr ~ exprs).rep(1))
iPar(kCond ~/ par(expr ~ exprs1).rep(1))
.map { case (i, a) => sCond(a)(i) })
private def if_[_: P] = P(
iPar(kIf ~ expr ~ expr ~ expr.?)
......@@ -207,53 +207,31 @@ object L3Parser {
private def sFun(args: Seq[String], body: Tree)
(implicit p: Position): Tree = {
val name = freshName("anonFun")
val fn = Fun(name, args, body)
LetRec(Seq(fn), Ident(name))
}
private def sLet_*(bdgs: Seq[(String,Tree)], body: Tree)
(implicit p: Position): Tree = {
bdgs.foldRight(body)((l, r) => {
Let(Seq(l), r)
})
}
private def sBegin(exprs: Seq[Tree])(implicit p: Position): Tree = {
exprs.reduceRight((l,r) => {
val anonName = freshName("t")
Let(Seq((anonName, l)), r)
})
val fName = freshName("fun")
LetRec(Seq(Fun(fName, args, body)), Ident(fName))
}
private def sLet_*(bdgs: Seq[(String,Tree)], body: Tree)
(implicit p: Position): Tree =
bdgs.foldRight(body)((b, t) => Let(Seq(b), t))
private def sBegin(exprs: Seq[Tree])(implicit p: Position): Tree =
exprs reduceRight { (e1, e2) => Let(Seq((freshName("begin"), e1)), e2) }
private def sRec(name: String, bdgs: Seq[(String, Tree)], body: Tree)
(implicit p: Position) = {
val (varNames, expressions) = bdgs.unzip
LetRec(
Seq(Fun(name, varNames, body)),
App(Ident(name), expressions)
)
}
(implicit p: Position) =
LetRec(Seq(Fun(name, bdgs map { _._1 }, body)),
App(Ident(name), bdgs map { _._2 }))
private def sAnd(es: Seq[Tree])(implicit p: Position): Tree =
es.reduceRight((l,r) => If(l, r, Lit(BooleanLit(false))))
private def sOr(es: Seq[Tree])(implicit p: Position): Tree =
es.reduceRight((l, r) => {
val v = freshName("v")
Let(Seq((v, l)), If(Ident(v), Ident(v), r))
})
private def sNot(e: Tree)(implicit p: Position): Tree =
If(
e,
Lit(BooleanLit(false)),
Lit(BooleanLit(true))
)
private def sCond(clses: Seq[(Tree, Seq[Tree])])(implicit p: Position): Tree = {
val s: Tree = Lit(UnitLit)
clses.foldRight(s)((l, r) => {
If(
l._1,
sBegin(l._2),
r
)
})
es reduceRight { If(_, _, Lit(BooleanLit(false))) }
private def sOr(es: Seq[Tree])(implicit p: Position): Tree = {
es reduceRight { (e, r) =>
val en = freshName("or")
Let(Seq((en, e)), If(Ident(en), Ident(en), r))
}
}
private def sNot(e: Tree)(implicit p: Position): Tree =
If(e, Lit(BooleanLit(false)), Lit(BooleanLit(true)))
private def sCond(clses: Seq[(Tree, Seq[Tree])])(implicit p: Position): Tree =
clses.foldRight(Lit(UnitLit) : Tree){ case ((c, t), e) =>
If(c, sBegin(t), e) }
private def sStringLit(s: String)(implicit p: Position): Tree = {
val b = freshName("string")
val cs = codePoints(s)
......
......@@ -5,10 +5,17 @@ import java.nio.file.{ Files, Paths }
import l3.SymbolicCL3TreeModule.Tree
import CL3TreeFormatter._ // Implicits required for CL3 tree printing
import CPSTreeFormatter._ // Implicits required for CPS tree printing
import CPSTreeChecker._ // Implicits required for CPS tree checking
object Main {
def main(args: Array[String]): Unit = {
val backEnd: Tree => TerminalPhaseResult = (
CL3Interpreter
CL3ToCPSTranslator
andThen treePrinter("---------- After translation to CPS")
andThen treeChecker
andThen CPSInterpreterHigh
)
val basePath = Paths.get(".").toAbsolutePath
......@@ -29,6 +36,9 @@ object Main {
private lazy val outPrintWriter =
new PrintWriter(System.out, true)
private def treeChecker[T <: CPSTreeModule](implicit c: CPSTreeChecker[T]) =
passThrough(c)
private def treePrinter[T](msg: String)(implicit f: Formatter[T]): T => T =
passThrough { tree =>
outPrintWriter.println(msg)
......
......@@ -49,3 +49,7 @@ trait ExamplesTests {
object ExamplesTests1 extends TestSuite with ExamplesTests {
val backEnd = L3Tester.backEnd1
}
object ExamplesTests2 extends TestSuite with ExamplesTests {
val backEnd = L3Tester.backEnd2
}
......@@ -44,4 +44,9 @@ object L3Tester {
val backEnd1 = (
CL3Interpreter
)
val backEnd2 = (
CL3ToCPSTranslator
andThen CPSInterpreterHigh
)
}
......@@ -85,3 +85,7 @@ trait SyntheticTests {
object SyntheticTests1 extends TestSuite with SyntheticTests {
val backEnd = L3Tester.backEnd1
}
object SyntheticTests2 extends TestSuite with SyntheticTests {
val backEnd = L3Tester.backEnd2
}
......@@ -148,10 +148,10 @@
(defrec int-print
(fun (i)
(cond
((< i 0) (char-print '-') (int-print (- i)))
((< i 10) (char-print (int->char-digit i)))
(#t (let ((digit (%t i 10))) (int-print (/t i 10)) (char-print (int->char-digit digit))))
(cond
((< i 0) (char-print '-') (int-print (- i)))
((< i 10) (char-print (int->char-digit i)))
(#t (let ((digit (%t i 10))) (int-print (/t i 10)) (char-print (int->char-digit digit))))
)
)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment