Init

cs420-acc/l3-warmup/compiler/src/l3/BlockTag.scala

@@ -0,0 +1,11 @@
+package l3
+
+/**
+  * Predefined tags for blocks.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+object BlockTag extends Enumeration(200) {
+  val String, RegisterFrame, Function = Value
+}

cs420-acc/l3-warmup/compiler/src/l3/CL3Interpreter.scala

@@ -0,0 +1,161 @@
+package l3
+
+import scala.collection.mutable.{ Map => MutableMap }
+import SymbolicCL3TreeModule._
+import IO._
+import l3.L3Primitive._
+
+/**
+  * A tree-based interpreter for the CL₃ language.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+object CL3Interpreter extends (Tree => TerminalPhaseResult) {
+  def apply(program: Tree): TerminalPhaseResult =
+    try {
+      eval(program)(Map.empty)
+      Right(0, None)
+    } catch {
+      case e: EvalHlt =>
+        Right((e.retCode, None))
+      case e: EvalErr =>
+        val Seq(m1, ms @ _*) = e.messages
+        Left((m1 +: ms.reverse).mkString("\n"))
+    }
+
+  // Values
+  private sealed trait Value {
+    override def toString(): String = this match {
+      case BlockV(t, c) => s"<$t>[${c mkString ","}]"
+      case IntV(i) => i.toString
+      case CharV(c) => s"'${new String(Array(c), 0, 1)}'"
+      case BoolV(b) => if (b) "#t" else "#f"
+      case UnitV => "#u"
+      case FunctionV(_, _, _) => "<function>"
+    }
+  }
+  private case class BlockV(tag: L3BlockTag, contents: Array[Value])
+      extends Value
+  private case class IntV(i: L3Int) extends Value
+  private case class CharV(c: L3Char) extends Value
+  private case class BoolV(b: Boolean) extends Value
+  private case object UnitV extends Value
+
+  private case class FunctionV(args: Seq[Symbol], body: Tree, env: Env)
+               extends Value
+
+  // Environment
+  private type Env = PartialFunction[Symbol, Value]
+
+  // Error/halt handling (termination)
+  private class EvalErr(val messages: Seq[String]) extends Exception()
+  private class EvalHlt(val retCode: Int) extends Exception()
+
+  private def error(pos: Position, msg: String): Nothing =
+    throw new EvalErr(Seq(msg, s"  at $pos"))
+  private def halt(r: Int): Nothing =
+    throw new EvalHlt(r)
+
+  private def validIndex(a: Array[Value], i: L3Int): Boolean =
+    0 <= i.toInt && i.toInt < a.length
+
+  private final def eval(tree: Tree)(implicit env: Env): Value = tree match {
+    case Let(bdgs, body) =>
+      eval(body)(Map(bdgs map { case (n, e) => n -> eval(e) } : _*) orElse env)
+
+    case LetRec(funs, body) =>
+      val recEnv = MutableMap[Symbol, Value]()
+      val env1 = recEnv orElse env
+      for (Fun(name, args, body) <- funs)
+        recEnv(name) = BlockV(l3.BlockTag.Function.id,
+                              Array(FunctionV(args, body, env1)))
+      eval(body)(env1)
+
+    case If(cond, thenE, elseE) =>
+      eval(cond) match {
+        case BoolV(false) => eval(elseE)
+        case _ => eval(thenE)
+      }
+
+    case App(fun, args) =>
+      eval(fun) match {
+        case BlockV(_, Array(FunctionV(cArgs, cBody, cEnv))) =>
+          if (args.length != cArgs.length)
+            error(tree.pos,
+                  s"expected ${cArgs.length} arguments, got ${args.length}")
+          try {
+            eval(cBody)(Map(cArgs zip (args map eval) : _*) orElse cEnv)
+          } catch {
+            case e: EvalErr =>
+              throw new EvalErr(e.messages :+ s"  at ${fun.pos}")
+          }
+        case _ => error(fun.pos, "function value expected")
+      }
+
+    case Prim(p, args) => (p, args map eval) match {
+      case (BlockAlloc(t), Seq(IntV(i))) =>
+        BlockV(t, Array.fill(i.toInt)(UnitV))
+      case (BlockP, Seq(BlockV(_, _))) => BoolV(true)
+      case (BlockP, Seq(_)) => BoolV(false)
+      case (BlockTag, Seq(BlockV(t, _))) => IntV(L3Int(t))
+      case (BlockLength, Seq(BlockV(_, c))) => IntV(L3Int(c.length))
+      case (BlockGet, Seq(BlockV(_, v), IntV(i))) if (validIndex(v, i)) =>
+        v(i.toInt)
+      case (BlockSet, Seq(BlockV(_, v), IntV(i), o)) if (validIndex(v, i)) =>
+        v(i.toInt) = o; UnitV
+
+      case (IntP, Seq(IntV(_))) => BoolV(true)
+      case (IntP, Seq(_)) => BoolV(false)
+
+      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 (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 (IntLt, Seq(IntV(v1), IntV(v2))) => BoolV(v1 < v2)
+      case (IntLe, Seq(IntV(v1), IntV(v2))) => BoolV(v1 <= v2)
+      case (Eq, Seq(v1, v2)) => BoolV(v1 == v2)
+
+      case (IntToChar, Seq(IntV(i))) if Character.isValidCodePoint(i.toInt) =>
+        CharV(i.toInt)
+
+      case (CharP, Seq(CharV(_))) => BoolV(true)
+      case (CharP, Seq(_)) => BoolV(false)
+
+      case (ByteRead, Seq()) => IntV(L3Int(readByte()))
+      case (ByteWrite, Seq(IntV(c))) => writeByte(c.toInt); UnitV
+
+      case (CharToInt, Seq(CharV(c))) => IntV(L3Int(c))
+
+      case (BoolP, Seq(BoolV(_))) => BoolV(true)
+      case (BoolP, Seq(_)) => BoolV(false)
+
+      case (UnitP, Seq(UnitV)) => BoolV(true)
+      case (UnitP, Seq(_)) => BoolV(false)
+
+      case (p, vs) =>
+        error(tree.pos,
+              s"""cannot apply primitive $p to values ${vs.mkString(", ")}""")
+    }
+
+    case Halt(arg) => eval(arg) match {
+      case IntV(c) => halt(c.toInt)
+      case c => error(tree.pos, s"halt with code $c")
+    }
+
+    case Ident(n) => env(n)
+
+    case Lit(IntLit(i)) => IntV(i)
+    case Lit(CharLit(c)) => CharV(c)
+    case Lit(BooleanLit(b)) => BoolV(b)
+    case Lit(UnitLit) => UnitV
+  }
+}

cs420-acc/l3-warmup/compiler/src/l3/CL3Literal.scala

@@ -0,0 +1,21 @@
+package l3
+
+/**
+  * Literal values for the CL₃ language.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+sealed trait CL3Literal {
+  override def toString: String = this match {
+    case IntLit(i) => i.toString
+    case CharLit(c) => "'"+ (new String(Character.toChars(c))) +"'"
+    case BooleanLit(v) => if (v) "#t" else "#f"
+    case UnitLit => "#u"
+  }
+}
+
+case class IntLit(value: L3Int) extends CL3Literal
+case class CharLit(value: L3Char) extends CL3Literal
+case class BooleanLit(value: Boolean) extends CL3Literal
+case object UnitLit extends CL3Literal

cs420-acc/l3-warmup/compiler/src/l3/CL3NameAnalyzer.scala

@@ -0,0 +1,83 @@
+package l3
+
+import l3.{ NominalCL3TreeModule => N }
+import l3.{ SymbolicCL3TreeModule => S }
+
+/**
+  * Name analysis for the CL₃ language. Translates a tree in which
+  * identifiers are simple strings into one in which identifiers are
+  * symbols (i.e. globally-unique names).
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+object CL3NameAnalyzer extends (N.Tree => Either[String, S.Tree]) {
+  def apply(tree: N.Tree): Either[String, S.Tree] =
+    try {
+      Right(rewrite(tree)(Map.empty))
+    } catch {
+      case NameAnalysisError(msg) =>
+        Left(msg)
+    }
+
+  private type Env = Map[String, Symbol]
+
+  private final case class NameAnalysisError(msg: String) extends Exception(msg)
+  private def error(msg: String)(implicit pos: Position): Nothing =
+    throw new NameAnalysisError(s"$pos: $msg")
+
+  private def rewrite(tree: N.Tree)(implicit env: Env): S.Tree = {
+    implicit val pos = tree.pos
+    tree match {
+      case N.Let(bdgs, body) =>
+        val syms = checkUnique(bdgs map (_._1)) map Symbol.fresh
+        S.Let(syms zip (bdgs map { b => rewrite(b._2) }),
+              rewrite(body)(augmented(env, syms)))
+      case N.LetRec(funs, body) =>
+        val syms = checkUnique(funs map (_.name)) map Symbol.fresh
+        val env1 = augmented(env, syms)
+        S.LetRec((syms zip funs) map {case (s,f) => rewriteF(s, f , env1)},
+                 rewrite(body)(env1))
+      case N.If(cond, thenE, elseE) =>
+        S.If(rewrite(cond), rewrite(thenE), rewrite(elseE))
+      case N.App(N.Ident(fun), args) if env contains altName(fun, args.length)=>
+        S.App(S.Ident(env(altName(fun, args.length))), args map rewrite)
+      case N.App(fun, args) =>
+        S.App(rewrite(fun), args map rewrite)
+      case N.Prim(p, args) if L3Primitive.isDefinedAt(p, args.length) =>
+        S.Prim(L3Primitive(p), args map rewrite)
+      case N.Halt(arg) =>
+        S.Halt(rewrite(arg))
+      case N.Ident(name) if env contains name =>
+        S.Ident(env(name))
+      case N.Lit(value) =>
+        S.Lit(value)
+
+      case N.Prim(p, _) if L3Primitive isDefinedAt p =>
+        error(s"incorrect number of arguments for @$p")
+      case N.Prim(p, _) =>
+        error(s"unknown primitive $p")
+      case N.Ident(name) =>
+        error(s"unknown identifier $name")
+    }
+  }
+
+  private def rewriteF(funSym: Symbol, fun: N.Fun, env: Env): S.Fun = {
+    implicit val pos = fun.pos
+    val argsSyms = checkUnique(fun.args) map Symbol.fresh
+    S.Fun(funSym, argsSyms, rewrite(fun.body)(augmented(env, argsSyms)))
+  }
+
+  private def checkUnique(names: Seq[String])
+                         (implicit pos: Position): Seq[String] = {
+    for (n <- names diff names.distinct)
+      error(s"repeated definition of $n")
+    names
+  }
+
+  private def altName(name: String, arity: Int): String =
+    s"$name@$arity"
+
+  private def augmented(env: Env, symbols: Seq[Symbol]): Env =
+    env ++ (symbols map { s => (s.name, s) })
+}

cs420-acc/l3-warmup/compiler/src/l3/CL3Tree.scala

@@ -0,0 +1,51 @@
+package l3
+
+/**
+  * A module for CL₃ trees.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+trait CL3TreeModule {
+  type Name
+  type Primitive
+
+  sealed abstract class Tree(val pos: Position)
+  case class Let(bindings: Seq[(Name, Tree)], body: Tree)
+                (implicit pos: Position) extends Tree(pos)
+  case class LetRec(functions: Seq[Fun], body: Tree)
+                   (implicit pos: Position) extends Tree(pos)
+  case class If(cond: Tree, thenE: Tree, elseE: Tree)
+               (implicit pos: Position) extends Tree(pos)
+  case class App(fun: Tree, args: Seq[Tree])
+                (implicit pos: Position) extends Tree(pos)
+  case class Prim(prim: Primitive, args: Seq[Tree])
+                 (implicit pos: Position) extends Tree(pos)
+  case class Halt(arg: Tree)
+                 (implicit pos: Position) extends Tree(pos)
+  case class Ident(name: Name)
+                  (implicit pos: Position) extends Tree(pos)
+  case class Lit(value: CL3Literal)
+                (implicit pos: Position) extends Tree(pos)
+
+  case class Fun(name: Name, args: Seq[Name], body: Tree)
+                (implicit val pos: Position)
+}
+
+/**
+  * Module for trees after parsing: names and primitives are
+  * represented as strings.
+  */
+object NominalCL3TreeModule extends CL3TreeModule {
+  type Name = String
+  type Primitive = String
+}
+
+/**
+  * Module for trees after name analysis: names are represented as
+  * symbols (globally-unique names) and primitives as objects.
+  */
+object SymbolicCL3TreeModule extends CL3TreeModule {
+  type Name = Symbol
+  type Primitive = L3Primitive
+}

