diff --git a/daml-script/daml/Daml/Script.daml b/daml-script/daml/Daml/Script.daml index 46c12bcbf693..84c8886c8017 100644 --- a/daml-script/daml/Daml/Script.daml +++ b/daml-script/daml/Daml/Script.daml @@ -45,7 +45,8 @@ data CommandsF a | Exercise { tplId : TemplateTypeRep, cId : ContractId (), argE : AnyChoice, continueE : LedgerValue -> a } deriving Functor -type Commands = Ap CommandsF +newtype Commands a = Commands (Ap CommandsF a) + deriving (Functor, Applicative) data ScriptF a = Submit (SubmitCmd a) @@ -60,7 +61,7 @@ data QueryACS a = QueryACS } deriving Functor query : forall t. Template t => Party -> Script [t] -query p = Free $ Query (QueryACS p (templateTypeRep @t) (pure . map (fromSome . fromAnyTemplate))) +query p = Script $ Free $ Query (QueryACS p (templateTypeRep @t) (pure . map (fromSome . fromAnyTemplate))) data AllocateParty a = AllocateParty { displayName : Text @@ -68,15 +69,16 @@ data AllocateParty a = AllocateParty } deriving Functor allocateParty : Text -> Script Party -allocateParty displayName = Free (AllocParty $ AllocateParty displayName pure) +allocateParty displayName = Script $ Free (AllocParty $ AllocateParty displayName pure) data SubmitCmd a = SubmitCmd { party : Party, commands : Commands a } deriving Functor submit : Party -> Commands a -> Script a -submit p cmds = Free (fmap pure $ Submit $ SubmitCmd p cmds) +submit p cmds = Script $ Free (fmap pure $ Submit $ SubmitCmd p cmds) -type Script = Free ScriptF +newtype Script a = Script (Free ScriptF a) + deriving (Functor, Applicative, Action) data LedgerValue = LedgerValue {} @@ -84,8 +86,7 @@ fromLedgerValue : LedgerValue -> a fromLedgerValue = error "foobar" createCmd : Template t => t -> Commands (ContractId t) -createCmd arg = Ap (\f -> f (Create (toAnyTemplate arg) identity) (pure coerceContractId)) +createCmd arg = Commands $ Ap (\f -> f (Create (toAnyTemplate arg) identity) (pure coerceContractId)) exerciseCmd : forall t c r. Choice t c r => ContractId t -> c -> Commands r -exerciseCmd cId arg = Ap (\f -> f (Exercise (templateTypeRep @t) (coerceContractId cId) (toAnyChoice @t arg) identity) (pure fromLedgerValue)) - +exerciseCmd cId arg = Commands $ Ap (\f -> f (Exercise (templateTypeRep @t) (coerceContractId cId) (toAnyChoice @t arg) identity) (pure fromLedgerValue)) 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 2b01969b3967..4c58905f81d9 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 @@ -18,7 +18,7 @@ import com.digitalasset.daml.lf.data.FrontStack import com.digitalasset.daml.lf.data.Ref._ import com.digitalasset.daml.lf.engine.ValueTranslator import com.digitalasset.daml.lf.language.Ast._ -import com.digitalasset.daml.lf.speedy.{Compiler, Pretty, Speedy, SValue} +import com.digitalasset.daml.lf.speedy.{Compiler, Pretty, Speedy, SValue, TraceLog} import com.digitalasset.daml.lf.speedy.SExpr._ import com.digitalasset.daml.lf.speedy.SResult._ import com.digitalasset.daml.lf.speedy.SValue._ @@ -110,10 +110,10 @@ class Runner( implicit ec: ExecutionContext, mat: ActorMaterializer): Future[SValue] = { val scriptExpr = EVal(scriptId) - val machine = + var machine = Speedy.Machine.fromSExpr(compiler.compile(scriptExpr), false, compiledPackages) - def go(): Future[SValue] = { + def stepToValue() = { while (!machine.isFinal) { machine.step() match { case SResultContinue => () @@ -125,17 +125,41 @@ class Runner( } } } + // TODO Share this logic with the trigger runner + var traceEmpty = true machine.traceLog.iterator.foreach { case (msg, optLoc) => + traceEmpty = false println(s"TRACE ${Pretty.prettyLoc(optLoc).render(80)}: $msg") } + if (!traceEmpty) { + machine = machine.copy(traceLog = TraceLog(machine.traceLog.capacity)) + } + } + + stepToValue() + machine.toSValue match { + // Unwrap Script newtype + case SRecord(_, _, vals) if vals.size == 1 => { + machine.ctrl = Speedy.CtrlExpr(SEValue(vals.get(0))) + } + case v => throw new ConverterException(s"Expected record with 1 field but got $v") + } + + def go(): Future[SValue] = { + stepToValue() machine.toSValue match { case SVariant(_, "Free", v) => { v match { case SVariant(_, "Submit", v) => { v match { case SRecord(_, _, vals) if vals.size == 2 => { - val freeAp = vals.get(1) + val freeAp = vals.get(1) match { + // Unwrap Commands newtype + case SRecord(_, _, vals) if vals.size == 1 => vals.get(0) + case v => + throw new ConverterException(s"Expected record with 1 field but got $v") + } val requestOrErr = for { party <- Converter.toParty(vals.get(0)) commands <- Converter.toCommands(compiledPackages, freeAp)