diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 47aac3cd9..3ca3d2bf3 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -103,7 +103,7 @@ let compile_storage = toplevel ~display_format @@ let%bind value = trace (simple_error "compile-storage") @@ - Ligo.Compile.Of_source.compile_file_contract_storage ~bigmap source entry_point expression (Syntax_name syntax) in + Ligo.Compile.Of_source.compile_file_contract_storage ~value:bigmap source entry_point expression (Syntax_name syntax) in ok @@ Format.asprintf "%a\n" Tezos_utils.Michelson.pp value in let term = @@ -116,7 +116,7 @@ let dry_run = let f source entry_point storage input amount syntax display_format bigmap = toplevel ~display_format @@ let%bind output = - Ligo.Run.Of_source.run_contract ~amount ~bigmap source entry_point storage input (Syntax_name syntax) in + Ligo.Run.Of_source.run_contract ~amount ~storage_value:bigmap source entry_point storage input (Syntax_name syntax) in ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output in let term = diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 5a1ff886e..34d8cd753 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -5,8 +5,16 @@ open Tezos_utils let compile_value : value -> type_value -> Michelson.t result = Compiler.Program.translate_value -let compile_expression : expression -> _ result = fun e -> - Compiler.Program.translate_expression e Compiler.Environment.empty +let compile_expression ?(value = false) : expression -> _ result = fun e -> + if value then ( + let%bind value = expression_to_value e in + Format.printf "Compile to value\n" ; + let%bind result = compile_value value e.type_value in + Format.printf "Compiled to value\n" ; + ok result + ) else ( + Compiler.Program.translate_expression e Compiler.Environment.empty + ) let compile_expression_as_function : expression -> _ result = fun e -> let (input , output) = t_unit , e.type_value in diff --git a/src/main/compile/of_source.ml b/src/main/compile/of_source.ml index 169dba0da..42c6adf91 100644 --- a/src/main/compile/of_source.ml +++ b/src/main/compile/of_source.ml @@ -30,19 +30,19 @@ let compile_file_expression : string -> string -> string -> s_syntax -> Michelso let%bind simplified = parsify_expression syntax expression in Of_simplified.compile_expression simplified -let compile_file_contract_storage : string -> string -> string -> s_syntax -> Michelson.t result = +let compile_file_contract_storage ~value : string -> string -> string -> s_syntax -> Michelson.t result = fun source_filename _entry_point expression syntax -> let%bind syntax = syntax_to_variant syntax (Some source_filename) in let%bind simplified = parsify_expression syntax expression in - Of_simplified.compile_expression simplified + Of_simplified.compile_expression ~value simplified let compile_file_contract_args = - fun source_filename _entry_point storage parameter syntax -> + fun ?value source_filename _entry_point storage parameter syntax -> let%bind syntax = syntax_to_variant syntax (Some source_filename) in let%bind storage_simplified = parsify_expression syntax storage in let%bind parameter_simplified = parsify_expression syntax parameter in let args = Ast_simplified.e_pair storage_simplified parameter_simplified in - Of_simplified.compile_expression args + Of_simplified.compile_expression ?value args let type_file ?(debug_simplify = false) ?(debug_typed = false) syntax (source_filename:string) : Ast_typed.program result = diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index ea75960b9..e8ac1e8e7 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -4,9 +4,8 @@ open Tezos_utils let compile_expression ?(value = false) : annotated_expression -> Michelson.t result = fun e -> - let _ = value in let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in - let%bind expr = Of_mini_c.compile_expression mini_c_expression in + let%bind expr = Of_mini_c.compile_expression ~value mini_c_expression in ok expr let compile_expression_as_function : annotated_expression -> _ result = fun e -> diff --git a/src/main/run/of_simplified.ml b/src/main/run/of_simplified.ml index e0e3e1a17..9c5d830cc 100644 --- a/src/main/run/of_simplified.ml +++ b/src/main/run/of_simplified.ml @@ -15,7 +15,7 @@ let run_typed_program let env = get_final_environment program in Compile.Of_simplified.compile_expression ~env ?value:input_to_value input in - let%bind ex_ty_value = Of_michelson.run ?options code input in + let%bind ex_ty_value = Of_michelson.run ?is_input_value:input_to_value ?options code input in Compile.Of_simplified.uncompile_typed_program_entry_function_result program entry ex_ty_value let evaluate_typed_program_entry diff --git a/src/main/run/of_source.ml b/src/main/run/of_source.ml index 5bc8b421c..3014cbbb7 100644 --- a/src/main/run/of_source.ml +++ b/src/main/run/of_source.ml @@ -46,10 +46,10 @@ include struct ok () end -let run_contract ?amount source_filename entry_point storage parameter syntax = +let run_contract ?amount ?storage_value source_filename entry_point storage parameter syntax = let%bind program = Compile.Of_source.type_file syntax source_filename in let%bind code = Compile.Of_typed.compile_function_entry program entry_point in - let%bind args = Compile.Of_source.compile_file_contract_args source_filename entry_point storage parameter syntax in + let%bind args = Compile.Of_source.compile_file_contract_args ?value:storage_value source_filename entry_point storage parameter syntax in let%bind ex_value_ty = let options = let open Proto_alpha_utils.Memory_proto_alpha in diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml index c114d901d..2838298d3 100644 --- a/src/passes/8-compiler/uncompiler.ml +++ b/src/passes/8-compiler/uncompiler.ml @@ -77,10 +77,12 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result = let aux k v acc = (k, v) :: acc in let lst = Script_ir_translator.map_fold aux m.diff [] in List.rev lst in - let%bind original_big_map = + let%bind original_big_map = match bm_opt with | Some (D_big_map l) -> ok @@ l - | _ -> fail @@ simple_error "Do not have access to the original big_map" in + | _ -> ok [] + (* | _ -> fail @@ simple_error "Do not have access to the original big_map" . When does this matter? *) + in let%bind lst' = let aux orig (k, v) = let%bind k' = translate_value (Ex_typed_value (k_ty, k)) in diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index 21e049e38..60810643c 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -106,3 +106,61 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : Format.printf "Not functional: %a\n" PP.expression entry_expression ; fail @@ Errors.not_functional_main name ) + +let rec expression_to_value (exp: expression) : value result = + match exp.content with + | E_literal v -> ok @@ v + | E_constant ("map" , lst) -> + let aux el = + let%bind l = expression_to_value el in + match l with + | D_pair (a , b) -> ok @@ (a , b) + | _ -> fail @@ simple_error "??" in + let%bind lstl = bind_map_list aux lst in + ok @@ D_map lstl + | E_constant ("big_map" , lst) -> + let aux el = + let%bind l = expression_to_value el in + match l with + | D_pair (a , b) -> ok @@ (a , b) + | _ -> fail @@ simple_error "??" in + let%bind lstl = bind_map_list aux lst in + ok @@ D_big_map lstl + | E_constant ("PAIR" , fst::snd::[]) -> + let%bind fstl = expression_to_value fst in + let%bind sndl = expression_to_value snd in + ok @@ D_pair (fstl , sndl) + | E_constant ("UNIT", _) -> ok @@ D_unit + | E_constant ("UPDATE", _) -> + let rec handle_prev upd = + match upd.content with + | E_constant ("UPDATE" , [k;v;prev]) -> + begin + match v.content with + | E_constant ("SOME" , [i]) -> + let%bind kl = expression_to_value k in + let%bind il = expression_to_value i in + let%bind prevl = handle_prev prev in + ok @@ (kl,il)::prevl + | E_constant ("NONE" , []) -> + let%bind prevl = handle_prev prev in + ok @@ prevl + | _ -> failwith "UPDATE second parameter is not an option" + end + | E_make_empty_map _ -> + ok @@ [] + | _ -> failwith "Ill-constructed map" + in + begin + match exp.type_value with + | T_big_map _ -> + let%bind kvl = handle_prev exp in + ok @@ D_big_map kvl + | T_map _ -> + let%bind kvl = handle_prev exp in + ok @@ D_map kvl + | _ -> failwith "UPDATE with a non-map type_value" + end + | _ as nl -> + let expp = Format.asprintf "'%a'" PP.expression' nl in + fail @@ simple_error ("Can not convert expression "^expp^" to literal") diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index f3f49af85..639310afc 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -417,7 +417,7 @@ let big_map () : unit result = let%bind () = let make_input = fun n -> ez [(23, n) ; (42, 4)] in let make_expected = e_int in - expect_eq_n ?input_to_value:(Some true) program "gf" make_input make_expected + expect_eq_n ~input_to_value:true program "gf" make_input make_expected in let%bind () = let make_input = fun n ->