cs420-acc/l3-warmup/compiler/src/l3/CL3TreeFormatter.scala

@@ -0,0 +1,40 @@
+package l3
+
+import org.typelevel.paiges.Doc
+
+class CL3TreeFormatter[T <: CL3TreeModule](treeModule: T)
+    extends Formatter[T#Tree] {
+  import Formatter.par, treeModule._
+
+  def toDoc(tree: T#Tree): Doc = (tree: @unchecked) match {
+    case Let(bdgs, body) =>
+      val bdgsDoc =
+        par(1, bdgs map { case (n, v) => par(1, Doc.str(n), toDoc(v)) })
+      par("let", 2, bdgsDoc, toDoc(body))
+    case LetRec(funs, body) =>
+      def funToDoc(fun: T#Fun): Doc =
+        (Doc.str(fun.name)
+           / par("fun", 2, par(1, fun.args map Doc.str), toDoc(fun.body)))
+      val funsDoc = par(1, funs map { f => par(1, funToDoc(f)) })
+      par("letrec", 2, funsDoc, toDoc(body))
+    case If(c, t, e) =>
+      par("if", 2, toDoc(c), toDoc(t), toDoc(e))
+    case App(fun, args) =>
+      par(1, (fun +: args) map toDoc)
+    case Halt(arg) =>
+      par("halt", 2, toDoc(arg))
+    case Prim(prim, args) =>
+      par(1, Doc.text(s"@$prim") +: (args map toDoc))
+    case Ident(name) =>
+      Doc.str(name)
+    case Lit(l) =>
+      Doc.str(l)
+  }
+}
+
+object CL3TreeFormatter {
+  implicit object NominalCL3TreeFormatter
+      extends CL3TreeFormatter(NominalCL3TreeModule)
+  implicit object SymbolicCL3TreeFormatter
+      extends CL3TreeFormatter(SymbolicCL3TreeModule)
+}

cs420-acc/l3-warmup/compiler/src/l3/Formatter.scala

@@ -0,0 +1,24 @@
+package l3
+
+import org.typelevel.paiges.Doc
+
+/**
+  * Utility methods for formatting.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+trait Formatter[-T] {
+  def toDoc(value: T): Doc
+}
+
+object Formatter {
+  def par(nest: Int, ds: Iterable[Doc]): Doc =
+    (Doc.char('(') + Doc.intercalate(Doc.line, ds).nested(nest) + Doc.char(')'))
+      .grouped
+  def par(nest: Int, d1: Doc): Doc = par(nest, Seq(d1))
+  def par(nest: Int, d1: Doc, d2: Doc): Doc = par(nest, Seq(d1, d2))
+
+  def par(tag: String, nest: Int, d1: Doc, ds: Doc*): Doc =
+    par(nest, (Doc.text(tag) space d1.aligned) +: ds)
+}

cs420-acc/l3-warmup/compiler/src/l3/IO.scala

@@ -0,0 +1,17 @@
+package l3
+
+/**
+  * Helper module for IO functions in L₃ and intermediate languages.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+object IO {
+  def readByte(): Int =
+    System.in.read()
+
+  def writeByte(c: Int): Unit = {
+    System.out.write(c)
+    System.out.flush()
+  }
+}

cs420-acc/l3-warmup/compiler/src/l3/L3FileReader.scala

@@ -0,0 +1,83 @@
+package l3
+
+import java.io.IOException
+import java.nio.file.Path
+import java.nio.file.Files.newBufferedReader
+
+import scala.util.Using.{resource => using}
+import scala.collection.mutable.ArrayBuffer
+
+/**
+  * File reading for L₃ (both modules and source files).
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+object L3FileReader {
+  def readFilesExpandingModules(base: Path, pathNames: Seq[String])
+      : Either[String, (String, Int => Position)] =
+    try {
+      Right(readFiles(base, expandModules(base, pathNames)))
+    } catch {
+      case e: IOException => Left(e.getMessage)
+    }
+
+  private def expandModules(base: Path, pathNames: Seq[String]): Seq[Path] = {
+    def readModule(modulePath: Path): Seq[String] = {
+      using(newBufferedReader(modulePath)) { moduleReader =>
+        Iterator.continually(moduleReader.readLine)
+          .takeWhile (_ != null)
+          .map (_.trim)
+          .filterNot { s => (s startsWith ";") || s.isEmpty }
+          .toList
+      }
+    }
+
+    def expand(base: Path, pathNames: Seq[String]): Seq[Path] = {
+      val basePath = base.toAbsolutePath.normalize
+      pathNames flatMap { pn =>
+        val p = basePath.resolve(pn).normalize
+        if (p.getFileName.toString endsWith ".l3m")
+          expandModules(p.getParent, readModule(p))
+        else
+          Seq(p)
+      }
+    }
+    expand(base, pathNames).distinct
+  }
+
+  private def readFiles(basePath: Path,
+                        paths: Seq[Path]): (String, Int=>Position) = {
+    def indexToPosition(indices: Array[Int],
+                        fileLines: Int => Option[(String, Int)])
+                       (index: Int): Position = {
+      val p = {
+        val p0 = java.util.Arrays.binarySearch(indices, index)
+        // FIXME: use code-points count to get column number, not char count!
+        if (p0 < 0) (-p0 - 2) else p0
+      }
+      fileLines(p)
+        .map { case (f, l) => new FilePosition(f, l, index - indices(p)) }
+        .getOrElse(UnknownPosition)
+    }
+
+    val progB = new StringBuilder()
+    val indicesB = ArrayBuffer.empty[Int]
+    val fileLinesB = ArrayBuffer.empty[(String, Int)]
+    for (path <- paths) {
+      val relPath = basePath relativize path
+      using(newBufferedReader(path)) { fileReader =>
+        Iterator.continually(fileReader.readLine)
+          .takeWhile(_ != null)
+          .zipWithIndex
+          .foreach { case (line, lineIndex) =>
+            val index = progB.size
+            progB ++= line; progB += '\n'
+            indicesB += index
+            fileLinesB += ((relPath.toString, lineIndex + 1))
+        }
+      }
+    }
+    (progB.result(), indexToPosition(indicesB.toArray, fileLinesB.toArray.lift))
+  }
+}

cs420-acc/l3-warmup/compiler/src/l3/L3Int.scala

@@ -0,0 +1,47 @@
+package l3
+
+final class L3Int private(private val v: Int) extends AnyVal {
+  def toInt: Int = v
+
+  def +(that: L3Int): L3Int = L3Int.ofIntClipped(this.v + that.v)
+  def -(that: L3Int): L3Int = L3Int.ofIntClipped(this.v - that.v)
+  def *(that: L3Int): L3Int = L3Int.ofIntClipped(this.v * that.v)
+  def /(that: L3Int): L3Int = L3Int.ofIntClipped(this.v / that.v)
+  def %(that: L3Int): L3Int = L3Int.ofIntClipped(this.v % that.v)
+  def &(that: L3Int): L3Int = L3Int.ofIntClipped(this.v & that.v)
+  def |(that: L3Int): L3Int = L3Int.ofIntClipped(this.v | that.v)
+  def ^(that: L3Int): L3Int = L3Int.ofIntClipped(this.v ^ that.v)
+  def <<(that: L3Int): L3Int = L3Int.ofIntClipped(this.v << that.v)
+  def >>(that: L3Int): L3Int = L3Int.ofIntClipped(this.v >> that.v)
+
+  def <(that: L3Int): Boolean = this.v < that.v
+  def <=(that: L3Int): Boolean = this.v <= that.v
+  def >(that: L3Int): Boolean = this.v > that.v
+  def >=(that: L3Int): Boolean = this.v >= that.v
+
+  override def toString: String = v.toString
+}
+
+object L3Int {
+  private def ofIntClipped(v: Int): L3Int =
+    L3Int((v << 1) >> 1)
+
+  def canConvertFromInt(i: Int): Boolean =
+    fitsInNSignedBits(L3_INT_BITS)(i)
+
+  def canConvertFromIntUnsigned(i: Int): Boolean =
+    fitsInNUnsignedBits(L3_INT_BITS)(i)
+
+  def ofIntUnsigned(v: Int): L3Int = {
+    require(canConvertFromIntUnsigned(v))
+    new L3Int((v << 1) >> 1)
+  }
+
+  def apply(v: Int): L3Int = {
+    require(canConvertFromInt(v))
+    new L3Int(v)
+  }
+
+  def unapply(v: L3Int): Option[Int] =
+    Some(v.toInt)
+}

cs420-acc/l3-warmup/compiler/src/l3/L3Parser.scala

@@ -0,0 +1,253 @@
+package l3
+
+import fastparse._
+import NominalCL3TreeModule._
+
+/**
+  * Parsing (including lexical analysis) for the L₃ language.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+object L3Parser {
+  def parse(programText: String,
+            indexToPosition: Int => Position): Either[String, Tree] = {
+    val parser = new S(indexToPosition)
+    fastparse.parse(programText, parser.program(_)) match {
+      case Parsed.Success(program, _) =>
+        Right(program)
+      case Parsed.Failure(lp, index, _) =>
+        Left(s"${indexToPosition(index)}: parse error (expected: $lp)")
+    }
+  }
+
+  // Lexical analysis (for which whitespace is significant)
+  private class L(indexToPosition: Int => Position) {
+    import NoWhitespace._
+    private implicit val indexToPositionView = indexToPosition
+
+    // Literals
+    private def sign[_: P] = P(CharIn("+\\-"))
+    private def prefix2[_: P] = IgnoreCase("#b")
+    private def prefix16[_: P] = IgnoreCase("#x")
+    private def digit2[_: P] = CharIn("0-1")
+    private def digit10[_: P] = CharIn("0-9")
+    private def digit16[_: P] = CharIn("0-9a-fA-F")
+    private def unicodeChar[_: P] = P(
+      CharPred(!Character.isHighSurrogate(_))
+        | (CharPred(Character.isHighSurrogate)
+             ~ CharPred(Character.isLowSurrogate)))
+
+    private def integer2[_: P] = P(
+      (prefix2 ~/ digit2.rep(1).!)
+        .map { Integer.parseInt(_, 2) }
+        .filter { L3Int.canConvertFromIntUnsigned(_) }
+        .map { L3Int.ofIntUnsigned(_) })
+    private def integer16[_: P] = P(
+      (prefix16 ~/ digit16.rep(1).!)
+        .map { Integer.parseInt(_, 16) }
+        .filter { L3Int.canConvertFromIntUnsigned(_) }
+        .map { L3Int.ofIntUnsigned(_) })
+    private def integer10[_: P] = P(
+      (sign.? ~ digit10 ~/ digit10.rep).!
+        .map { Integer.parseInt(_, 10) }
+        .filter { L3Int.canConvertFromInt(_) })
+      .map { L3Int(_) }
+    private def integer[_: P] = P(
+      (Index ~ (integer2 | integer10 | integer16))
+        .map { case (i, v) => Lit(IntLit(v))(i) })
+    private def string[_: P] = P(
+      (Index ~ "\"" ~/ CharPred(c => c != '\n' && c != '"').rep.! ~ "\"")
+        .map { case (i, s) => sStringLit(s)(i) })
+    private def char[_: P] = P(
+      (Index ~ "'" ~/ unicodeChar.! ~ "'")
+        .map { case (i, c) => Lit(CharLit(c.codePointAt(0)))(i) })
+    private def bool[_: P] = P(
+      (Index ~ StringIn("#t", "#f").!)
+        .map { case (i, v) => Lit(BooleanLit(v == "#t"))(i) })
+    private def unit[_: P] = P(
+      (Index ~ "#u")
+        .map { case i => Lit(UnitLit)(i) })
+
+    def literal[_: P] = P(integer | string | char | bool | unit)
+
+    // Identifiers
+    private def identStart[_: P] = P(CharIn("|!%&*+\\-./:<=>?^_~a-zA-Z"))
+    private def identCont[_: P] = P(identStart | digit10)
+    private def identSuffix[_: P] = P("@" ~ digit10.rep(1))
+
+    def identStr[_: P] = P(
+      (identStart ~/ identCont.rep ~/ identSuffix.?).!)
+    def identifier[_: P] = P(
+      (Index ~ identStr).map { case (i, n) => Ident(n)(i) })
+
+    // Keywords
+    def kDef[_: P] = P("def" ~ !identCont)
+    def kDefrec[_: P] = P("defrec" ~ !identCont)
+    def kFun[_: P] = P("fun" ~ !identCont)
+    def kLet[_: P] = P("let" ~ !identCont)
+    def kLet_*[_: P] = P("let*" ~ !identCont)
+    def kLetrec[_: P] = P("letrec" ~ !identCont)
+    def kRec[_: P] = P("rec" ~ !identCont)
+    def kBegin[_: P] = P("begin" ~ !identCont)
+    def kCond[_: P] = P("cond" ~ !identCont)
+    def kIf[_: P] = P("if" ~ !identCont)
+    def kAnd[_: P] = P("and" ~ !identCont)
+    def kOr[_: P] = P("or" ~ !identCont)
+    def kNot[_: P] = P("not" ~ !identCont)
+    def kHalt[_: P] = P("halt" ~ !identCont)
+    def kPrim[_: P] = P("@")
+  }
+
+  // Syntactic analysis (for which whitespace and comments are ignored)
+  private class S(indexToPosition: Int => Position) {
+    val lexer = new L(indexToPosition)
+    import lexer._
+
+    private implicit val whitespace = { implicit ctx: ParsingRun[_] =>
+      import NoWhitespace._
+      (CharIn(" \t\n\r")
+         | (";" ~ CharPred(c => c != '\n' && c != '\r').rep)).rep
+    }
+    private implicit val indexToPositionView = indexToPosition
+
+    def program[_: P]: P[Tree] =
+      P("" ~ topExpr ~ End) // The initial "" allows leading whitespace
+
+    private def topExpr[_: P]: P[Tree] = P(defP | defrecP | exprP)
+
+    private def defP[_: P] = P(
+      (iPar(kDef ~ identStr ~ expr) ~ topExpr)
+        .map { case (i, (n, v), p) => Let(Seq((n, v)), p)(i) })
+    private def defrecP[_: P] = P(
+      (iPar(kDefrec ~ identStr ~ anonFun) ~ topExpr)
+        .map { case (i, (n, (a, b)), p) =>
+          LetRec(Seq(Fun(n, a, b)(i)), p)(i) })
+    private def exprP[_: P] = P(
+      (ix(expr ~ topExpr.?))
+        .map { case (i, (e, p)) => sBegin(e +: p.toSeq)(i) })
+
+    private def expr[_: P]: P[Tree] = P(
+      fun | let | let_* | letrec | rec | begin | cond | if_ | and | or | not
+        | halt | app | prim | literal | identifier)
+    private def exprs[_: P] = expr.rep
+    private def iExprs[_: P] = ix(exprs)
+    private def exprs1[_: P] = expr.rep(1)
+    private def iExprs1[_: P] = ix(exprs1)
+
+    private def anonFun[_: P] = P(
+      par("fun" ~ par(identStr.rep) ~ iExprs1)
+        .map { case (a, (i, e)) => (a, sBegin(e)(i)) })
+    private def funDef[_: P] = P(
+      iPar(identStr ~ anonFun)
+        .map { case (i, (n, (a, e))) => Fun(n, a, e)(i) })
+    private def binding[_: P] = P(
+      par(identStr ~ expr)
+        .map { case (i, e) => (i, e) })
+    private def bindings[_: P] = P(
+      par(binding.rep))
+
+    private def fun[_: P] = P(
+      ix(anonFun)
+        .map { case (i, (a, e)) => sFun(a, e)(i) })
+    private def let[_: P] = P(
+      iPar(kLet ~/ bindings ~ iExprs1)
+        .map { case (i1, (b, (i2, e))) => Let(b, sBegin(e)(i2))(i1) })
+    private def let_*[_: P] = P(
+      iPar(kLet_* ~/ bindings ~ iExprs1)
+        .map { case (i1, (b, (i2, e))) => sLet_*(b, sBegin(e)(i2))(i1) })
+    private def letrec[_: P]= P(
+      iPar(kLetrec ~/ par(funDef.rep) ~ iExprs1)
+        .map { case (i1, (f, (i2, e))) => LetRec(f, sBegin(e)(i2))(i1) })
+    private def rec[_: P] = P(
+      iPar(kRec ~/ identStr ~ bindings ~ iExprs1)
+        .map { case (i1, (n, b, (i2, e))) => sRec(n, b, sBegin(e)(i2))(i1) })
+    private def begin[_: P] = P(
+      iPar(kBegin ~/ exprs1)
+        .map { case (i, e) => sBegin(e)(i) })
+
+    private def cond[_: P] = P(
+      iPar(kCond ~/ par(expr ~ exprs).rep(1))
+        .map { case (i, a) => sCond(a)(i) })
+    private def if_[_: P] = P(
+      iPar(kIf ~ expr ~ expr ~ expr.?)
+        .map { case (i, (c, t, f)) =>
+          If(c, t, f.getOrElse(Lit(UnitLit)(i)))(i) })
+    private def and[_: P] = P(
+      iPar(kAnd ~/ expr.rep(2))
+        .map { case (i, es) => sAnd(es)(i) })
+    private def or[_: P] = P(
+      iPar(kOr ~/ expr.rep(2))
+        .map { case (i, es) => sOr(es)(i) })
+    private def not[_: P] = P(
+      iPar(kNot ~/ expr)
+        .map { case (i, e) => sNot(e)(i) })
+
+    private def app[_: P] = P(
+      iPar(expr ~ exprs)
+        .map { case (i, (e, es)) => App(e, es)(i) })
+    private def prim[_: P] = P(
+      iPar(kPrim ~/ identStr ~ exprs)
+        .map { case (i, (p, es)) => Prim(p, es)(i) })
+    private def halt[_: P] = P(
+      iPar(kHalt ~/ expr)
+        .map { case (i, e) => Halt(e)(i) })
+
+    private def par[T, _: P](b: =>P[T]): P[T] = P("(" ~ b ~ ")")
+    private def ix[T, _: P](b: =>P[T]): P[(Int, T)] = Index ~ b
+    private def iPar[T, _: P](b: =>P[T]): P[(Int, T)] = ix(par(b))
+  }
+
+  // Syntactic sugar translation.
+  private var freshCounter = 0
+  private def freshName(prefix: String): String = {
+    freshCounter += 1
+    prefix + "$" + freshCounter
+  }
+
+  private def sFun(args: Seq[String], body: Tree)
+                  (implicit p: Position): Tree = {
+    val fn = freshName("sfun")
+    LetRec(Seq(Fun(fn, args, body)), Ident(fn))
+  }
+
+  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("sbegin"), e1)),e2))
+  private def sRec(name: String, bdgs: Seq[(String, Tree)], body: Tree)(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(If(_,_,Lit(BooleanLit(false))))
+  private def sOr(es: Seq[Tree])(implicit p: Position): Tree =
+    es.reduceRight((e, r) =>{
+      val fn = freshName("sor")
+      Let(Seq((fn, e)), If(Ident(fn), Ident(fn), 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)
+    Let(Seq((b, Prim("block-alloc-"+ BlockTag.String.id,
+                     Seq(Lit(IntLit(L3Int(cs.length))))))),
+        sBegin((cs.zipWithIndex map {case (c, i) =>
+                  Prim("block-set!",
+                       Seq(Ident(b), Lit(IntLit(L3Int(i))), Lit(CharLit(c)))) })
+                 :+ Ident(b)))
+  }
+
+  private def codePoints(chars: Seq[Char]): Seq[L3Char] = chars match {
+    case Seq(h, l, r @ _*) if (Character.isSurrogatePair(h, l)) =>
+      Character.toCodePoint(h, l) +: codePoints(r)
+    case Seq(c, r @ _*) =>
+      c.toInt +: codePoints(r)
+    case Seq() =>
+      Seq()
+  }
+}

cs420-acc/l3-warmup/compiler/src/l3/L3Primitive.scala

@@ -0,0 +1,92 @@
+package l3
+
+/**
+  * A class for L₃ primitives.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+sealed abstract class L3Primitive(val name: String, val arity: Int) {
+  override def toString: String = name
+}
+
+sealed abstract class L3ValuePrimitive(name: String, arity: Int)
+    extends L3Primitive(name, arity)
+sealed abstract class L3TestPrimitive(name: String, arity: Int)
+    extends L3Primitive(name, arity)
+
+object L3Primitive {
+  // Primitives on blocks
+  case class BlockAlloc(tag: L3BlockTag)
+      extends L3ValuePrimitive(s"block-alloc-${tag}", 1)
+  case object BlockP extends L3TestPrimitive("block?", 1)
+  case object BlockTag extends L3ValuePrimitive("block-tag", 1)
+  case object BlockLength extends L3ValuePrimitive("block-length", 1)
+  case object BlockGet extends L3ValuePrimitive("block-get", 2)
+  case object BlockSet extends L3ValuePrimitive("block-set!", 3)
+
+  // Primitives on integers
+  case object IntP extends L3TestPrimitive("int?", 1)
+
+  case object IntAdd extends L3ValuePrimitive("+", 2)
+  case object IntSub extends L3ValuePrimitive("-", 2)
+  case object IntMul extends L3ValuePrimitive("*", 2)
+  case object IntDiv extends L3ValuePrimitive("/", 2)
+  case object IntMod extends L3ValuePrimitive("%", 2)
+
+  case object IntShiftLeft extends L3ValuePrimitive("shift-left", 2)
+  case object IntShiftRight extends L3ValuePrimitive("shift-right", 2)
+  case object IntBitwiseAnd extends L3ValuePrimitive("and", 2)
+  case object IntBitwiseOr extends L3ValuePrimitive("or", 2)
+  case object IntBitwiseXOr extends L3ValuePrimitive("xor", 2)
+
+
+  case object IntLt extends L3TestPrimitive("<", 2)
+  case object IntLe extends L3TestPrimitive("<=", 2)
+
+
+  case object ByteRead extends L3ValuePrimitive("byte-read", 0)
+  case object ByteWrite extends L3ValuePrimitive("byte-write", 1)
+
+  case object IntToChar extends L3ValuePrimitive("int->char", 1)
+
+  // Primitives on characters
+  case object CharP extends L3TestPrimitive("char?", 1)
+
+  case object CharToInt extends L3ValuePrimitive("char->int", 1)
+
+  // Primitives on booleans
+  case object BoolP extends L3TestPrimitive("bool?", 1)
+
+  // Primitives on unit
+  case object UnitP extends L3TestPrimitive("unit?", 1)
+
+  // Primitives on arbitrary values
+
+  case object Eq extends L3TestPrimitive("=", 2)
+  case object Id extends L3ValuePrimitive("id", 1)
+
+  def isDefinedAt(name: String): Boolean =
+    byName isDefinedAt name
+
+  def isDefinedAt(name: String, arity: Int): Boolean =
+    (byName isDefinedAt name) && (byName(name).arity == arity)
+
+  def apply(name: String): L3Primitive =
+    byName(name)
+
+  private val blockAllocators = for (i <- 0 to 200) yield BlockAlloc(i)
+
+  // Note: private primitives (id and block-alloc-n for n > 200) are ommitted
+  // on purpose from this map, as they are not meant to be used by user code.
+  private val byName: Map[String, L3Primitive] =
+    Map((Seq(BlockP, BlockTag, BlockLength, BlockGet, BlockSet,
+             IntP, IntAdd, IntSub, IntMul, IntDiv, IntMod,
+             IntShiftLeft, IntShiftRight,
+             IntBitwiseAnd, IntBitwiseOr, IntBitwiseXOr,
+             IntLt, IntLe, Eq, IntToChar,
+             CharP, ByteRead, ByteWrite, CharToInt,
+             BoolP,
+             UnitP) ++ blockAllocators)
+          map { p => (p.name, p) } : _*)
+}

cs420-acc/l3-warmup/compiler/src/l3/Main.scala

@@ -0,0 +1,47 @@
+package l3
+
+import java.io.PrintWriter
+import java.nio.file.{ Files, Paths }
+
+import l3.SymbolicCL3TreeModule.Tree
+
+object Main {
+  def main(args: Array[String]): Unit = {
+    val backEnd: Tree => TerminalPhaseResult = (
+      CL3Interpreter
+    )
+
+    val basePath = Paths.get(".").toAbsolutePath
+    Either.cond(! args.isEmpty, args.toIndexedSeq, "no input file given")
+      .flatMap(L3FileReader.readFilesExpandingModules(basePath, _))
+      .flatMap(p => L3Parser.parse(p._1, p._2))
+      .flatMap(CL3NameAnalyzer)
+      .flatMap(backEnd) match {
+      case Right((retCode, maybeMsg)) =>
+        maybeMsg foreach println
+        sys.exit(retCode)
+      case Left(errMsg) =>
+        println(s"Error: $errMsg")
+        sys.exit(1)
+    }
+  }
+
+  private lazy val outPrintWriter =
+    new PrintWriter(System.out, true)
+
+  private def treePrinter[T](msg: String)(implicit f: Formatter[T]): T => T =
+    passThrough { tree =>
+      outPrintWriter.println(msg)
+      f.toDoc(tree).writeTo(80, outPrintWriter)
+      outPrintWriter.println()
+    }
+
+  private def seqPrinter[T](msg: String): Seq[T] => Seq[T] =
+    passThrough { program =>
+      outPrintWriter.println(msg)
+      program foreach outPrintWriter.println
+    }
+
+  private def passThrough[T](f: T => Unit): T => T =
+    { t: T => f(t); t }
+}

cs420-acc/l3-warmup/compiler/src/l3/Position.scala

@@ -0,0 +1,12 @@
+package l3
+
+sealed trait Position
+
+final class FilePosition(fileName: String, line: Int, column: Int)
+    extends Position {
+  override def toString: String = s"$fileName:$line:$column"
+}
+
+object UnknownPosition extends Position {
+  override def toString: String = "<unknown position>"
+}

cs420-acc/l3-warmup/compiler/src/l3/Symbol.scala

@@ -0,0 +1,32 @@
+package l3
+
+/**
+  * A class for symbols, i.e. globally-unique names.
+  *
+  * @author Michel Schinz <Michel.Schinz@epfl.ch>
+  */
+
+final class Symbol(val name: String, idProvider: => Int) {
+  private[this] lazy val id =
+    idProvider
+
+  def copy(): Symbol =
+    new Symbol(name, idProvider)
+
+  override def toString: String =
+    if (id == 0) name else s"${name}_${id}"
+}
+
+object Symbol {
+  private[this] val counters = scala.collection.mutable.HashMap[String,Int]()
+
+  def fresh(name: String): Symbol = {
+    def id: Int = {
+      val id = counters.getOrElse(name, 0)
+      counters.put(name, id + 1)
+      id
+    }
+
+    new Symbol(name, id)
+  }
+}

cs420-acc/l3-warmup/compiler/src/l3/package.scala

@@ -0,0 +1,49 @@
+package object l3 {
+  type TerminalPhaseResult = Either[String, (Int, Option[String])]
+
+  type L3BlockTag = Int
+  type L3Char = Int
+
+  // A 32-bit integer (which could contain a pointer, a tagged value,
+  // or an untagged value).
+  type Bits32 = Int
+
+  val L3_INT_BITS = java.lang.Integer.SIZE - 1
+
+  // Bit twiddling
+  def bitsToIntMSBF(bits: Int*): Int =
+    bits.foldLeft(0) { (v, b) => (v << 1) | b }
+
+  def fitsInNSignedBits(bits: Int)(value: Int): Boolean = {
+    require(0 <= bits && bits < Integer.SIZE)
+    val value1 = value >> (bits - 1)
+    value1 == 0 || value1 == -1
+  }
+
+  def fitsInNUnsignedBits(bits: Int)(value: Int): Boolean = {
+    require(0 <= bits && bits < Integer.SIZE)
+    (value >>> bits) == 0
+  }
+
+  // Substitutions
+  type Subst[T] = Map[T, T]
+  def emptySubst[T]: Subst[T] =
+    Map.empty[T, T].withDefault(identity)
+  def subst[T](from: T, to: T): Subst[T] =
+    emptySubst[T] + (from -> to)
+  def subst[T](from: Seq[T], to: Seq[T]): Subst[T] =
+    emptySubst[T] ++ (from zip to)
+
+  // Fixed point computation
+  private def fixedPoint[T](start: T, maxIt: Option[Int])(f: T=>T): T = {
+    val approx = LazyList.iterate(start, maxIt getOrElse Integer.MAX_VALUE)(f)
+    val (improv, stable) = ((approx zip approx.tail) span (p => p._1 != p._2))
+    if (improv.isEmpty) stable.head._1 else improv.last._2
+  }
+
+  private[l3] def fixedPoint[T](start: T)(f: T=>T): T =
+    fixedPoint(start, None)(f)
+
+  private[l3] def fixedPoint[T](start: T, maxIt: Int)(f: T=>T): T =
+    fixedPoint(start, Some(maxIt))(f)
+}