2019-05-13 12:20:23 +00:00
|
|
|
open Proto_alpha_utils
|
2019-05-12 20:56:22 +00:00
|
|
|
open Trace
|
|
|
|
open Mini_c
|
|
|
|
open! Compiler.Program
|
|
|
|
open Memory_proto_alpha.Script_ir_translator
|
|
|
|
|
|
|
|
let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
|
|
|
|
let Compiler.Program.{input;output;body} : compiled_program = program in
|
|
|
|
let (Ex_ty input_ty) = input in
|
|
|
|
let (Ex_ty output_ty) = output in
|
|
|
|
let%bind input =
|
|
|
|
Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
|
2019-05-13 12:20:23 +00:00
|
|
|
Memory_proto_alpha.parse_michelson_data input_michelson input_ty in
|
2019-05-12 20:56:22 +00:00
|
|
|
let body = Michelson.strip_annots body in
|
|
|
|
let%bind descr =
|
|
|
|
Trace.trace_tzresult_lwt (simple_error "error parsing program code") @@
|
2019-05-13 12:20:23 +00:00
|
|
|
Memory_proto_alpha.parse_michelson body
|
2019-05-12 20:56:22 +00:00
|
|
|
(Stack.(input_ty @: nil)) (Stack.(output_ty @: nil)) in
|
|
|
|
let open! Memory_proto_alpha.Script_interpreter in
|
|
|
|
let%bind (Item(output, Empty)) =
|
|
|
|
Trace.trace_tzresult_lwt (simple_error "error of execution") @@
|
2019-05-13 12:20:23 +00:00
|
|
|
Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in
|
2019-05-12 20:56:22 +00:00
|
|
|
ok (Ex_typed_value (output_ty, output))
|
|
|
|
|
|
|
|
let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:value) : value result =
|
|
|
|
let%bind compiled =
|
|
|
|
let error =
|
|
|
|
let title () = "compile entry" in
|
|
|
|
let content () =
|
|
|
|
Format.asprintf "%a" PP.function_ entry
|
|
|
|
in
|
|
|
|
error title content in
|
|
|
|
trace error @@
|
|
|
|
translate_entry entry in
|
|
|
|
if debug_michelson then Format.printf "Program: %a\n" Michelson.pp compiled.body ;
|
|
|
|
let%bind input_michelson = translate_value input in
|
|
|
|
let%bind ex_ty_value = run_aux ?options compiled input_michelson in
|
|
|
|
let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in
|
|
|
|
ok result
|