From ee4f89378d66ec99d58c2b140400267acadc69d0 Mon Sep 17 00:00:00 2001 From: nickchapman-da <49153372+nickchapman-da@users.noreply.github.com> Date: Wed, 20 May 2020 12:37:52 +0100 Subject: [PATCH] Speedy Tail Call Optimization (#6003) * Speedy Tail call optimization The goal of this PR is to achieve Tail call optimization #5767 Tail call optimization means that tail-calls execute without consuming resources. In particular, they must not consume stack space. Speedy has two stacks: The `env`-stack and the `kontStack`. For an optimized tail call in Speedy, we must not extend either. In Speedy, all function calls are executed via the code `enterFullyAppliedFunction`. The behaviour of this code (prior to this PR) is as follows: (1) Push the values of all args and free-variables on the env-stack (because that's where the code expects to find them), and (2) Push a KPop continuation on the kontStack, which will restore the env-stack to its original size before returning to the code which made the function call. We must stop doing both these things. We achieve this as follows: (1) We address function args and free-vars via a new machine component: the current `frame`. (2) We make continuations responsible for restoring their own environment. As well as achieving proper tail calls, we also gain a performance improvement by (a) removing the many pushes to the env-stack, and (b) never having to push (and then later re-enter) a KPop continuation. The args array and the free-vars array already existed, so there is no additional cost associated with constructing these array. The only extra costs (which are smaller than the gains) are that we must manage the new `frame` component of the machine, and we must record frame/env-size information in continuations so they can restore their environment. To make use of the frame, we need to identify (at compile time) the run-time location for every variable in a speedy expression. This is done during the `closureConvert` phase. At run-time, an environment is now composed of both the existing env-stack and the frame. The only values which now live on the env-stack are those introduced by let-bindings and pattern-match-destructuring. All other are found in the frame. Changes to SEExpr: - Introduce a new expression form `SELoc`, with 3 sub classes: SELocS/SELocA/SELocF to represent the run-time location of a variable. - SELocS/A/F execute by calling corresponding lookup function in Speedy: getEnv(Stack,Arg,Free). - SEMakeClo takes a list of SELoc instead of list of int. - During closure conversion all SEVar are replaced by an SELocS/A/F. - SEVar are not allowed to exist at run-time (just as SEAbs may not exist). - We adapt the synthesised code for SEBuiltinRecursiveDefinition: FoldL, FoldR, EqualList It is worth noting the prior code also had the notion of before/after closureConvert, but SEVar was used for both meanings: Prior to closureConvert it meant the relative-index of the enclosing binder (lambda,let,..). After closureConvert it meant the relative-offset from the top of the env-stack where the value would be found at run-time. These are not quite the same! Now we have different sub-types (SEVar vs SELoc), this change of mode is made more explicit. Run-time changes: - Use the existing `KFun` continuation as the new `Frame` component. - `KFun` allows access to both the args of the current application, and the free-vars of the current closure. - A variable is looked up by it's run-time location (SELocS/A/F) - A function application is executed (`enterFullyAppliedFunction`), by setting the machine's `frame` component to the new current `KFun`. - When a continuation (KArg, KMatch, KPushTo, KCatch) is pushed, we record the current Frame and current stack depth within the continuation, so when it is entered, it can call `restoreEnv` to restore the environment to the state when the continuation was pushed. Changes to Compiler: - The required changes are to the `closureConvert` and `validate`. - `closureConvert` `remaps` is now a `Map` from the `SEVar`s relative-index to `SELoc` - `validate` now tracks 3-ints (maxS,masA,maxF) changelog_begin changelog_end * changes for Remy * Changes for Martin * test designed explicitly to blow if the free variables are captured incorrectly * address more comments * improve comment about shift in Compiler --- .../scala/com/daml/lf/explore/Explore.scala | 84 ++++++-- .../daml/lf/speedy/Classify.scala | 28 +-- .../daml/lf/speedy/Compiler.scala | 180 +++++++++++------- .../digitalasset/daml/lf/speedy/Pretty.scala | 11 +- .../daml/lf/speedy/PrettyLightweight.scala | 24 +-- .../digitalasset/daml/lf/speedy/SExpr.scala | 114 +++++++---- .../digitalasset/daml/lf/speedy/SValue.scala | 4 +- .../digitalasset/daml/lf/speedy/Speedy.scala | 123 +++++++----- .../daml/lf/speedy/SpeedyTest.scala | 18 ++ .../daml/lf/engine/script/Converter.scala | 2 +- .../daml/lf/engine/script/Runner.scala | 2 +- 11 files changed, 386 insertions(+), 204 deletions(-) diff --git a/daml-lf/interpreter/perf/src/main/scala/com/daml/lf/explore/Explore.scala b/daml-lf/interpreter/perf/src/main/scala/com/daml/lf/explore/Explore.scala index 107544bde57c..c015e5f37191 100644 --- a/daml-lf/interpreter/perf/src/main/scala/com/daml/lf/explore/Explore.scala +++ b/daml-lf/interpreter/perf/src/main/scala/com/daml/lf/explore/Explore.scala @@ -24,35 +24,42 @@ object PlaySpeedy { val config: Config = parseArgs(args0) val compiler: Compiler = Compiler(Map.empty, Compiler.NoProfile) - val e: SExpr = compiler.unsafeClosureConvert(examples(config.exampleName)) - val m: Machine = makeMachine(e) - runMachine(config, m) + val names: List[String] = config.names match { + case Nil => examples.toList.map(_._1) + case xs => xs + } + + names.foreach { name => + val (expected, expr) = examples(name) + val converted = compiler.unsafeClosureConvert(expr) + val machine = makeMachine(converted) + runMachine(name, machine, expected) + } } final case class Config( - exampleName: String, + names: List[String], ) def usage(): Unit = { println(""" - |usage: explore [EXAMPLE-NAME] + |usage: explore [EXAMPLES] + |default: run all known examples """.stripMargin) } def parseArgs(args0: List[String]): Config = { - - var exampleName: String = "thrice-thrice" - + var names: List[String] = Nil def loop(args: List[String]): Unit = args match { case Nil => {} case "-h" :: _ => usage() case "--help" :: _ => usage() case name :: args => - exampleName = name + names = names ++ List(name) loop(args) } loop(args0) - Config(exampleName) + Config(names) } private val txSeed = crypto.Hash.hashPrivateKey("SpeedyExplore") @@ -69,14 +76,21 @@ object PlaySpeedy { ) } - def runMachine(config: Config, machine: Machine): Unit = { + def runMachine(name: String, machine: Machine, expected: Int): Unit = { - println(s"example name: ${config.exampleName}") + println(s"example name: $name") machine.run() match { - case SResultFinalValue(value) => { + case SResultFinalValue(value) => println(s"final-value: $value") - } + value match { + case SInt64(got) => + if (got != expected) { + throw new MachineProblem(s"Expected final integer to be $expected, but got $got") + } + case _ => + throw new MachineProblem(s"Expected final-value to be an integer") + } case res => throw new MachineProblem(s"Unexpected result from machine $res") } @@ -84,7 +98,7 @@ object PlaySpeedy { final case class MachineProblem(s: String) extends RuntimeException(s, null, false, false) - def examples: Map[String, SExpr] = { + def examples: Map[String, (Int, SExpr)] = { def num(n: Long): SExpr = SEValue(SInt64(n)) @@ -102,13 +116,41 @@ object PlaySpeedy { def thrice2(f: SExpr, x: SExpr): SExpr = SEApp(f, Array(SEApp(f, Array(SEApp(f, Array(x)))))) val thrice = SEAbs(2, thrice2(SEVar(2), SEVar(1))) - Map( - "sub" -> subtract2(num(11), num(33)), - "sub/sub" -> subtract2(subtract2(num(1), num(3)), subtract2(num(5), num(10))), - "subF" -> SEApp(subtract, Array(num(88), num(55))), - "thrice" -> SEApp(thrice, Array(decrement, num(0))), - "thrice-thrice" -> SEApp(thrice, Array(thrice, decrement, num(0))), + val examples = List( + ( + "sub", //11-33 + -22, + subtract2(num(11), num(33))), + ( + "sub/sub", // (1-3)-(5-10) + 3, + subtract2(subtract2(num(1), num(3)), subtract2(num(5), num(10)))), + ( + "subF", //88-55 + 33, + SEApp(subtract, Array(num(88), num(55)))), + ( + "thrice", // thrice (\x -> x - 1) 0 + -3, + SEApp(thrice, Array(decrement, num(0)))), + ( + "thrice-thrice", //thrice thrice (\x -> x - 1) 0 + -27, + SEApp(thrice, Array(thrice, decrement, num(0)))), + ( + "free", // let (a,b,c) = (30,100,21) in twice (\x -> x - (a-c)) b + 82, + SELet( + Array(num(30), num(100), num(21)), + SEApp( + twice, + Array(SEAbs(1, subtract2(SEVar(1), subtract2(SEVar(4), SEVar(2)))), SEVar(2)))) //100 + ) ) + + val res = examples.map { case (k, x, e) => (k, (x, e)) }.toMap + + res } } diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Classify.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Classify.scala index cf604dc67979..ccad88d56f56 100644 --- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Classify.scala +++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Classify.scala @@ -14,7 +14,9 @@ object Classify { // classify the machine state w.r.t what step occurs next var ctrlValue: Int, // expression classification (ctrlExpr) var evalue: Int, - var evar: Int, + var evarS: Int, + var evarA: Int, + var evarF: Int, var eapp: Int, var eclose: Int, var ebuiltin: Int, @@ -28,7 +30,6 @@ object Classify { // classify the machine state w.r.t what step occurs next var ewronglytypedcontractid: Int, // kont classification (ctrlValue) var kfinished: Int, - var kpop: Int, var karg: Int, var kfun: Int, var kpushto: Int, @@ -42,7 +43,9 @@ object Classify { // classify the machine state w.r.t what step occurs next List( ("CtrlExpr:", ctrlExpr), ("- evalue", evalue), - ("- evar", evar), + ("- evarS", evarS), + ("- evarA", evarA), + ("- evarF", evarF), ("- eapp", eapp), ("- eclose", eclose), ("- ebuiltin", ebuiltin), @@ -55,7 +58,6 @@ object Classify { // classify the machine state w.r.t what step occurs next ("- eimportvalue", eimportvalue), ("CtrlValue:", ctrlValue), ("- kfinished", kfinished), - ("- kpop", kpop), ("- karg", karg), ("- kfun", kfun), ("- kpushto", kpushto), @@ -68,7 +70,7 @@ object Classify { // classify the machine state w.r.t what step occurs next } def newEmptyCounts(): Counts = { - Counts(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) + Counts(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) } def classifyMachine(machine: Machine, counts: Counts): Unit = { @@ -86,7 +88,10 @@ object Classify { // classify the machine state w.r.t what step occurs next def classifyExpr(exp: SExpr, counts: Counts): Unit = { exp match { case SEValue(_) => counts.evalue += 1 - case SEVar(_) => counts.evar += 1 + case SEVar(_) => //not expected at runtime + case SELocS(_) => counts.evarS += 1 + case SELocA(_) => counts.evarA += 1 + case SELocF(_) => counts.evarF += 1 case SEApp(_, _) => counts.eapp += 1 case SEMakeClo(_, _, _) => counts.eclose += 1 case SEBuiltin(_) => counts.ebuiltin += 1 @@ -96,7 +101,7 @@ object Classify { // classify the machine state w.r.t what step occurs next case SECase(_, _) => counts.ecase += 1 case SEBuiltinRecursiveDefinition(_) => counts.ebuiltinrecursivedefinition += 1 case SECatch(_, _, _) => counts.ecatch += 1 - case SEAbs(_, _) => //never expect these! + case SEAbs(_, _) => //not expected at runtime case SELabelClosure(_, _) => () case SEImportValue(_) => counts.eimportvalue += 1 case SEWronglyTypeContractId(_, _, _) => counts.ewronglytypedcontractid += 1 @@ -105,14 +110,13 @@ object Classify { // classify the machine state w.r.t what step occurs next def classifyKont(kont: Kont, counts: Counts): Unit = { kont match { - case KPop(_) => counts.kpop += 1 - case KArg(_) => counts.karg += 1 + case KArg(_, _, _) => counts.karg += 1 case KFun(_, _, _) => counts.kfun += 1 - case KPushTo(_, _) => counts.kpushto += 1 + case KPushTo(_, _, _, _) => counts.kpushto += 1 case KCacheVal(_, _) => counts.kcacheval += 1 case KLocation(_) => counts.klocation += 1 - case KMatch(_) => counts.kmatch += 1 - case KCatch(_, _, _) => counts.kcatch += 1 + case KMatch(_, _, _) => counts.kmatch += 1 + case KCatch(_, _, _, _) => counts.kcatch += 1 case KFinished => counts.kfinished += 1 case KLabelClosure(_) | KLeaveClosure(_) => () } diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Compiler.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Compiler.scala index f22832cc4bf7..125cb979fd37 100644 --- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Compiler.scala +++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Compiler.scala @@ -26,6 +26,7 @@ import scala.annotation.tailrec * is exposed via ':speedy' command in the REPL. */ private[lf] object Compiler { + case class CompilationError(error: String) extends RuntimeException(error, null, true, false) case class PackageNotFound(pkgId: PackageId) extends RuntimeException(s"Package not found $pkgId", null, true, false) @@ -154,17 +155,17 @@ private[lf] final case class Compiler( @throws[PackageNotFound] @throws[CompilationError] def unsafeCompile(cmds: ImmArray[Command]): SExpr = - validate(closureConvert(Map.empty, 0, translateCommands(cmds))) + validate(closureConvert(Map.empty, translateCommands(cmds))) @throws[PackageNotFound] @throws[CompilationError] def unsafeCompile(expr: Expr): SExpr = - validate(closureConvert(Map.empty, 0, translate(expr))) + validate(closureConvert(Map.empty, translate(expr))) @throws[PackageNotFound] @throws[CompilationError] def unsafeClosureConvert(sexpr: SExpr): SExpr = - validate(closureConvert(Map.empty, 0, sexpr)) + validate(closureConvert(Map.empty, sexpr)) @throws[PackageNotFound] @throws[CompilationError] @@ -845,7 +846,6 @@ private[lf] final case class Compiler( validate( closureConvert( Map.empty, - 0, withEnv { _ => env = env.incrPos // env = env.incrPos // @@ -983,65 +983,74 @@ private[lf] final case class Compiler( * describing the free variables that need to be captured. * * For example: - * SELet(...) in - * SEAbs(2, SEVar(4)) + * SELet(..two-bindings..) in + * SEAbs(2, + * SEVar(4) .. [reference to first let-bound variable] + * SEVar(2)) [reference to first function-arg] * => - * SELet(...) in + * SELet(..two-bindings..) in * SEMakeClo( - * Array(SEVar(2)), (capture 2nd value) - * 2, (still takes two arguments) - * SEVar(3)) (variable now first value after args) + * Array(SELocS(2)), [capture the first let-bound variable, from the stack] + * 2, + * SELocF(0) .. [reference the first let-bound variable via the closure] + * SELocA(0)) [reference the first function arg] */ - def closureConvert(remaps: Map[Int, Int], bound: Int, expr: SExpr): SExpr = { - def remap(i: Int): Int = - remaps - .get(bound - i) - // map the absolute stack position back into a - // relative position - .map(bound - _) - .getOrElse(i) + def closureConvert(remaps: Map[Int, SELoc], expr: SExpr): SExpr = { + // remaps is a function which maps the relative offset from variables (SEVar) to their runtime location + // The Map must contain a binding for every variable referenced. + // The Map is consulted when translating variable references (SEVar) and free variables of an abstraction (SEAbs) + def remap(i: Int): SELoc = { + remaps.get(i) match { + case None => throw CompilationError(s"remap($i),remaps=$remaps") + case Some(loc) => loc + } + } expr match { - case SEVar(i) => SEVar(remap(i)) + case SEVar(i) => remap(i) case v: SEVal => v case be: SEBuiltin => be case pl: SEValue => pl case f: SEBuiltinRecursiveDefinition => f case SELocation(loc, body) => - SELocation(loc, closureConvert(remaps, bound, body)) + SELocation(loc, closureConvert(remaps, body)) case SEAbs(0, _) => throw CompilationError("empty SEAbs") - case SEAbs(n, body) => - val fv = freeVars(body, n).toList.sorted - - // remap free variables to new indices. - // the index is the absolute position in stack. - val newRemaps = fv.zipWithIndex.map { + case SEAbs(arity, body) => + val fvs = freeVars(body, arity).toList.sorted + val newRemapsF: Map[Int, SELoc] = fvs.zipWithIndex.map { case (orig, i) => - // mapping from old position in the stack - // to the new position - (bound - orig) -> (bound - i - 1) + (orig + arity) -> SELocF(i) }.toMap - val newBody = closureConvert(newRemaps, bound + n, body) - SEMakeClo(fv.reverse.map(remap).toArray, n, newBody) + val newRemapsA = (1 to arity).map { + case i => + i -> SELocA(arity - i) + } + // The keys in newRemapsF and newRemapsA are disjoint + val newBody = closureConvert(newRemapsF ++ newRemapsA, body) + SEMakeClo(fvs.map(remap).toArray, arity, newBody) + + case x: SELoc => + throw CompilationError(s"closureConvert: unexpected SELoc: $x") case x: SEMakeClo => - throw CompilationError(s"unexpected SEMakeClo: $x") + throw CompilationError(s"closureConvert: unexpected SEMakeClo: $x") case SEApp(fun, args) => - val newFun = closureConvert(remaps, bound, fun) - val newArgs = args.map(closureConvert(remaps, bound, _)) + val newFun = closureConvert(remaps, fun) + val newArgs = args.map(closureConvert(remaps, _)) SEApp(newFun, newArgs) case SECase(scrut, alts) => SECase( - closureConvert(remaps, bound, scrut), + closureConvert(remaps, scrut), alts.map { case SCaseAlt(pat, body) => + val n = patternNArgs(pat) SCaseAlt( pat, - closureConvert(remaps, bound + patternNArgs(pat), body), + closureConvert(shift(remaps, n), body), ) }, ) @@ -1049,18 +1058,18 @@ private[lf] final case class Compiler( case SELet(bounds, body) => SELet(bounds.zipWithIndex.map { case (b, i) => - closureConvert(remaps, bound + i, b) - }, closureConvert(remaps, bound + bounds.length, body)) + closureConvert(shift(remaps, i), b) + }, closureConvert(shift(remaps, bounds.length), body)) case SECatch(body, handler, fin) => SECatch( - closureConvert(remaps, bound, body), - closureConvert(remaps, bound, handler), - closureConvert(remaps, bound, fin), + closureConvert(remaps, body), + closureConvert(remaps, handler), + closureConvert(remaps, fin), ) case SELabelClosure(label, expr) => - SELabelClosure(label, closureConvert(remaps, bound, expr)) + SELabelClosure(label, closureConvert(remaps, expr)) case x: SEWronglyTypeContractId => throw CompilationError(s"unexpected SEWronglyTypeContractId: $x") @@ -1070,6 +1079,29 @@ private[lf] final case class Compiler( } } + // Modify/extend `remaps` to reflect when new values are pushed on the stack. This + // happens as we traverse into SELet and SECase bodies which have bindings which at + // runtime will appear on the stack. + // We must modify `remaps` because it is keyed by indexes relative to the end of the stack. + // And any values in the map which are of the form SELocS must also be _shifted_ + // because SELocS indexes are also relative to the end of the stack. + def shift(remaps: Map[Int, SELoc], n: Int): Map[Int, SELoc] = { + + // We must update both the keys of the map (the relative-indexes from the original SEVar) + // And also any values in the map which are stack located (SELocS), which are also indexed relatively + val m1 = remaps.map { case (k, loc) => (n + k, shiftLoc(loc, n)) } + + // And create mappings for the `n` new stack items + val m2 = (1 to n).map(i => (i, SELocS(i))) + + m1 ++ m2 + } + + def shiftLoc(loc: SELoc, n: Int): SELoc = loc match { + case SELocS(i) => SELocS(i + n) + case SELocA(_) | SELocF(_) => loc + } + /** Compute the free variables in a speedy expression. * The returned free variables are de bruijn indices * adjusted to the stack of the caller. */ @@ -1095,8 +1127,10 @@ private[lf] final case class Compiler( bound += n go(body) bound -= n + case x: SELoc => + throw CompilationError(s"freeVars: unexpected SELoc: $x") case x: SEMakeClo => - throw CompilationError(s"unexpected SEMakeClo: $x") + throw CompilationError(s"freeVars: unexpected SEMakeClo: $x") case SECase(scrut, alts) => go(scrut) alts.foreach { @@ -1127,8 +1161,9 @@ private[lf] final case class Compiler( } /** Validate variable references in a speedy expression */ - def validate(expr: SExpr): SExpr = { - var bound = 0 + // valiate that we correctly captured all free-variables, and so reference to them is + // via the surrounding closure, instead of just finding them higher up on the stack + def validate(expr0: SExpr): SExpr = { def goV(v: SValue): Unit = { v match { @@ -1151,12 +1186,22 @@ private[lf] final case class Compiler( } } - def go(expr: SExpr): Unit = - expr match { - case SEVar(i) => - if (i < 1 || i > bound) { - throw CompilationError(s"validate: SEVar: index $i out of bound $bound") - } + def goBody(maxS: Int, maxA: Int, maxF: Int): SExpr => Unit = { + + def goLoc(loc: SELoc) = loc match { + case SELocS(i) => + if (i < 1 || i > maxS) + throw CompilationError(s"validate: SELocS: index $i out of range ($maxS..1)") + case SELocA(i) => + if (i < 0 || i >= maxA) + throw CompilationError(s"validate: SELocA: index $i out of range (0..$maxA-1)") + case SELocF(i) => + if (i < 0 || i >= maxF) + throw CompilationError(s"validate: SELocF: index $i out of range (0..$maxF-1)") + } + + def go(expr: SExpr): Unit = expr match { + case loc: SELoc => goLoc(loc) case _: SEVal => () case _: SEBuiltin => () case _: SEBuiltinRecursiveDefinition => () @@ -1164,33 +1209,26 @@ private[lf] final case class Compiler( case SEApp(fun, args) => go(fun) args.foreach(go) + case x: SEVar => + throw CompilationError(s"validate: SEVar encountered: $x") case abs: SEAbs => throw CompilationError(s"validate: SEAbs encountered: $abs") - case SEMakeClo(fv, n, body) => - fv.foreach { i => - if (i < 1 || i > bound) { - throw CompilationError( - s"validate: SEMakeClo: free variable $i is out of bounds ($bound)") - } - } - val oldBound = bound - bound = n + fv.length - go(body) - bound = oldBound + case SEMakeClo(fvs, n, body) => + fvs.foreach(goLoc) + goBody(0, n, fvs.length)(body) case SECase(scrut, alts) => go(scrut) alts.foreach { case SCaseAlt(pat, body) => val n = patternNArgs(pat) - bound += n; go(body); bound -= n + goBody(maxS + n, maxA, maxF)(body) } case SELet(bounds, body) => - bounds.foreach { e => - go(e) - bound += 1 + bounds.zipWithIndex.foreach { + case (rhs, i) => + goBody(maxS + i, maxA, maxF)(rhs) } - go(body) - bound -= bounds.length + goBody(maxS + bounds.length, maxA, maxF)(body) case SECatch(body, handler, fin) => go(body) go(handler) @@ -1204,8 +1242,10 @@ private[lf] final case class Compiler( case x: SEImportValue => throw CompilationError(s"unexpected SEImportValue: $x") } - go(expr) - expr + go + } + goBody(0, 0, 0)(expr0) + expr0 } private def compileFetch(tmplId: Identifier, coid: SExpr): SExpr = { diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Pretty.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Pretty.scala index 717453275d0f..2dbbf1fb11fd 100644 --- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Pretty.scala +++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Pretty.scala @@ -454,6 +454,13 @@ object Pretty { } (pat & text("=>") + lineOrSpace + prettySExpr(newIndex)(alt.body)).nested(2) } + + def prettySELoc(loc: SELoc): Doc = loc match { + case SELocS(i) => char('S') + str(i) + case SELocA(i) => char('A') + str(i) + case SELocF(i) => char('F') + str(i) + } + def prettySExpr(index: Int)(e: SExpr): Doc = e match { case SEVar(i) => char('@') + str(index - i) @@ -515,11 +522,13 @@ object Pretty { case SEMakeClo(fv, n, body) => val prefix = char('[') + - intercalate(space, fv.map((v: Int) => str(v))) + char(']') + text("(\\") + + intercalate(space, fv.map(prettySELoc)) + char(']') + text("(\\") + intercalate(space, (index to n + index - 1).map((v: Int) => str(v))) & text("-> ") prettySExpr(index + n)(body).tightBracketBy(prefix, char(')')) + case loc: SELoc => prettySELoc(loc) + case SELet(bounds, body) => // let [a, b, c] in X intercalate(comma + lineOrSpace, (bounds.zipWithIndex.map { diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/PrettyLightweight.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/PrettyLightweight.scala index 2be14a07d609..cd2ec5baa058 100644 --- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/PrettyLightweight.scala +++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/PrettyLightweight.scala @@ -25,8 +25,8 @@ object PrettyLightweight { // lightweight pretty printer for CEK machine states } def ppEnv(env: Env): String = { - //s"{${commas(env.asScala.map(pp))}}" - s"{#${env.size()}}" //show just the env size + s"#${env.size()}={${commas(env.asScala.map(pp))}}" + //s"{#${env.size()}}" //show just the env size } def ppKontStack(ks: util.ArrayList[Kont]): String = { @@ -35,31 +35,33 @@ object PrettyLightweight { // lightweight pretty printer for CEK machine states } def ppKont(k: Kont): String = k match { - case KPop(n) => s"KPop($n)" - case KArg(es) => s"KArg(${commas(es.map(pp))})" + case KArg(es, _, _) => s"KArg(${commas(es.map(pp))})" case KFun(prim, extendedArgs, arity) => s"KFun(${pp(prim)}/$arity,[${commas(extendedArgs.asScala.map(pp))}])" - case KPushTo(_, e) => s"KPushTo(_, ${pp(e)})" + case KPushTo(_, e, _, _) => s"KPushTo(_, ${pp(e)})" case KCacheVal(_, _) => "KCacheVal" case KLocation(_) => "KLocation" - case KMatch(_) => "KMatch" - case KCatch(_, _, _) => "KCatch" //never seen + case KMatch(_, _, _) => "KMatch" + case KCatch(_, _, _, _) => "KCatch" case KFinished => "KFinished" case KLabelClosure(_) => "KLabelClosure" case KLeaveClosure(_) => "KLeaveClosure" } - def ppVarRef(n: Int): String = { - s"#$n" + def pp(v: SELoc) = v match { + case SELocS(n) => s"S#$n" + case SELocA(n) => s"A#$n" + case SELocF(n) => s"F#$n" } def pp(e: SExpr): String = e match { case SEValue(v) => pp(v) - case SEVar(n) => ppVarRef(n) + case SEVar(n) => s"D#$n" //dont expect thee at runtime + case loc: SELoc => pp(loc) //case SEApp(func, args) => s"@(${pp(func)},${commas(args.map(pp))})" case SEApp(_, _) => s"@(...)" //case SEMakeClo(fvs, arity, body) => s"[${commas(fvs.map(ppVarRef))}]lam/$arity->${pp(body)}" - case SEMakeClo(fvs, arity, _) => s"[${commas(fvs.map(ppVarRef))}]lam/$arity->..." + case SEMakeClo(fvs, arity, _) => s"[${commas(fvs.map(pp))}]lam/$arity->..." case SEBuiltin(b) => s"${b}" case SEVal(_) => "" case SELocation(_, _) => "" diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SExpr.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SExpr.scala index 9284e0f6d456..e49e70cff992 100644 --- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SExpr.scala +++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SExpr.scala @@ -37,12 +37,14 @@ sealed abstract class SExpr extends Product with Serializable { object SExpr { /** Reference to a variable. 'index' is the 1-based de Bruijn index, - * that is, SEVar(1) points to the top-most value in the environment. + * that is, SEVar(1) points to the nearest enclosing variable binder. + * which could be an SELam, SELet, or a binding variant of SECasePat. * https://en.wikipedia.org/wiki/De_Bruijn_index + * This expression form is only allowed prior to closure conversion */ final case class SEVar(index: Int) extends SExpr { def execute(machine: Machine): Unit = { - machine.returnValue = machine.getEnv(index) + crash("unexpected SEVar, expected SELoc(S/A/F)") } } @@ -101,7 +103,7 @@ object SExpr { */ final case class SEApp(fun: SExpr, args: Array[SExpr]) extends SExpr with SomeArrayEquals { def execute(machine: Machine): Unit = { - machine.pushKont(KArg(args)) + machine.pushKont(KArg(args, machine.frame, machine.env.size)) machine.ctrl = fun } } @@ -126,30 +128,58 @@ object SExpr { /** Closure creation. Create a new closure object storing the free variables * in 'body'. */ - final case class SEMakeClo(fv: Array[Int], arity: Int, body: SExpr) + final case class SEMakeClo(fvs: Array[SELoc], arity: Int, body: SExpr) extends SExpr with SomeArrayEquals { def execute(machine: Machine): Unit = { - def convertToSValues(fv: Array[Int], getEnv: Int => SValue) = { - val sValues = new Array[SValue](fv.length) - var i = 0 - while (i < fv.length) { - sValues(i) = getEnv(fv(i)) - i = i + 1 - } - sValues + val sValues = Array.ofDim[SValue](fvs.length) + var i = 0 + while (i < fvs.length) { + sValues(i) = fvs(i).lookup(machine) + i += 1 } - - val sValues = convertToSValues(fv, machine.getEnv) machine.returnValue = SPAP(PClosure(null, body, sValues), new util.ArrayList[SValue](), arity) } } + /** SELoc -- Reference to the runtime location of a variable. + + This is the closure-converted form of SEVar. There are three sub-forms, with sufffix: + S/A/F, indicating [S]tack, [A]argument, or [F]ree variable captured by a closure. + */ + sealed abstract class SELoc extends SExpr { + def lookup(machine: Machine): SValue + def execute(machine: Machine): Unit = { + machine.returnValue = lookup(machine) + } + } + + // SELocS -- variable is located on the stack (SELet & binding forms of SECasePat) + final case class SELocS(n: Int) extends SELoc { + def lookup(machine: Machine): SValue = { + machine.getEnvStack(n) + } + } + + // SELocS -- variable is located in the args array of the application + final case class SELocA(n: Int) extends SELoc { + def lookup(machine: Machine): SValue = { + machine.getEnvArg(n) + } + } + + // SELocF -- variable is located in the free-vars array of the closure being applied + final case class SELocF(n: Int) extends SELoc { + def lookup(machine: Machine): SValue = { + machine.getEnvFree(n) + } + } + /** Pattern match. */ final case class SECase(scrut: SExpr, alts: Array[SCaseAlt]) extends SExpr with SomeArrayEquals { def execute(machine: Machine): Unit = { - machine.pushKont(KMatch(alts)) + machine.pushKont(KMatch(alts, machine.frame, machine.env.size)) machine.ctrl = scrut } @@ -176,16 +206,16 @@ object SExpr { */ final case class SELet(bounds: Array[SExpr], body: SExpr) extends SExpr with SomeArrayEquals { def execute(machine: Machine): Unit = { - // Pop the block once we're done evaluating the body - machine.pushKont(KPop(bounds.size)) // Evaluate the body after we've evaluated the binders - machine.pushKont(KPushTo(machine.env, body)) + machine.pushKont( + KPushTo(machine.env, body, machine.frame, machine.env.size + bounds.size - 1)) // Start evaluating the let binders for (i <- 1 until bounds.size) { val b = bounds(bounds.size - i) - machine.pushKont(KPushTo(machine.env, b)) + val expectedEnvSize = machine.env.size + bounds.size - i - 1 + machine.pushKont(KPushTo(machine.env, b, machine.frame, expectedEnvSize)) } machine.ctrl = bounds.head } @@ -228,7 +258,7 @@ object SExpr { */ final case class SECatch(body: SExpr, handler: SExpr, fin: SExpr) extends SExpr { def execute(machine: Machine): Unit = { - machine.pushKont(KCatch(handler, fin, machine.env.size)) + machine.pushKont(KCatch(handler, fin, machine.frame, machine.env.size)) machine.ctrl = body } } @@ -271,10 +301,10 @@ object SExpr { /** Case patterns */ sealed trait SCasePat - /** Match on a variant. On match the value is unboxed and pushed to environment. */ + /** Match on a variant. On match the value is unboxed and pushed to stack. */ final case class SCPVariant(id: Identifier, variant: Name, constructorRank: Int) extends SCasePat - /** Match on a variant. On match the value is unboxed and pushed to environment. */ + /** Match on a variant. On match the value is unboxed and pushed to stack. */ final case class SCPEnum(id: Identifier, constructor: Name, constructorRank: Int) extends SCasePat /** Match on a primitive constructor, that is on true, false or unit. */ @@ -283,7 +313,7 @@ object SExpr { /** Match on an empty list. */ final case object SCPNil extends SCasePat - /** Match on a list. On match, the head and tail of the list is pushed to environment. */ + /** Match on a list. On match, the head and tail of the list is pushed to the stack. */ final case object SCPCons extends SCasePat /** Default match case. Always matches. */ @@ -348,9 +378,9 @@ object SExpr { Array(), 3, // case xs of - SECase(SEVar(1)) of ( + SECase(SELocA(2)) of ( // nil -> z - SCaseAlt(SCPNil, SEVar(2)), + SCaseAlt(SCPNil, SELocA(1)), // cons y ys -> SCaseAlt( SCPCons, @@ -358,15 +388,15 @@ object SExpr { SEApp( FoldL, Array( - SEVar(5), /* f */ + SELocA(0), /* f */ SEApp( - SEVar(5), + SELocA(0), Array( - SEVar(4), /* z */ - SEVar(2) /* y */ + SELocA(1), /* z */ + SELocS(2) /* y */ ) ), - SEVar(1) /* ys */ + SELocS(1) /* ys */ ) ) ) @@ -379,24 +409,24 @@ object SExpr { Array(), 3, // case xs of - SECase(SEVar(1)) of (// nil -> z - SCaseAlt(SCPNil, SEVar(2)), + SECase(SELocA(2)) of (// nil -> z + SCaseAlt(SCPNil, SELocA(1)), // cons y ys -> SCaseAlt( SCPCons, // f y (foldr f z ys) SEApp( - SEVar(5), + SELocA(0), Array( /* f */ - SEVar(2), /* y */ + SELocS(2), /* y */ SEApp( FoldR, Array( /* foldr f z ys */ - SEVar(5), /* f */ - SEVar(4), /* z */ - SEVar(1) /* ys */ + SELocA(0), /* f */ + SELocA(1), /* z */ + SELocS(1) /* ys */ ) ) ) @@ -410,14 +440,14 @@ object SExpr { Array(), 3, // case xs of - SECase(SEVar(2) /* xs */ ) of ( + SECase(SELocA(1) /* xs */ ) of ( // nil -> SCaseAlt( SCPNil, // case ys of // nil -> True // default -> False - SECase(SEVar(1)) of (SCaseAlt(SCPNil, SEValue.True), + SECase(SELocA(2)) of (SCaseAlt(SCPNil, SEValue.True), SCaseAlt(SCPDefault, SEValue.False)) ), // cons x xss -> @@ -426,17 +456,17 @@ object SExpr { // case ys of // True -> listEqual f xss yss // False -> False - SECase(SEVar(3) /* ys */ ) of ( + SECase(SELocA(2) /* ys */ ) of ( // nil -> False SCaseAlt(SCPNil, SEValue.False), // cons y yss -> SCaseAlt( SCPCons, // case f x y of - SECase(SEApp(SEVar(7), Array(SEVar(4), SEVar(2)))) of ( + SECase(SEApp(SELocA(0), Array(SELocS(2), SELocS(4)))) of ( SCaseAlt( SCPPrimCon(PCTrue), - SEApp(EqualList, Array(SEVar(7), SEVar(1), SEVar(3))), + SEApp(EqualList, Array(SELocA(0), SELocS(1), SELocS(3))), ), SCaseAlt(SCPPrimCon(PCFalse), SEValue.False) ) diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SValue.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SValue.scala index f2fc5e441659..def733274e7e 100644 --- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SValue.scala +++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SValue.scala @@ -131,10 +131,10 @@ object SValue { * See [[com.daml.lf.speedy.Profile]] for an explanation why we use * [[AnyRef]] for the label. */ - final case class PClosure(label: AnyRef, expr: SExpr, closure: Array[SValue]) + final case class PClosure(label: AnyRef, expr: SExpr, fvs: Array[SValue]) extends Prim with SomeArrayEquals { - override def toString: String = s"PClosure($expr, ${closure.mkString("[", ",", "]")})" + override def toString: String = s"PClosure($expr, ${fvs.mkString("[", ",", "]")})" } /** A partially applied primitive. diff --git a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Speedy.scala b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Speedy.scala index f1690c499ed6..1b7fac287aec 100644 --- a/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Speedy.scala +++ b/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Speedy.scala @@ -58,6 +58,26 @@ object Speedy { } } + /* + Speedy uses a caller-saves strategy for managing the environment. In a Speedy machine, + the environment is represented by the `frame` and `env` components. + + Continuations are responsible for restoring their own environment. In the general case, + an arbitrary amount of computation may have occurred between the continuation being + pushed and then later entered. + + When we push a continuation which requires it's environment to be preserved, we record + the current Frame and the current env-stack depth within the continuation. Then, when + the continuation is entered, it will call `restoreEnv`. + + We do this for KArg, KMatch, KPushTo, KCatch. + + We *dont* need to do this for KFun. Because, when KFun is entered, it immediately + changes `frame` to point to itself, and there will be no references to existing + stack-variables within the body of the function. (They will have been translated to + free-var reference by the compiler). + */ + /** The speedy CEK machine. */ final case class Machine( /* The control is what the machine should be evaluating. If this is not @@ -68,7 +88,9 @@ object Speedy { * been fully evaluated. If this is not null, then `ctrl` must be null. */ var returnValue: SValue, - /* The environment: an array of values */ + /* Frame: to access values for function arguments and closure free-vars. */ + var frame: Frame, + /* Environment: values pushed to a stack: let-bindings and pattern-matches. */ var env: Env, /* Kont, or continuation specifies what should be done next * once the control has been evaluated. @@ -122,30 +144,44 @@ object Speedy { /* env manipulation... */ - @inline def envDepth(): Int = env.size() + // The environment is partitioned into three locations: Stack, Args, Free + // The run-time location of a variable is determined (at compile time) by closureConvert + // And made explicit by a specifc speedy expression node: SELocS/SELocA/SELocF + // At runtime these different location-node execute by calling the corresponding `getEnv*` function + + // Variables which reside on the stack. Indexed by relative offset from the top of the stack + @inline def getEnvStack(i: Int): SValue = env.get(env.size - i) - @inline def getEnv(i: Int): SValue = env.get(env.size - i) + // Variables which reside in the args array of the current frame. Indexed by absolute offset. + @inline def getEnvArg(i: Int): SValue = frame.args.get(i) + + // Variables which reside in the free-vars array of the current frame. Indexed by absolute offset. + @inline def getEnvFree(i: Int): SValue = { + //TODO(NC) : modify types to avoid this asInstanceOf + frame.prim.asInstanceOf[PClosure].fvs(i) + } @inline def pushEnv(v: SValue): Unit = { env.add(v) if (enableInstrumentation) { track.countPushesEnv += 1 - if (envDepth > track.maxDepthEnv) track.maxDepthEnv = envDepth + if (env.size > track.maxDepthEnv) track.maxDepthEnv = env.size } } - @inline def pushEnvAll(vs: Env): Unit = { - env.addAll(vs) - if (enableInstrumentation) { - track.countPushesEnv += vs.size() - if (envDepth > track.maxDepthEnv) track.maxDepthEnv = envDepth + @inline def restoreEnv(frameToBeRestored: Frame, envSize: Int): Unit = { + // Restore the frame pointer captured when the continuation was created. + frame = frameToBeRestored + // Pop the env-stack back to the size it was when the continuation was created. + if (envSize != env.size) { + val count = env.size - envSize + if (count < 1) { + crash(s"restoreEnv, unexpected negative count: $count!") + } + env.subList(envSize, env.size).clear } } - @inline def popEnv(count: Int): Unit = { - env.subList(env.size - count, env.size).clear - } - /** Push a single location to the continuation stack for the sake of maintaining a stack trace. */ def pushLocation(loc: Location): Unit = { @@ -156,7 +192,7 @@ object Speedy { // NOTE(MH): If the top of the continuation stack is the monadic token, // we push location information under it to account for the implicit // lambda binding the token. - case Some(KArg(Array(SEValue.Token))) => { + case Some(KArg(Array(SEValue.Token), _, _)) => { // Can't call pushKont here, because we don't push at the top of the stack. kontStack.add(last_index, KLocation(loc)) if (enableInstrumentation) { @@ -317,22 +353,14 @@ object Speedy { def enterFullyAppliedFunction(prim: Prim, args: util.ArrayList[SValue]): Unit = { prim match { - case PClosure(label, expr, vars) => + case PClosure(label, expr, _) => if (label != null) { profile.addOpenEvent(label) pushKont(KLeaveClosure(label)) } - - // Pop the arguments once we're done evaluating the body. - pushKont(KPop(args.size + vars.size)) - - // Add all the variables we closed over - vars.foreach(pushEnv) - - // Add the arguments - pushEnvAll(args) - - // And start evaluating the body of the closure. + // Start evaluating the body of the closure. (We dont do anything with the + // function arguments or free-varables, because the frame will have been set to + // allow their access within the body). ctrl = expr case PBuiltin(b) => @@ -502,6 +530,7 @@ object Speedy { Machine( ctrl = null, returnValue = null, + frame = null, env = emptyEnv, kontStack = initialKontStack(), lastLocation = None, @@ -590,6 +619,14 @@ object Speedy { initial(compiledPackages, submissionTime, seeding, globalCids).copy(ctrl = sexpr) } + // + // Frame + // + // For our frame, we use the KFun continuation directly. From here + // we can access both the application arguments, and the values of + // the free-variables which were stored into the closure. + type Frame = KFun + // // Environment // @@ -630,17 +667,12 @@ object Speedy { } } - /** Pop 'count' arguments from the environment. */ - final case class KPop(count: Int) extends Kont { - def execute(v: SValue, machine: Machine) = { - machine.popEnv(count) - machine.returnValue = v - } - } - /** The function has been evaluated to a value, now start evaluating the arguments. */ - final case class KArg(newArgs: Array[SExpr]) extends Kont with SomeArrayEquals { + final case class KArg(newArgs: Array[SExpr], frame: Frame, envSize: Int) + extends Kont + with SomeArrayEquals { def execute(v: SValue, machine: Machine) = { + machine.restoreEnv(frame, envSize) v match { case SPAP(prim, args, arity) => val missing = arity - args.size @@ -655,7 +687,7 @@ object Speedy { if (othersLength > 0) { val others = new Array[SExpr](othersLength) System.arraycopy(newArgs, missing, others, 0, othersLength) - machine.pushKont(KArg(others)) + machine.pushKont(KArg(others, machine.frame, machine.env.size)) } machine.pushKont(KFun(prim, extendedArgs, arity)) @@ -664,7 +696,7 @@ object Speedy { var i = 1 while (i < newArgsLimit) { val arg = newArgs(newArgsLimit - i) - machine.pushKont(KPushTo(extendedArgs, arg)) + machine.pushKont(KPushTo(extendedArgs, arg, machine.frame, machine.env.size)) i = i + 1 } machine.ctrl = newArgs(0) @@ -682,6 +714,8 @@ object Speedy { def execute(v: SValue, machine: Machine) = { args.add(v) // Add last argument if (args.size == arity) { + // Set the frame to enable access for Arg/Free variable references + machine.frame = this machine.enterFullyAppliedFunction(prim, args) } else { // args.size < arity (we already dealt with args.size > args in Karg) @@ -691,8 +725,11 @@ object Speedy { } /** The scrutinee of a match has been evaluated, now match the alternatives against it. */ - final case class KMatch(alts: Array[SCaseAlt]) extends Kont with SomeArrayEquals { + final case class KMatch(alts: Array[SCaseAlt], frame: Frame, envSize: Int) + extends Kont + with SomeArrayEquals { def execute(v: SValue, machine: Machine) = { + machine.restoreEnv(frame, envSize) val altOpt = v match { case SBool(b) => alts.find { alt => @@ -707,7 +744,6 @@ object Speedy { alts.find { alt => alt.pattern match { case SCPVariant(_, _, rank2) if rank1 == rank2 => - machine.pushKont(KPop(1)) machine.pushEnv(arg) true case SCPDefault => true @@ -727,7 +763,6 @@ object Speedy { alt.pattern match { case SCPNil if lst.isEmpty => true case SCPCons if !lst.isEmpty => - machine.pushKont(KPop(2)) val Some((head, tail)) = lst.pop machine.pushEnv(head) machine.pushEnv(SList(tail)) @@ -752,7 +787,6 @@ object Speedy { mbVal match { case None => false case Some(x) => - machine.pushKont(KPop(1)) machine.pushEnv(x) true } @@ -778,8 +812,10 @@ object Speedy { * the PAP that is being built, and in the case of lets the evaluated value is pushed * direy into the environment. */ - final case class KPushTo(to: util.ArrayList[SValue], next: SExpr) extends Kont { + final case class KPushTo(to: util.ArrayList[SValue], next: SExpr, frame: Frame, envSize: Int) + extends Kont { def execute(v: SValue, machine: Machine) = { + machine.restoreEnv(frame, envSize) to.add(v) machine.ctrl = next } @@ -804,8 +840,9 @@ object Speedy { * If an exception is raised and 'KCatch' is found from kont-stack, then 'handler' is * evaluated. If 'KCatch' is encountered naturally, then 'fin' is evaluated. */ - final case class KCatch(handler: SExpr, fin: SExpr, envSize: Int) extends Kont { + final case class KCatch(handler: SExpr, fin: SExpr, frame: Frame, envSize: Int) extends Kont { def execute(v: SValue, machine: Machine) = { + machine.restoreEnv(frame, envSize) machine.ctrl = fin } } diff --git a/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/SpeedyTest.scala b/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/SpeedyTest.scala index 0d4085023cca..478f2081c561 100644 --- a/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/SpeedyTest.scala +++ b/daml-lf/interpreter/src/test/scala/com/digitalasset/daml/lf/speedy/SpeedyTest.scala @@ -24,6 +24,24 @@ class SpeedyTest extends WordSpec with Matchers { import SpeedyTest._ import defaultParserParameters.{defaultPackageId => pkgId} + "free variables" should { + + val pkgs = typeAndCompile(p"") + + "be captured correctly" in { + eval( + e""" + let a : Int64 = 88 in + let b : Int64 = 33 in + (\ (x: Unit) -> SUB_INT64 a b) () + """, + pkgs + // If the get the order of the free variables wrong, this test should fail because + // the subtraction performed will be (33-88) and so result in (-55). + ) shouldEqual Right(SInt64(55)) + } + } + "pattern matching" should { val pkg = diff --git a/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Converter.scala b/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Converter.scala index 072b6772d82e..f465285fb656 100644 --- a/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Converter.scala +++ b/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Converter.scala @@ -209,7 +209,7 @@ object Converter { 2, SEApp( SEBuiltin(SBStructCon(Name.Array(Name.assertFromString("a"), Name.assertFromString("b")))), - Array(SEVar(2), SEVar(1))), + Array(SELocA(0), SELocA(1))), ) val machine = Speedy.Machine.fromSExpr( diff --git a/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Runner.scala b/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Runner.scala index a6dd47583c6e..bfcca134d0cb 100644 --- a/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Runner.scala +++ b/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Runner.scala @@ -272,7 +272,7 @@ class Runner( private val extendedCompiledPackages = { val fromLedgerValue: PartialFunction[SDefinitionRef, SExpr] = { case LfDefRef(id) if id == script.scriptIds.damlScript("fromLedgerValue") => - SEMakeClo(Array(), 1, SEVar(1)) + SEMakeClo(Array(), 1, SELocA(0)) } new CompiledPackages { def getPackage(pkgId: PackageId): Option[Package] = compiledPackages.getPackage(pkgId)