Initial commit

.gitignore

+# compiler
+/compiler/.bsp/
+/compiler/**/target/
+/compiler/out.l3a
+
+# VM
+/vm/c/bin/
+/vm/rust/target/

README.org

+#+OPTIONS: toc:nil author:nil
+#+TITLE: The L₃ project
+
+Welcome to the L₃ project, composed of an L₃ compiler, a virtual machine, a library and a few example programs. The directories are laid out as follows:
+
+  - ~compiler~ :: contains the source code of the L₃ compiler,
+
+  - ~vm~ :: contains the source code of the main version of the L₃ virtual machine (written in C),
+
+  - ~vm-rust~ :: contains the source code of the Rust version of the L₃ virtual machine,
+
+  - ~library~ :: contains the source code of the L₃ library,
+
+  - ~examples~ :: contains a few example L₃ programs and benchmarks.
+
+Most of these directories contain a ~README.org~ file with further information.

compiler/README.org

+#+OPTIONS: toc:nil author:nil
+#+TITLE: The L₃ compiler
+
+* Introduction
+
+This directory contains the source code of the L₃ compiler, written in Scala. All interactions with the compiler should be done through [[http://www.scala-sbt.org/][sbt]], a Scala build tool.
+
+~Sbt~ can either be run in interactive mode, by simply typing ~sbt~ and then entering commands at the prompt, or in batch mode. The following sections use batch mode for illustration, but in practice interactive mode is often to be preferred as it avoids repeated startup of ~sbt~ itself.
+
+* Compiling
+
+To compile the compiler, use the ~compile~ command:
+: $ sbt compile
+(the dollar sign ~$~ represents the shell prompt and should not be typed).
+
+* Testing
+
+To test the compiler (and compile it beforehand, if necessary), use the ~test~ command:
+: $ sbt test
+
+* Running
+
+To run the compiler (and compile it beforehand, if necessary), use the ~run~ command, followed by arguments for the compiler, e.g.:
+: $ sbt 'run ../library/lib.l3m ../examples/queens.l3'
+
+The compiler accepts a list of files to compile as arguments. These files can have one of the following extensions:
+
+  - ~.l3~ :: A normal source file, containing L₃ code.
+
+  - ~.l3m~ :: A module file, containing a list of other files, which must also be either source files (with a ~.l3~ extension) or other module files (with a ~.l3m~ extension).
+
+Modules are expanded recursively, until only ~.l3~ files remain. Then, duplicate file names are removed, with only the first occurrence kept. Finally, this list of files is fed to the compiler.
+
+As an example, assume that the file ~lib.l3m~ references ~characters.l3m~ and ~integers.l3m~, and that ~characters.l3m~ references ~characters.l3~ while ~integers.l3m~ references both ~characters.l3m~ and ~integers.l3~. Then, a command line consisting of ~lib.l3m~ and ~helloworld.l3~ is expanded as follows:
+
+  1. ~lib.l3m~ ~helloworld.l3~ (original command line),
+
+  2. ~characters.l3m~ ~integers.l3m~ ~helloworld.l3~ (expansion of ~lib.l3m~),
+
+  3. ~characters.l3~ ~characters.l3m~ ~integers.l3~ ~helloworld.l3~ (expansion of ~characters.l3m~ and ~integers.l3m~),
+
+  4. ~characters.l3~ ~characters.l3~ ~integers.l3~ ~helloworld.l3~ (expansion of the second ~characters.l3m~),
+
+  5. ~characters.l3~ ~integers.l3~ ~helloworld.l3~ (removal of duplicates).

compiler/build.sbt

+ThisBuild / organization := "ch.epfl"
+ThisBuild / version      := "2021"
+
+ThisBuild / scalaVersion := "2.13.4"
+
+val javaMemOptions = Seq("-Xss32M", "-Xms128M")
+
+lazy val root = (project in file("."))
+// Enable packaging of the L3 compiler so that it can be run without SBT.
+// See documentation at https://www.scala-sbt.org/sbt-native-packager/
+// Among the tasks added by this plugin, the most useful are:
+// - "stage" to create the scripts locally in target/universal/stage/bin,
+// - "dist" to create a Zip archive in target/universal.
+  .enablePlugins(JavaAppPackaging)
+  .settings(
+    name := "l3c",
+
+    scalacOptions ++= Seq("-feature",
+                          "-deprecation",
+                          "-unchecked",
+                          "-encoding", "utf-8"),
+
+    // Main configuration
+    Compile / scalaSource := baseDirectory.value / "src",
+    libraryDependencies ++= Seq(
+      "com.lihaoyi"   %% "fastparse"   % "2.3.1",
+      "org.typelevel" %% "paiges-core" % "0.4.0"),
+
+    fork := true,
+    javaOptions ++= javaMemOptions,
+
+    run / connectInput := true,
+    run / outputStrategy := Some(StdoutOutput),
+
+    // Test configuration
+    Test / scalaSource := baseDirectory.value / "test",
+    libraryDependencies += "com.lihaoyi" %% "utest" % "0.7.7" % "test",
+    testFrameworks += new TestFramework("utest.runner.Framework"),
+
+    // Packaging configuration (sbt-native-packager)
+    Compile / packageDoc / mappings := Seq(),
+    Universal / javaOptions ++= javaMemOptions.map("-J" + _))

compiler/project/build.properties

+sbt.version=1.4.7

compiler/project/plugins.sbt

+addSbtPlugin("com.typesafe.sbt" % "sbt-native-packager" % "1.8.0")

compiler/src/l3/BlockTag.scala

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

compiler/src/l3/CL3Interpreter.scala

+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
+  }
+}

compiler/src/l3/CL3Literal.scala

+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

compiler/src/l3/CL3NameAnalyzer.scala

+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) })
+}

compiler/src/l3/CL3Tree.scala

+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
+}

compiler/src/l3/CL3TreeFormatter.scala

+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)
+}

compiler/src/l3/Formatter.scala

+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)
+}

compiler/src/l3/IO.scala

+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()
+  }
+}

compiler/src/l3/L3FileReader.scala

+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
+  }