Refactoring eval run functions
This commit is contained in:
parent
a121766a89
commit
4be2d6fb6a
@ -39,6 +39,14 @@ let syntax =
|
|||||||
info ~docv ~doc ["syntax" ; "s"] in
|
info ~docv ~doc ["syntax" ; "s"] in
|
||||||
value @@ opt string "auto" info
|
value @@ opt string "auto" info
|
||||||
|
|
||||||
|
let req_syntax n =
|
||||||
|
let open Arg in
|
||||||
|
let info =
|
||||||
|
let docv = "SYNTAX" in
|
||||||
|
let doc = "$(docv) is the syntax that will be used. Currently supported syntaxes are \"pascaligo\" and \"cameligo\". By default, the syntax is guessed from the extension (.ligo and .mligo, respectively)." in
|
||||||
|
info ~docv ~doc [] in
|
||||||
|
required @@ pos n (some string) None info
|
||||||
|
|
||||||
let amount =
|
let amount =
|
||||||
let open Arg in
|
let open Arg in
|
||||||
let info =
|
let info =
|
||||||
@ -86,12 +94,15 @@ let michelson_code_format =
|
|||||||
(enum [("text", `Text); ("json", `Json); ("hex", `Hex)])
|
(enum [("text", `Text); ("json", `Json); ("hex", `Hex)])
|
||||||
`Text info
|
`Text info
|
||||||
|
|
||||||
|
module Helpers = Ligo.Compile.Helpers
|
||||||
|
module Compile = Ligo.Compile.Wrapper
|
||||||
|
module Uncompile = Ligo.Uncompile
|
||||||
|
module Run = Ligo.Run.Of_michelson
|
||||||
|
|
||||||
let compile_file =
|
let compile_file =
|
||||||
let f source_file entry_point syntax display_format michelson_format =
|
let f source_file entry_point syntax display_format michelson_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind contract =
|
let%bind contract = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
|
||||||
trace (simple_info "compiling contract to michelson") @@
|
|
||||||
Ligo.Compile.Of_source.compile_file_contract_entry source_file entry_point (Syntax_name syntax) in
|
|
||||||
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
|
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) contract
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
@ -103,9 +114,7 @@ let compile_file =
|
|||||||
let measure_contract =
|
let measure_contract =
|
||||||
let f source_file entry_point syntax display_format =
|
let f source_file entry_point syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind contract =
|
let%bind contract = Compile.source_to_michelson_contract (Syntax_name syntax) source_file entry_point in
|
||||||
trace (simple_info "compiling contract to michelson") @@
|
|
||||||
Ligo.Compile.Of_source.compile_file_contract_entry source_file entry_point (Syntax_name syntax) in
|
|
||||||
let open Tezos_utils in
|
let open Tezos_utils in
|
||||||
ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract)
|
ok @@ Format.asprintf "%d bytes\n" (Michelson.measure contract)
|
||||||
in
|
in
|
||||||
@ -116,11 +125,12 @@ let measure_contract =
|
|||||||
(term , Term.info ~doc cmdname)
|
(term , Term.info ~doc cmdname)
|
||||||
|
|
||||||
let compile_parameter =
|
let compile_parameter =
|
||||||
let f source_file entry_point expression syntax display_format michelson_format =
|
let f source_file _entry_point expression syntax display_format michelson_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind value =
|
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
|
||||||
trace (simple_error "compile-input") @@
|
let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
|
||||||
Ligo.Run.Of_source.compile_file_contract_parameter source_file entry_point expression (Syntax_name syntax) in
|
let%bind compiled_exp = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in
|
||||||
|
let%bind value = Run.evaluate_michelson compiled_exp in
|
||||||
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
@ -129,12 +139,16 @@ let compile_parameter =
|
|||||||
let doc = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract." in
|
let doc = "Subcommand: compile parameters to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which calls a contract." in
|
||||||
(term , Term.info ~doc cmdname)
|
(term , Term.info ~doc cmdname)
|
||||||
|
|
||||||
|
(*-------------------------------------------------------------------------------------------------------------------------------------
|
||||||
|
TODO: This function does not typecheck anything, add the typecheck against the given entrypoint. For now: does the same as compile_parameter
|
||||||
|
-------------------------------------------------------------------------------------------------------------------------------------- *)
|
||||||
let compile_storage =
|
let compile_storage =
|
||||||
let f source_file entry_point expression syntax display_format michelson_format =
|
let f source_file _entry_point expression syntax display_format michelson_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind value =
|
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
|
||||||
trace (simple_error "compile-storage") @@
|
let%bind (_,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
|
||||||
Ligo.Run.Of_source.compile_file_contract_storage source_file entry_point expression (Syntax_name syntax) in
|
let%bind compiled = Compile.source_expression_to_michelson_value_as_function ~env ~state expression v_syntax in
|
||||||
|
let%bind value = Run.evaluate_michelson compiled in
|
||||||
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
@ -146,11 +160,15 @@ let compile_storage =
|
|||||||
let dry_run =
|
let dry_run =
|
||||||
let f source_file entry_point storage input amount sender source syntax display_format =
|
let f source_file entry_point storage input amount sender source syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind output =
|
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
|
||||||
Ligo.Run.Of_source.run_contract
|
let%bind (typed_program,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
|
||||||
~options:{ amount ; sender ; source }
|
let%bind compiled_param = Compile.source_contract_input_to_michelson_value_as_function ~env ~state (storage,input) v_syntax in
|
||||||
source_file entry_point storage input (Syntax_name syntax) in
|
let%bind michelson = Compile.typed_to_michelson_program typed_program entry_point in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
|
let%bind args_michelson = Run.evaluate_michelson compiled_param in
|
||||||
|
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
|
||||||
|
let%bind michelson_output = Run.run ~options michelson args_michelson in
|
||||||
|
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in
|
||||||
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format) in
|
||||||
@ -161,11 +179,15 @@ let dry_run =
|
|||||||
let run_function =
|
let run_function =
|
||||||
let f source_file entry_point parameter amount sender source syntax display_format =
|
let f source_file entry_point parameter amount sender source syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind output =
|
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (Some source_file) in
|
||||||
Ligo.Run.Of_source.run_function_entry
|
let%bind (typed_program,state,env) = Compile.source_to_typed (Syntax_name syntax) source_file in
|
||||||
~options:{ amount ; sender ; source }
|
let%bind compiled_parameter = Compile.source_expression_to_michelson_value_as_function ~env ~state parameter v_syntax in
|
||||||
source_file entry_point parameter (Syntax_name syntax) in
|
let%bind michelson = Compile.typed_to_michelson_program typed_program entry_point in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
|
let%bind args_michelson = Run.evaluate_michelson compiled_parameter in
|
||||||
|
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
|
||||||
|
let%bind michelson_output = Run.run ~options michelson args_michelson in
|
||||||
|
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_function_result typed_program entry_point michelson_output in
|
||||||
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ sender $ source $ syntax $ display_format) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ amount $ sender $ source $ syntax $ display_format) in
|
||||||
@ -176,11 +198,12 @@ let run_function =
|
|||||||
let evaluate_value =
|
let evaluate_value =
|
||||||
let f source_file entry_point amount sender source syntax display_format =
|
let f source_file entry_point amount sender source syntax display_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
let%bind output =
|
let%bind (typed_program,_,_) = Compile.source_to_typed (Syntax_name syntax) source_file in
|
||||||
Ligo.Run.Of_source.evaluate_entry
|
let%bind contract = Compile.typed_to_michelson_value_as_function typed_program entry_point in
|
||||||
~options:{ amount ; sender ; source }
|
let%bind options = Run.make_dry_run_options {amount ; sender ; source } in
|
||||||
source_file entry_point (Syntax_name syntax) in
|
let%bind michelson_output = Run.evaluate ~options contract in
|
||||||
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output
|
let%bind simplified_output = Uncompile.uncompile_typed_program_entry_expression_result typed_program entry_point michelson_output in
|
||||||
|
ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression simplified_output
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ source_file 0 $ entry_point 1 $ amount $ sender $ source $ syntax $ display_format) in
|
Term.(const f $ source_file 0 $ entry_point 1 $ amount $ sender $ source $ syntax $ display_format) in
|
||||||
@ -191,15 +214,15 @@ let evaluate_value =
|
|||||||
let compile_expression =
|
let compile_expression =
|
||||||
let f expression syntax display_format michelson_format =
|
let f expression syntax display_format michelson_format =
|
||||||
toplevel ~display_format @@
|
toplevel ~display_format @@
|
||||||
(* This is an actual compiler entry-point, so we start with a blank state *)
|
let%bind v_syntax = Helpers.syntax_to_variant (Syntax_name syntax) (None) in
|
||||||
let state = Typer.Solver.initial_state in
|
let%bind compiled = Compile.source_expression_to_michelson_value_as_function
|
||||||
let%bind value =
|
~env:(Ast_typed.Environment.full_empty) ~state:(Typer.Solver.initial_state)
|
||||||
trace (simple_error "compile-input") @@
|
expression v_syntax in
|
||||||
Ligo.Run.Of_source.compile_expression expression state (Syntax_name syntax) in
|
let%bind value = Run.evaluate_michelson compiled in
|
||||||
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value
|
||||||
in
|
in
|
||||||
let term =
|
let term =
|
||||||
Term.(const f $ expression "" 0 $ syntax $ display_format $ michelson_code_format) in
|
Term.(const f $ expression "" 1 $ req_syntax 0 $ display_format $ michelson_code_format) in
|
||||||
let cmdname = "compile-expression" in
|
let cmdname = "compile-expression" in
|
||||||
let doc = "Subcommand: compile to a michelson value." in
|
let doc = "Subcommand: compile to a michelson value." in
|
||||||
(term , Term.info ~doc cmdname)
|
(term , Term.info ~doc cmdname)
|
||||||
|
@ -380,12 +380,17 @@ let%expect_test _ =
|
|||||||
ligo-compile-expression - Subcommand: compile to a michelson value.
|
ligo-compile-expression - Subcommand: compile to a michelson value.
|
||||||
|
|
||||||
SYNOPSIS
|
SYNOPSIS
|
||||||
ligo compile-expression [OPTION]... _EXPRESSION
|
ligo compile-expression [OPTION]... SYNTAX _EXPRESSION
|
||||||
|
|
||||||
ARGUMENTS
|
ARGUMENTS
|
||||||
_EXPRESSION (required)
|
_EXPRESSION (required)
|
||||||
_EXPRESSION is the expression that will be compiled.
|
_EXPRESSION is the expression that will be compiled.
|
||||||
|
|
||||||
|
SYNTAX (required)
|
||||||
|
SYNTAX is the syntax that will be used. Currently supported
|
||||||
|
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
||||||
|
guessed from the extension (.ligo and .mligo, respectively).
|
||||||
|
|
||||||
OPTIONS
|
OPTIONS
|
||||||
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
|
||||||
(absent=human-readable)
|
(absent=human-readable)
|
||||||
@ -403,9 +408,4 @@ let%expect_test _ =
|
|||||||
--michelson-format=MICHELSON_FORMAT (absent=text)
|
--michelson-format=MICHELSON_FORMAT (absent=text)
|
||||||
MICHELSON_FORMAT is the format that will be used by
|
MICHELSON_FORMAT is the format that will be used by
|
||||||
compile-contract for the resulting Michelson. Available formats
|
compile-contract for the resulting Michelson. Available formats
|
||||||
are 'text' (default), 'json' and 'hex'.
|
are 'text' (default), 'json' and 'hex'. |} ] ;
|
||||||
|
|
||||||
-s SYNTAX, --syntax=SYNTAX (absent=auto)
|
|
||||||
SYNTAX is the syntax that will be used. Currently supported
|
|
||||||
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
|
|
||||||
guessed from the extension (.ligo and .mligo, respectively). |} ] ;
|
|
||||||
|
@ -42,7 +42,3 @@ let compile_contract_entry = fun program name ->
|
|||||||
let%bind storage_michelson = Compiler.Type.type_ storage_ty in
|
let%bind storage_michelson = Compiler.Type.type_ storage_ty in
|
||||||
let contract = Michelson.contract param_michelson storage_michelson compiled.body in
|
let contract = Michelson.contract param_michelson storage_michelson compiled.body in
|
||||||
ok contract
|
ok contract
|
||||||
|
|
||||||
|
|
||||||
let uncompile_value : Proto_alpha_utils.Memory_proto_alpha.X.ex_typed_value -> value result = fun x ->
|
|
||||||
Compiler.Uncompiler.translate_value x
|
|
||||||
|
@ -1,46 +1,9 @@
|
|||||||
open Ast_simplified
|
|
||||||
open Trace
|
open Trace
|
||||||
|
|
||||||
let compile_contract_entry (program : program) entry_point =
|
let compile (program : Ast_simplified.program) : (Ast_typed.program * Typer.Solver.state) result =
|
||||||
let%bind (prog_typed , state) = Typer.type_program program in
|
let%bind (prog_typed , state) = Typer.type_program program in
|
||||||
let () = Typer.Solver.discard_state state in
|
let () = Typer.Solver.discard_state state in
|
||||||
Of_typed.compile_contract_entry prog_typed entry_point
|
ok @@ (prog_typed, state)
|
||||||
|
|
||||||
let compile_function_entry (program : program) entry_point : _ result =
|
let compile_expression ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) : (Ast_typed.value * Typer.Solver.state) result =
|
||||||
let%bind (prog_typed , state) = Typer.type_program program in
|
Typer.type_expression env state ae
|
||||||
let () = Typer.Solver.discard_state state in
|
|
||||||
Of_typed.compile_function_entry prog_typed entry_point
|
|
||||||
|
|
||||||
let compile_expression_as_function_entry (program : program) entry_point : _ result =
|
|
||||||
let%bind (typed_program , state) = Typer.type_program program in
|
|
||||||
let () = Typer.Solver.discard_state state in
|
|
||||||
Of_typed.compile_expression_as_function_entry typed_program entry_point
|
|
||||||
|
|
||||||
(* TODO: do we need to thread the state here? Also, make the state arg. optional. *)
|
|
||||||
let compile_expression_as_function ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) (ae : Ast_simplified.expression) : _ result =
|
|
||||||
let%bind (typed , state) = Typer.type_expression env state ae in
|
|
||||||
(* TODO: move this to typer.ml *)
|
|
||||||
let typed =
|
|
||||||
if false then
|
|
||||||
let () = failwith "TODO : subst all" in let _todo = ignore (env, state) in typed
|
|
||||||
else
|
|
||||||
typed
|
|
||||||
in
|
|
||||||
Of_typed.compile_expression_as_function typed
|
|
||||||
|
|
||||||
let uncompile_typed_program_entry_expression_result program entry ex_ty_value =
|
|
||||||
let%bind output_type =
|
|
||||||
let%bind entry_expression = Ast_typed.get_entry program entry in
|
|
||||||
ok entry_expression.type_annotation
|
|
||||||
in
|
|
||||||
let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in
|
|
||||||
Typer.untype_expression typed
|
|
||||||
|
|
||||||
let uncompile_typed_program_entry_function_result program entry ex_ty_value =
|
|
||||||
let%bind output_type =
|
|
||||||
let%bind entry_expression = Ast_typed.get_entry program entry in
|
|
||||||
let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in
|
|
||||||
ok output_type
|
|
||||||
in
|
|
||||||
let%bind typed = Of_typed.uncompile_value ex_ty_value output_type in
|
|
||||||
Typer.untype_expression typed
|
|
@ -1,39 +1,16 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Helpers
|
open Helpers
|
||||||
|
|
||||||
let parse_file_program source_filename syntax =
|
let compile (source_filename:string) syntax : Ast_simplified.program result =
|
||||||
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
|
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
|
||||||
let%bind simplified = parsify syntax source_filename in
|
let%bind simplified = parsify syntax source_filename in
|
||||||
ok simplified
|
ok simplified
|
||||||
|
|
||||||
let compile_file_entry : string -> string -> s_syntax -> _ result =
|
let compile_expression : v_syntax -> string -> Ast_simplified.expression result =
|
||||||
fun source_filename entry_point syntax ->
|
fun syntax exp ->
|
||||||
let%bind simplified = parse_file_program source_filename syntax in
|
parsify_expression syntax exp
|
||||||
Of_simplified.compile_function_entry simplified entry_point
|
|
||||||
|
|
||||||
let compile_file_contract_entry : string -> string -> s_syntax -> _ result =
|
let compile_contract_input : string -> string -> v_syntax -> Ast_simplified.expression result =
|
||||||
fun source_filename entry_point syntax ->
|
fun storage parameter syntax ->
|
||||||
let%bind simplified = parse_file_program source_filename syntax in
|
let%bind (storage,parameter) = bind_map_pair (compile_expression syntax) (storage,parameter) in
|
||||||
let%bind compiled_contract = Of_simplified.compile_contract_entry simplified entry_point in
|
ok @@ Ast_simplified.e_pair storage parameter
|
||||||
ok compiled_contract
|
|
||||||
|
|
||||||
let compile_expression_as_function : string -> s_syntax -> _ result =
|
|
||||||
fun expression syntax ->
|
|
||||||
let%bind syntax = syntax_to_variant syntax None in
|
|
||||||
let%bind simplified = parsify_expression syntax expression in
|
|
||||||
Of_simplified.compile_expression_as_function ~state:Typer.Solver.initial_state (* TODO: thread state or start with initial? *) simplified
|
|
||||||
|
|
||||||
let type_file ?(debug_simplify = false) ?(debug_typed = false)
|
|
||||||
syntax (source_filename:string) : (Ast_typed.program * Typer.Solver.state) result =
|
|
||||||
let%bind syntax = syntax_to_variant syntax (Some source_filename) in
|
|
||||||
let%bind simpl = parsify syntax source_filename in
|
|
||||||
(if debug_simplify then
|
|
||||||
Format.(printf "Simplified : %a\n%!" Ast_simplified.PP.program simpl)
|
|
||||||
) ;
|
|
||||||
let%bind (typed, state) =
|
|
||||||
trace (simple_error "typing") @@
|
|
||||||
Typer.type_program simpl in
|
|
||||||
(if debug_typed then (
|
|
||||||
Format.(printf "Typed : %a\n%!" Ast_typed.PP.program typed)
|
|
||||||
)) ;
|
|
||||||
ok (typed, state)
|
|
@ -1,45 +1,8 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Ast_typed
|
open Ast_typed
|
||||||
|
|
||||||
|
let compile : Ast_typed.program -> Mini_c.program result = fun p ->
|
||||||
|
Transpiler.transpile_program p
|
||||||
|
|
||||||
let compile_expression_as_function : annotated_expression -> _ result = fun e ->
|
let compile_expression : annotated_expression -> Mini_c.expression result = fun e ->
|
||||||
let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
|
Transpiler.transpile_annotated_expression e
|
||||||
let%bind expr = Of_mini_c.compile_expression_as_function mini_c_expression in
|
|
||||||
ok expr
|
|
||||||
|
|
||||||
let compile_function : annotated_expression -> _ result = fun e ->
|
|
||||||
let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in
|
|
||||||
let%bind expr = Of_mini_c.compile_function mini_c_expression in
|
|
||||||
ok expr
|
|
||||||
|
|
||||||
let compile_function_entry : program -> string -> _ = fun p entry ->
|
|
||||||
let%bind prog_mini_c = Transpiler.transpile_program p in
|
|
||||||
Of_mini_c.compile_function_entry prog_mini_c entry
|
|
||||||
|
|
||||||
let compile_contract_entry : program -> string -> _ = fun p entry ->
|
|
||||||
let%bind prog_mini_c = Transpiler.transpile_program p in
|
|
||||||
Of_mini_c.compile_contract_entry prog_mini_c entry
|
|
||||||
|
|
||||||
let compile_expression_as_function_entry : program -> string -> _ = fun p entry ->
|
|
||||||
let%bind prog_mini_c = Transpiler.transpile_program p in
|
|
||||||
Of_mini_c.compile_expression_as_function_entry prog_mini_c entry
|
|
||||||
|
|
||||||
let uncompile_value : _ -> _ -> annotated_expression result = fun x ty ->
|
|
||||||
let%bind mini_c = Of_mini_c.uncompile_value x in
|
|
||||||
let%bind typed = Transpiler.untranspile mini_c ty in
|
|
||||||
ok typed
|
|
||||||
|
|
||||||
let uncompile_entry_function_result = fun program entry ex_ty_value ->
|
|
||||||
let%bind output_type =
|
|
||||||
let%bind entry_expression = get_entry program entry in
|
|
||||||
let%bind (_ , output_type) = get_t_function entry_expression.type_annotation in
|
|
||||||
ok output_type
|
|
||||||
in
|
|
||||||
uncompile_value ex_ty_value output_type
|
|
||||||
|
|
||||||
let uncompile_entry_expression_result = fun program entry ex_ty_value ->
|
|
||||||
let%bind output_type =
|
|
||||||
let%bind entry_expression = get_entry program entry in
|
|
||||||
ok entry_expression.type_annotation
|
|
||||||
in
|
|
||||||
uncompile_value ex_ty_value output_type
|
|
51
src/main/compile/wrapper.ml
Normal file
51
src/main/compile/wrapper.ml
Normal file
@ -0,0 +1,51 @@
|
|||||||
|
open Trace
|
||||||
|
|
||||||
|
let source_to_typed syntax source_file =
|
||||||
|
let%bind simplified = Of_source.compile source_file syntax in
|
||||||
|
let%bind typed,state = Of_simplified.compile simplified in
|
||||||
|
let env = Ast_typed.program_environment typed in
|
||||||
|
ok (typed,state,env)
|
||||||
|
|
||||||
|
let source_to_typed_expression ~env ~state parameter syntax =
|
||||||
|
let%bind simplified = Of_source.compile_expression syntax parameter in
|
||||||
|
let%bind (typed,_) = Of_simplified.compile_expression ~env ~state simplified in
|
||||||
|
ok typed
|
||||||
|
|
||||||
|
let typed_to_michelson_program
|
||||||
|
(typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result =
|
||||||
|
let%bind mini_c = Of_typed.compile typed in
|
||||||
|
Of_mini_c.compile_function_entry mini_c entry_point
|
||||||
|
|
||||||
|
let typed_to_michelson_value_as_function
|
||||||
|
(typed: Ast_typed.program) (entry_point:string) : Compiler.compiled_program result =
|
||||||
|
let%bind mini_c = Of_typed.compile typed in
|
||||||
|
Of_mini_c.compile_expression_as_function_entry mini_c entry_point
|
||||||
|
|
||||||
|
let typed_expression_to_michelson_value_as_function
|
||||||
|
(typed: Ast_typed.annotated_expression) : Compiler.compiled_program result =
|
||||||
|
let%bind mini_c = Of_typed.compile_expression typed in
|
||||||
|
Of_mini_c.compile_expression_as_function mini_c
|
||||||
|
|
||||||
|
let simplified_to_compiled_program
|
||||||
|
~env ~state (exp: Ast_simplified.expression) : Compiler.compiled_program result =
|
||||||
|
let%bind (typed,_) = Of_simplified.compile_expression ~env ~state exp in
|
||||||
|
typed_expression_to_michelson_value_as_function typed
|
||||||
|
|
||||||
|
let typed_to_michelson_contract
|
||||||
|
(typed: Ast_typed.program) (entry_point:string) : Michelson.michelson result =
|
||||||
|
let%bind mini_c = Of_typed.compile typed in
|
||||||
|
Of_mini_c.compile_contract_entry mini_c entry_point
|
||||||
|
|
||||||
|
let source_to_michelson_contract syntax source_file entry_point =
|
||||||
|
let%bind (typed,_,_) = source_to_typed syntax source_file in
|
||||||
|
typed_to_michelson_contract typed entry_point
|
||||||
|
|
||||||
|
let source_expression_to_michelson_value_as_function ~env ~state parameter syntax =
|
||||||
|
let%bind typed = source_to_typed_expression ~env ~state parameter syntax in
|
||||||
|
let%bind mini_c = Of_typed.compile_expression typed in
|
||||||
|
Of_mini_c.compile_expression_as_function mini_c
|
||||||
|
|
||||||
|
let source_contract_input_to_michelson_value_as_function ~env ~state (storage,parameter) syntax =
|
||||||
|
let%bind simplified = Of_source.compile_contract_input storage parameter syntax in
|
||||||
|
let%bind typed,_ = Of_simplified.compile_expression ~env ~state simplified in
|
||||||
|
typed_expression_to_michelson_value_as_function typed
|
@ -4,6 +4,7 @@
|
|||||||
(libraries
|
(libraries
|
||||||
run
|
run
|
||||||
compile
|
compile
|
||||||
|
uncompile
|
||||||
)
|
)
|
||||||
(preprocess
|
(preprocess
|
||||||
(pps ppx_let)
|
(pps ppx_let)
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
module Run = Run
|
module Run = Run
|
||||||
module Compile = Compile
|
module Compile = Compile
|
||||||
|
module Uncompile = Uncompile
|
||||||
module Display = Display
|
module Display = Display
|
||||||
|
@ -6,6 +6,38 @@ open Memory_proto_alpha.X
|
|||||||
|
|
||||||
type options = Memory_proto_alpha.options
|
type options = Memory_proto_alpha.options
|
||||||
|
|
||||||
|
type dry_run_options =
|
||||||
|
{ amount : string ;
|
||||||
|
sender : string option ;
|
||||||
|
source : string option }
|
||||||
|
|
||||||
|
let make_dry_run_options (opts : dry_run_options) : options result =
|
||||||
|
let open Proto_alpha_utils.Trace in
|
||||||
|
let open Proto_alpha_utils.Memory_proto_alpha in
|
||||||
|
let open Protocol.Alpha_context in
|
||||||
|
let%bind amount = match Tez.of_string opts.amount with
|
||||||
|
| None -> simple_fail "invalid amount"
|
||||||
|
| Some amount -> ok amount in
|
||||||
|
let%bind sender =
|
||||||
|
match opts.sender with
|
||||||
|
| None -> ok None
|
||||||
|
| Some sender ->
|
||||||
|
let%bind sender =
|
||||||
|
trace_alpha_tzresult
|
||||||
|
(simple_error "invalid address")
|
||||||
|
(Contract.of_b58check sender) in
|
||||||
|
ok (Some sender) in
|
||||||
|
let%bind source =
|
||||||
|
match opts.source with
|
||||||
|
| None -> ok None
|
||||||
|
| Some source ->
|
||||||
|
let%bind source =
|
||||||
|
trace_alpha_tzresult
|
||||||
|
(simple_error "invalid source address")
|
||||||
|
(Contract.of_b58check source) in
|
||||||
|
ok (Some source) in
|
||||||
|
ok @@ make_options ~amount ?source:sender ?payer:source ()
|
||||||
|
|
||||||
let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
|
let run ?options (* ?(is_input_value = false) *) (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result =
|
||||||
let Compiler.Program.{input;output;body} : compiled_program = program in
|
let Compiler.Program.{input;output;body} : compiled_program = program in
|
||||||
let (Ex_ty input_ty) = input in
|
let (Ex_ty input_ty) = input in
|
||||||
|
@ -1,41 +0,0 @@
|
|||||||
open Proto_alpha_utils
|
|
||||||
open Memory_proto_alpha.X
|
|
||||||
open Trace
|
|
||||||
open Mini_c
|
|
||||||
open! Compiler.Program
|
|
||||||
|
|
||||||
module Errors = struct
|
|
||||||
|
|
||||||
let entry_error =
|
|
||||||
simple_error "error translating entry point"
|
|
||||||
|
|
||||||
end
|
|
||||||
|
|
||||||
type options = {
|
|
||||||
entry_point : anon_function ;
|
|
||||||
input_type : type_value ;
|
|
||||||
output_type : type_value ;
|
|
||||||
input : value ;
|
|
||||||
michelson_options : Of_michelson.options ;
|
|
||||||
}
|
|
||||||
|
|
||||||
let evaluate ?options expression =
|
|
||||||
let%bind code = Compile.Of_mini_c.compile_expression_as_function expression in
|
|
||||||
let%bind ex_ty_value = Of_michelson.evaluate ?options code in
|
|
||||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
|
||||||
|
|
||||||
let evaluate_entry ?options program entry =
|
|
||||||
let%bind code = Compile.Of_mini_c.compile_expression_as_function_entry program entry in
|
|
||||||
let%bind ex_ty_value = Of_michelson.evaluate ?options code in
|
|
||||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
|
||||||
|
|
||||||
let run_function_entry ?options program entry input =
|
|
||||||
let%bind code = Compile.Of_mini_c.compile_function_entry program entry in
|
|
||||||
let%bind input_michelson =
|
|
||||||
let%bind code = Compile.Of_mini_c.compile_expression_as_function input in
|
|
||||||
let%bind (Ex_typed_value (ty , value)) = Of_michelson.evaluate ?options code in
|
|
||||||
Trace.trace_tzresult_lwt (simple_error "error unparsing input") @@
|
|
||||||
Memory_proto_alpha.unparse_michelson_data ty value
|
|
||||||
in
|
|
||||||
let%bind ex_ty_value = Of_michelson.run ?options code input_michelson in
|
|
||||||
Compile.Of_mini_c.uncompile_value ex_ty_value
|
|
@ -1,45 +0,0 @@
|
|||||||
open Trace
|
|
||||||
open Ast_simplified
|
|
||||||
|
|
||||||
let compile_expression ?env ~state expr = (* TODO: state optional *)
|
|
||||||
let%bind code = Compile.Of_simplified.compile_expression_as_function ?env ~state expr in
|
|
||||||
Of_michelson.evaluate_michelson code
|
|
||||||
|
|
||||||
let run_typed_program (* TODO: this runs an *untyped* program, not a typed one. *)
|
|
||||||
?options
|
|
||||||
(program : Ast_typed.program) (state : Typer.Solver.state) (entry : string)
|
|
||||||
(input : expression) : expression result =
|
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry in
|
|
||||||
let%bind input =
|
|
||||||
let env = Ast_typed.program_environment program in
|
|
||||||
compile_expression ~env ~state input
|
|
||||||
in
|
|
||||||
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
|
||||||
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value
|
|
||||||
|
|
||||||
let run_failwith_program
|
|
||||||
?options
|
|
||||||
(program : Ast_typed.program) (state : Typer.Solver.state) (entry : string)
|
|
||||||
(input : expression) : Of_michelson.failwith_res result =
|
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry in
|
|
||||||
let%bind input =
|
|
||||||
let env = Ast_typed.program_environment program in
|
|
||||||
compile_expression ~env ~state input
|
|
||||||
in
|
|
||||||
Of_michelson.get_exec_error ?options code input
|
|
||||||
|
|
||||||
let evaluate_typed_program_entry
|
|
||||||
?options
|
|
||||||
(program : Ast_typed.program) (entry : string)
|
|
||||||
: Ast_simplified.expression result =
|
|
||||||
let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in
|
|
||||||
let%bind ex_ty_value = Of_michelson.evaluate ?options code in
|
|
||||||
Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry ex_ty_value
|
|
||||||
|
|
||||||
let compile_program
|
|
||||||
?options
|
|
||||||
(program : Ast_typed.program) (entry : string)
|
|
||||||
: unit result =
|
|
||||||
let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in
|
|
||||||
let%bind _ex_ty_value = Of_michelson.evaluate ?options code in
|
|
||||||
ok ()
|
|
@ -1,151 +0,0 @@
|
|||||||
open Trace
|
|
||||||
|
|
||||||
include struct
|
|
||||||
open Ast_simplified
|
|
||||||
|
|
||||||
let assert_entry_point_defined : program -> string -> unit result =
|
|
||||||
fun program entry_point ->
|
|
||||||
let aux : declaration -> bool = fun declaration ->
|
|
||||||
match declaration with
|
|
||||||
| Declaration_type _ -> false
|
|
||||||
| Declaration_constant (name , _ , _) -> name = entry_point
|
|
||||||
in
|
|
||||||
trace_strong (simple_error "no entry-point with given name") @@
|
|
||||||
Assert.assert_true @@ List.exists aux @@ List.map Location.unwrap program
|
|
||||||
end
|
|
||||||
|
|
||||||
include struct
|
|
||||||
open Ast_typed
|
|
||||||
open Combinators
|
|
||||||
|
|
||||||
let get_entry_point_type : type_value -> (type_value * type_value) result = fun t ->
|
|
||||||
let%bind (arg , result) =
|
|
||||||
trace_strong (simple_error "entry-point doesn't have a function type") @@
|
|
||||||
get_t_function t in
|
|
||||||
let%bind (arg' , storage_param) =
|
|
||||||
trace_strong (simple_error "entry-point doesn't have 2 parameters") @@
|
|
||||||
get_t_pair arg in
|
|
||||||
let%bind (ops , storage_result) =
|
|
||||||
trace_strong (simple_error "entry-point doesn't have 2 results") @@
|
|
||||||
get_t_pair result in
|
|
||||||
let%bind () =
|
|
||||||
trace_strong (simple_error "entry-point doesn't have a list of operation as first result") @@
|
|
||||||
assert_t_list_operation ops in
|
|
||||||
let%bind () =
|
|
||||||
trace_strong (simple_error "entry-point doesn't identical type (storage) for second parameter and second result") @@
|
|
||||||
assert_type_value_eq (storage_param , storage_result) in
|
|
||||||
ok (arg' , storage_param)
|
|
||||||
|
|
||||||
let get_entry_point : program -> string -> (type_value * type_value) result = fun p e ->
|
|
||||||
let%bind declaration = get_declaration_by_name p e in
|
|
||||||
match declaration with
|
|
||||||
| Declaration_constant (d , _) -> get_entry_point_type d.annotated_expression.type_annotation
|
|
||||||
|
|
||||||
let assert_valid_entry_point = fun p e ->
|
|
||||||
let%bind _ = get_entry_point p e in
|
|
||||||
ok ()
|
|
||||||
end
|
|
||||||
|
|
||||||
(* open Tezos_utils *)
|
|
||||||
|
|
||||||
let compile_file_contract_parameter : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
|
|
||||||
fun source_filename _entry_point expression syntax ->
|
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
|
||||||
let env = Ast_typed.program_environment program in
|
|
||||||
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
|
||||||
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
|
||||||
Of_simplified.compile_expression simplified ~env ~state
|
|
||||||
|
|
||||||
let compile_file_expression : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
|
|
||||||
fun source_filename _entry_point expression syntax ->
|
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
|
||||||
let env = Ast_typed.program_environment program in
|
|
||||||
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
|
||||||
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
|
||||||
Of_simplified.compile_expression simplified ~env ~state
|
|
||||||
|
|
||||||
let compile_expression : string -> Typer.Solver.state -> Compile.Helpers.s_syntax -> Michelson.t result =
|
|
||||||
fun expression state syntax ->
|
|
||||||
let%bind syntax = Compile.Helpers.syntax_to_variant syntax None in
|
|
||||||
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
|
||||||
Of_simplified.compile_expression ~state simplified
|
|
||||||
|
|
||||||
let compile_file_contract_storage : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result =
|
|
||||||
fun source_filename _entry_point expression syntax ->
|
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
|
||||||
let env = Ast_typed.program_environment program in
|
|
||||||
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
|
||||||
let%bind simplified = Compile.Helpers.parsify_expression syntax expression in
|
|
||||||
Of_simplified.compile_expression simplified ~env ~state
|
|
||||||
|
|
||||||
let compile_file_contract_args =
|
|
||||||
fun source_filename _entry_point storage parameter syntax ->
|
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
|
||||||
let env = Ast_typed.program_environment program in
|
|
||||||
let%bind syntax = Compile.Helpers.syntax_to_variant syntax (Some source_filename) in
|
|
||||||
let%bind storage_simplified = Compile.Helpers.parsify_expression syntax storage in
|
|
||||||
let%bind parameter_simplified = Compile.Helpers.parsify_expression syntax parameter in
|
|
||||||
let args = Ast_simplified.e_pair storage_simplified parameter_simplified in
|
|
||||||
Of_simplified.compile_expression args ~env ~state
|
|
||||||
|
|
||||||
type dry_run_options =
|
|
||||||
{ amount : string ;
|
|
||||||
sender : string option ;
|
|
||||||
source : string option }
|
|
||||||
|
|
||||||
let make_dry_run_options (opts : dry_run_options) : Of_michelson.options result =
|
|
||||||
let open Proto_alpha_utils.Trace in
|
|
||||||
let open Proto_alpha_utils.Memory_proto_alpha in
|
|
||||||
let open Protocol.Alpha_context in
|
|
||||||
let%bind amount = match Tez.of_string opts.amount with
|
|
||||||
| None -> simple_fail "invalid amount"
|
|
||||||
| Some amount -> ok amount in
|
|
||||||
let%bind sender =
|
|
||||||
match opts.sender with
|
|
||||||
| None -> ok None
|
|
||||||
| Some sender ->
|
|
||||||
let%bind sender =
|
|
||||||
trace_alpha_tzresult
|
|
||||||
(simple_error "invalid address")
|
|
||||||
(Contract.of_b58check sender) in
|
|
||||||
ok (Some sender) in
|
|
||||||
let%bind source =
|
|
||||||
match opts.source with
|
|
||||||
| None -> ok None
|
|
||||||
| Some source ->
|
|
||||||
let%bind source =
|
|
||||||
trace_alpha_tzresult
|
|
||||||
(simple_error "invalid source address")
|
|
||||||
(Contract.of_b58check source) in
|
|
||||||
ok (Some source) in
|
|
||||||
ok @@ make_options ~amount ?source:sender ?payer:source ()
|
|
||||||
|
|
||||||
let run_contract ~options source_filename entry_point storage parameter syntax =
|
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
|
||||||
let () = Typer.Solver.discard_state state in
|
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
|
|
||||||
let%bind args = compile_file_contract_args source_filename entry_point storage parameter syntax in
|
|
||||||
let%bind options = make_dry_run_options options in
|
|
||||||
let%bind ex_value_ty = Of_michelson.run ~options code args in
|
|
||||||
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
|
|
||||||
|
|
||||||
let run_function_entry ~options source_filename entry_point input syntax =
|
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
|
||||||
let () = Typer.Solver.discard_state state in
|
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry_point in
|
|
||||||
let%bind args = compile_file_expression source_filename entry_point input syntax in
|
|
||||||
let%bind options = make_dry_run_options options in
|
|
||||||
let%bind ex_value_ty = Of_michelson.run ~options code args in
|
|
||||||
Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry_point ex_value_ty
|
|
||||||
|
|
||||||
let evaluate_entry ~options source_filename entry_point syntax =
|
|
||||||
let%bind (program , state) = Compile.Of_source.type_file syntax source_filename in
|
|
||||||
let () = Typer.Solver.discard_state state in
|
|
||||||
let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry_point in
|
|
||||||
let%bind options = make_dry_run_options options in
|
|
||||||
let%bind ex_value_ty = Of_michelson.evaluate ~options code in
|
|
||||||
Compile.Of_simplified.uncompile_typed_program_entry_expression_result program entry_point ex_value_ty
|
|
||||||
|
|
||||||
let evaluate_michelson expression syntax =
|
|
||||||
let%bind code = Compile.Of_source.compile_expression_as_function expression syntax in
|
|
||||||
Of_michelson.evaluate_michelson code
|
|
@ -1,36 +0,0 @@
|
|||||||
open Trace
|
|
||||||
open Ast_typed
|
|
||||||
|
|
||||||
let compile_expression expr =
|
|
||||||
let%bind code = Compile.Of_typed.compile_expression_as_function expr in
|
|
||||||
Of_michelson.evaluate_michelson code
|
|
||||||
|
|
||||||
let run_function ?options f input =
|
|
||||||
let%bind code = Compile.Of_typed.compile_function f in
|
|
||||||
let%bind input = compile_expression input in
|
|
||||||
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
|
||||||
let%bind ty =
|
|
||||||
let%bind (_ , output_ty) = get_t_function f.type_annotation in
|
|
||||||
ok output_ty
|
|
||||||
in
|
|
||||||
Compile.Of_typed.uncompile_value ex_ty_value ty
|
|
||||||
|
|
||||||
let run_entry
|
|
||||||
?options (entry : string)
|
|
||||||
(program : Ast_typed.program) (input : Ast_typed.annotated_expression) : Ast_typed.annotated_expression result =
|
|
||||||
let%bind code = Compile.Of_typed.compile_function_entry program entry in
|
|
||||||
let%bind input =
|
|
||||||
compile_expression input
|
|
||||||
in
|
|
||||||
let%bind ex_ty_value = Of_michelson.run ?options code input in
|
|
||||||
Compile.Of_typed.uncompile_entry_function_result program entry ex_ty_value
|
|
||||||
|
|
||||||
let evaluate ?options (e : annotated_expression) : annotated_expression result =
|
|
||||||
let%bind code = Compile.Of_typed.compile_expression_as_function e in
|
|
||||||
let%bind ex_ty_value = Of_michelson.evaluate ?options code in
|
|
||||||
Compile.Of_typed.uncompile_value ex_ty_value e.type_annotation
|
|
||||||
|
|
||||||
let evaluate_entry ?options program entry =
|
|
||||||
let%bind code = Compile.Of_typed.compile_expression_as_function_entry program entry in
|
|
||||||
let%bind ex_ty_value = Of_michelson.evaluate ?options code in
|
|
||||||
Compile.Of_typed.uncompile_entry_expression_result program entry ex_ty_value
|
|
@ -1,5 +1 @@
|
|||||||
module Of_source = Of_source
|
|
||||||
module Of_typed = Of_typed
|
|
||||||
module Of_simplified = Of_simplified
|
|
||||||
module Of_mini_c = Of_mini_c
|
|
||||||
module Of_michelson = Of_michelson
|
module Of_michelson = Of_michelson
|
||||||
|
17
src/main/uncompile/dune
Normal file
17
src/main/uncompile/dune
Normal file
@ -0,0 +1,17 @@
|
|||||||
|
(library
|
||||||
|
(name uncompile)
|
||||||
|
(public_name ligo.uncompile)
|
||||||
|
(libraries
|
||||||
|
simple-utils
|
||||||
|
compiler
|
||||||
|
typer_new
|
||||||
|
typer
|
||||||
|
ast_typed
|
||||||
|
mini_c
|
||||||
|
transpiler
|
||||||
|
)
|
||||||
|
(preprocess
|
||||||
|
(pps ppx_let)
|
||||||
|
)
|
||||||
|
(flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Tezos_utils ))
|
||||||
|
)
|
19
src/main/uncompile/uncompile.ml
Normal file
19
src/main/uncompile/uncompile.ml
Normal file
@ -0,0 +1,19 @@
|
|||||||
|
open Trace
|
||||||
|
|
||||||
|
type ret_type = Function | Expression
|
||||||
|
let uncompile_value func_or_expr program entry ex_ty_value =
|
||||||
|
let%bind entry_expression = Ast_typed.get_entry program entry in
|
||||||
|
let%bind output_type = match func_or_expr with
|
||||||
|
| Expression -> ok entry_expression.type_annotation
|
||||||
|
| Function ->
|
||||||
|
let%bind (_,output_type) = Ast_typed.get_t_function entry_expression.type_annotation in
|
||||||
|
ok output_type in
|
||||||
|
let%bind mini_c = Compiler.Uncompiler.translate_value ex_ty_value in
|
||||||
|
let%bind typed = Transpiler.untranspile mini_c output_type in
|
||||||
|
Typer.untype_expression typed
|
||||||
|
|
||||||
|
let uncompile_typed_program_entry_expression_result program entry ex_ty_value =
|
||||||
|
uncompile_value Expression program entry ex_ty_value
|
||||||
|
|
||||||
|
let uncompile_typed_program_entry_function_result program entry ex_ty_value =
|
||||||
|
uncompile_value Function program entry ex_ty_value
|
@ -1,12 +0,0 @@
|
|||||||
open Trace
|
|
||||||
open Test_helpers
|
|
||||||
|
|
||||||
let compile_contract_basic () : unit result =
|
|
||||||
let%bind _ =
|
|
||||||
Ligo.Compile.Of_source.compile_file_entry "./contracts/dispatch-counter.ligo" "main" (Syntax_name "pascaligo")
|
|
||||||
in
|
|
||||||
ok ()
|
|
||||||
|
|
||||||
let main = test_suite "Bin" [
|
|
||||||
test "compile contract basic" compile_contract_basic ;
|
|
||||||
]
|
|
@ -3,7 +3,9 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Test_helpers
|
open Test_helpers
|
||||||
|
|
||||||
let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo")
|
let type_file f =
|
||||||
|
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in
|
||||||
|
ok @@ (typed,state)
|
||||||
|
|
||||||
let get_program =
|
let get_program =
|
||||||
let s = ref None in
|
let s = ref None in
|
||||||
|
@ -1,7 +1,9 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Test_helpers
|
open Test_helpers
|
||||||
|
|
||||||
let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo")
|
let type_file f =
|
||||||
|
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in
|
||||||
|
ok @@ (typed,state)
|
||||||
|
|
||||||
let get_program =
|
let get_program =
|
||||||
let s = ref None in
|
let s = ref None in
|
||||||
@ -45,7 +47,18 @@ let dummy n =
|
|||||||
@@ range (n + 1)
|
@@ range (n + 1)
|
||||||
)
|
)
|
||||||
|
|
||||||
let run_typed = Run.Of_typed.run_entry
|
let run_typed (entry_point:string) (program:Ast_typed.program) (input:Ast_typed.annotated_expression) =
|
||||||
|
let%bind program_mich = Compile.Wrapper.typed_to_michelson_program program entry_point in
|
||||||
|
let%bind input_mich = Compile.Wrapper.typed_expression_to_michelson_value_as_function input in
|
||||||
|
let%bind input_eval = Run.Of_michelson.evaluate_michelson input_mich in
|
||||||
|
let%bind res = Run.Of_michelson.run program_mich input_eval in
|
||||||
|
let%bind output_type =
|
||||||
|
let%bind entry_expression = Ast_typed.get_entry program entry_point in
|
||||||
|
let%bind (_ , output_type) = Ast_typed.get_t_function entry_expression.type_annotation in
|
||||||
|
ok output_type
|
||||||
|
in
|
||||||
|
let%bind mini_c = Compiler.Uncompiler.translate_value res in
|
||||||
|
Transpiler.untranspile mini_c output_type
|
||||||
|
|
||||||
let is_empty () : unit result =
|
let is_empty () : unit result =
|
||||||
let%bind program = get_program () in
|
let%bind program = get_program () in
|
||||||
|
@ -3,12 +3,12 @@ open Test_helpers
|
|||||||
|
|
||||||
open Ast_simplified.Combinators
|
open Ast_simplified.Combinators
|
||||||
|
|
||||||
let mtype_file ?debug_simplify ?debug_typed f =
|
let mtype_file f =
|
||||||
let%bind (typed , state) = Ligo.Compile.Of_source.type_file ?debug_simplify ?debug_typed (Syntax_name "cameligo") f in
|
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "cameligo") f in
|
||||||
let () = Typer.Solver.discard_state state in
|
let () = Typer.Solver.discard_state state in
|
||||||
ok typed
|
ok typed
|
||||||
let type_file f =
|
let type_file f =
|
||||||
let%bind (typed , state) = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo") f in
|
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in
|
||||||
let () = Typer.Solver.discard_state state in
|
let () = Typer.Solver.discard_state state in
|
||||||
ok typed
|
ok typed
|
||||||
|
|
||||||
@ -323,9 +323,9 @@ let bytes_arithmetic () : unit result =
|
|||||||
let%bind () = expect_eq program "slice_op" tata at in
|
let%bind () = expect_eq program "slice_op" tata at in
|
||||||
let%bind () = expect_fail program "slice_op" foo in
|
let%bind () = expect_fail program "slice_op" foo in
|
||||||
let%bind () = expect_fail program "slice_op" ba in
|
let%bind () = expect_fail program "slice_op" ba in
|
||||||
let%bind b1 = Run.Of_simplified.run_typed_program program Typer.Solver.initial_state "hasherman" foo in
|
let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foo in
|
||||||
let%bind () = expect_eq program "hasherman" foo b1 in
|
let%bind () = expect_eq program "hasherman" foo b1 in
|
||||||
let%bind b3 = Run.Of_simplified.run_typed_program program Typer.Solver.initial_state "hasherman" foototo in
|
let%bind b3 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foototo in
|
||||||
let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in
|
let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
@ -343,9 +343,9 @@ let bytes_arithmetic_mligo () : unit result =
|
|||||||
let%bind () = expect_eq program "slice_op" tata at in
|
let%bind () = expect_eq program "slice_op" tata at in
|
||||||
let%bind () = expect_fail program "slice_op" foo in
|
let%bind () = expect_fail program "slice_op" foo in
|
||||||
let%bind () = expect_fail program "slice_op" ba in
|
let%bind () = expect_fail program "slice_op" ba in
|
||||||
let%bind b1 = Run.Of_simplified.run_typed_program program Typer.Solver.initial_state "hasherman" foo in
|
let%bind b1 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foo in
|
||||||
let%bind () = expect_eq program "hasherman" foo b1 in
|
let%bind () = expect_eq program "hasherman" foo b1 in
|
||||||
let%bind b3 = Run.Of_simplified.run_typed_program program Typer.Solver.initial_state "hasherman" foototo in
|
let%bind b3 = Test_helpers.run_typed_program_with_simplified_input program "hasherman" foototo in
|
||||||
let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in
|
let%bind () = Assert.assert_fail @@ Ast_simplified.Misc.assert_value_eq (b3 , b1) in
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
@ -1054,9 +1054,7 @@ let guess_string_mligo () : unit result =
|
|||||||
|
|
||||||
let basic_mligo () : unit result =
|
let basic_mligo () : unit result =
|
||||||
let%bind typed = mtype_file "./contracts/basic.mligo" in
|
let%bind typed = mtype_file "./contracts/basic.mligo" in
|
||||||
let%bind result = Run.Of_typed.evaluate_entry typed "foo" in
|
expect_eq_evaluate typed "foo" (e_int (42+127))
|
||||||
Ast_typed.assert_value_eq
|
|
||||||
(Ast_typed.Combinators.e_a_empty_int (42 + 127), result)
|
|
||||||
|
|
||||||
let counter_mligo () : unit result =
|
let counter_mligo () : unit result =
|
||||||
let%bind program = mtype_file "./contracts/counter.mligo" in
|
let%bind program = mtype_file "./contracts/counter.mligo" in
|
||||||
|
@ -1,7 +1,9 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Test_helpers
|
open Test_helpers
|
||||||
|
|
||||||
let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo")
|
let type_file f =
|
||||||
|
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in
|
||||||
|
ok @@ (typed,state)
|
||||||
|
|
||||||
let get_program =
|
let get_program =
|
||||||
let s = ref None in
|
let s = ref None in
|
||||||
@ -15,9 +17,8 @@ let get_program =
|
|||||||
|
|
||||||
let compile_main () =
|
let compile_main () =
|
||||||
let%bind program,_ = get_program () in
|
let%bind program,_ = get_program () in
|
||||||
let%bind () =
|
let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in
|
||||||
Ligo.Run.Of_simplified.compile_program
|
let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson in
|
||||||
program "main" in
|
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
open Ast_simplified
|
open Ast_simplified
|
||||||
|
@ -1,7 +1,9 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Test_helpers
|
open Test_helpers
|
||||||
|
|
||||||
let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "pascaligo")
|
let type_file f =
|
||||||
|
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "pascaligo") f in
|
||||||
|
ok @@ (typed,state)
|
||||||
|
|
||||||
let get_program =
|
let get_program =
|
||||||
let s = ref None in
|
let s = ref None in
|
||||||
@ -15,9 +17,8 @@ let get_program =
|
|||||||
|
|
||||||
let compile_main () =
|
let compile_main () =
|
||||||
let%bind program,_ = get_program () in
|
let%bind program,_ = get_program () in
|
||||||
let%bind () =
|
let%bind michelson = Compile.Wrapper.typed_to_michelson_value_as_function program "main" in
|
||||||
Ligo.Run.Of_simplified.compile_program
|
let%bind _ex_ty_value = Ligo.Run.Of_michelson.evaluate michelson in
|
||||||
program "main" in
|
|
||||||
ok ()
|
ok ()
|
||||||
|
|
||||||
open Ast_simplified
|
open Ast_simplified
|
||||||
|
@ -11,7 +11,6 @@ let () =
|
|||||||
Heap_tests.main ;
|
Heap_tests.main ;
|
||||||
Coase_tests.main ;
|
Coase_tests.main ;
|
||||||
Vote_tests.main ;
|
Vote_tests.main ;
|
||||||
Bin_tests.main ;
|
|
||||||
Multisig_tests.main ;
|
Multisig_tests.main ;
|
||||||
Multisig_v2_tests.main ;
|
Multisig_v2_tests.main ;
|
||||||
] ;
|
] ;
|
||||||
|
@ -35,7 +35,7 @@ open Ast_simplified
|
|||||||
let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result =
|
let pack_payload (program:Ast_typed.program) (payload:expression) : bytes result =
|
||||||
let%bind code =
|
let%bind code =
|
||||||
let env = Ast_typed.program_environment program in
|
let env = Ast_typed.program_environment program in
|
||||||
Compile.Of_simplified.compile_expression_as_function
|
Compile.Wrapper.simplified_to_compiled_program
|
||||||
~env ~state:(Typer.Solver.initial_state) payload in
|
~env ~state:(Typer.Solver.initial_state) payload in
|
||||||
let Compiler.Program.{input=_;output=(Ex_ty payload_ty);body=_} = code in
|
let Compiler.Program.{input=_;output=(Ex_ty payload_ty);body=_} = code in
|
||||||
let%bind (payload: Tezos_utils.Michelson.michelson) =
|
let%bind (payload: Tezos_utils.Michelson.michelson) =
|
||||||
@ -76,14 +76,41 @@ let sha_256_hash pl =
|
|||||||
|
|
||||||
open Ast_simplified.Combinators
|
open Ast_simplified.Combinators
|
||||||
|
|
||||||
|
let run_typed_program_with_simplified_input ?options
|
||||||
|
(program: Ast_typed.program) (entry_point: string)
|
||||||
|
(input: Ast_simplified.expression) : Ast_simplified.expression result =
|
||||||
|
let env = Ast_typed.program_environment program in
|
||||||
|
let%bind michelson_exp = Compile.Wrapper.simplified_to_compiled_program ~env ~state:(Typer.Solver.initial_state) input in
|
||||||
|
let%bind evaluated_exp = Ligo.Run.Of_michelson.evaluate_michelson michelson_exp in
|
||||||
|
let%bind michelson_program = Compile.Wrapper.typed_to_michelson_program program entry_point in
|
||||||
|
let%bind michelson_output = Ligo.Run.Of_michelson.run ?options michelson_program evaluated_exp in
|
||||||
|
Uncompile.uncompile_typed_program_entry_function_result program entry_point michelson_output
|
||||||
|
|
||||||
|
let expect_fail_typed_program_with_simplified_input ?options
|
||||||
|
(program: Ast_typed.program) (entry_point: string)
|
||||||
|
(input: Ast_simplified.expression) : Ligo.Run.Of_michelson.failwith_res Simple_utils__Trace.result =
|
||||||
|
let env = Ast_typed.program_environment program in
|
||||||
|
let%bind michelson_exp = Compile.Wrapper.simplified_to_compiled_program ~env ~state:(Typer.Solver.initial_state) input in
|
||||||
|
let%bind evaluated_exp = Ligo.Run.Of_michelson.evaluate_michelson michelson_exp in
|
||||||
|
let%bind michelson_program = Compile.Wrapper.typed_to_michelson_program program entry_point in
|
||||||
|
Ligo.Run.Of_michelson.get_exec_error ?options michelson_program evaluated_exp
|
||||||
|
|
||||||
|
let run_typed_value_as_function
|
||||||
|
(program: Ast_typed.program) (entry_point:string) : Ast_simplified.expression result =
|
||||||
|
let%bind michelson_value_as_f = Compile.Wrapper.typed_to_michelson_value_as_function program entry_point in
|
||||||
|
let%bind result = Ligo.Run.Of_michelson.evaluate michelson_value_as_f in
|
||||||
|
Uncompile.uncompile_typed_program_entry_expression_result program entry_point result
|
||||||
|
|
||||||
let expect ?options program entry_point input expecter =
|
let expect ?options program entry_point input expecter =
|
||||||
let%bind result =
|
let%bind result =
|
||||||
let run_error =
|
let run_error =
|
||||||
let title () = "expect run" in
|
let title () = "expect run" in
|
||||||
let content () = Format.asprintf "Entry_point: %s" entry_point in
|
let content () = Format.asprintf "Entry_point: %s" entry_point in
|
||||||
error title content in
|
error title content
|
||||||
|
in
|
||||||
trace run_error @@
|
trace run_error @@
|
||||||
Ligo.Run.Of_simplified.run_typed_program ?options program Typer.Solver.initial_state entry_point input in
|
run_typed_program_with_simplified_input ?options program entry_point input in
|
||||||
|
|
||||||
expecter result
|
expecter result
|
||||||
|
|
||||||
let expect_fail ?options program entry_point input =
|
let expect_fail ?options program entry_point input =
|
||||||
@ -93,12 +120,11 @@ let expect_fail ?options program entry_point input =
|
|||||||
error title content
|
error title content
|
||||||
in
|
in
|
||||||
trace run_error @@
|
trace run_error @@
|
||||||
Assert.assert_fail
|
Assert.assert_fail @@
|
||||||
@@ Ligo.Run.Of_simplified.run_typed_program ?options program Typer.Solver.initial_state entry_point input
|
run_typed_program_with_simplified_input ?options program entry_point input
|
||||||
|
|
||||||
let expect_string_failwith ?options program entry_point input expected_failwith =
|
let expect_string_failwith ?options program entry_point input expected_failwith =
|
||||||
let%bind err = Ligo.Run.Of_simplified.run_failwith_program
|
let%bind err = expect_fail_typed_program_with_simplified_input ?options program entry_point input in
|
||||||
?options program Typer.Solver.initial_state entry_point input in
|
|
||||||
match err with
|
match err with
|
||||||
| Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s
|
| Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s
|
||||||
| _ -> simple_fail "Expected to fail with a string"
|
| _ -> simple_fail "Expected to fail with a string"
|
||||||
@ -121,7 +147,7 @@ let expect_evaluate program entry_point expecter =
|
|||||||
let content () = Format.asprintf "Entry_point: %s" entry_point in
|
let content () = Format.asprintf "Entry_point: %s" entry_point in
|
||||||
error title content in
|
error title content in
|
||||||
trace error @@
|
trace error @@
|
||||||
let%bind result = Ligo.Run.Of_simplified.evaluate_typed_program_entry program entry_point in
|
let%bind result = run_typed_value_as_function program entry_point in
|
||||||
expecter result
|
expecter result
|
||||||
|
|
||||||
let expect_eq_evaluate program entry_point expected =
|
let expect_eq_evaluate program entry_point expected =
|
||||||
|
@ -1,7 +1,9 @@
|
|||||||
open Trace
|
open Trace
|
||||||
open Test_helpers
|
open Test_helpers
|
||||||
|
|
||||||
let type_file = Ligo.Compile.Of_source.type_file (Syntax_name "cameligo")
|
let type_file f =
|
||||||
|
let%bind (typed , state , _env) = Ligo.Compile.Wrapper.source_to_typed (Syntax_name "cameligo") f in
|
||||||
|
ok @@ (typed,state)
|
||||||
|
|
||||||
let get_program =
|
let get_program =
|
||||||
let s = ref None in
|
let s = ref None in
|
||||||
@ -39,8 +41,8 @@ let vote str =
|
|||||||
e_constructor "Vote" vote
|
e_constructor "Vote" vote
|
||||||
|
|
||||||
let init_vote () =
|
let init_vote () =
|
||||||
let%bind (program , state) = get_program () in
|
let%bind (program , _) = get_program () in
|
||||||
let%bind result = Ligo.Run.Of_simplified.run_typed_program program state "main" (e_pair (vote "Yes") (init_storage "basic")) in
|
let%bind result = Test_helpers.run_typed_program_with_simplified_input program "main" (e_pair (vote "Yes") (init_storage "basic")) in
|
||||||
let%bind (_ , storage) = extract_pair result in
|
let%bind (_ , storage) = extract_pair result in
|
||||||
let%bind storage' = extract_record storage in
|
let%bind storage' = extract_record storage in
|
||||||
let votes = List.assoc "candidates" storage' in
|
let votes = List.assoc "candidates" storage' in
|
||||||
|
Loading…
Reference in New Issue
Block a user