From 81c49f434278afeedc890d001694cd1510ede531 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Mon, 4 Nov 2019 17:01:39 -0600 Subject: [PATCH] Fix/simplify big_maps using Babylon --- src/bin/cli.ml | 19 ++---- src/main/compile/of_mini_c.ml | 11 ---- src/main/compile/of_simplified.ml | 12 ---- src/main/compile/of_typed.ml | 12 ---- src/main/run/of_mini_c.ml | 12 ---- src/main/run/of_simplified.ml | 20 +++---- src/main/run/of_source.ml | 12 ++-- src/main/run/of_typed.ml | 12 +--- src/passes/6-transpiler/transpiler.ml | 2 +- src/passes/7-self_mini_c/helpers.ml | 9 ++- src/passes/7-self_mini_c/self_mini_c.ml | 1 + src/passes/8-compiler/compiler_program.ml | 3 + src/passes/8-compiler/uncompiler.ml | 18 ++---- src/passes/8-compiler/uncompiler.mli | 2 +- src/stages/mini_c/PP.ml | 1 + src/stages/mini_c/mini_c.ml | 5 +- src/stages/mini_c/misc.ml | 59 +------------------ src/stages/mini_c/types.ml | 1 + src/test/compiler_tests.ml | 34 ----------- src/test/integration_tests.ml | 8 +-- src/test/test.ml | 1 - src/test/test_helpers.ml | 24 ++++---- vendors/ligo-utils/tezos-utils/x_michelson.ml | 1 + 23 files changed, 61 insertions(+), 218 deletions(-) delete mode 100644 src/test/compiler_tests.ml diff --git a/src/bin/cli.ml b/src/bin/cli.ml index 5515780a6..f3f552865 100644 --- a/src/bin/cli.ml +++ b/src/bin/cli.ml @@ -37,14 +37,6 @@ let syntax = info ~docv ~doc ["syntax" ; "s"] in value @@ opt string "auto" info -let bigmap = - let open Arg in - let info = - let docv = "BIGMAP" in - let doc = "$(docv) is necessary when your storage embeds a big_map." in - info ~docv ~doc ["bigmap"] in - value @@ flag info - let amount = let open Arg in let info = @@ -121,31 +113,30 @@ let compile_parameter = (term , Term.info ~docs cmdname) let compile_storage = - let f source_file entry_point expression syntax display_format michelson_format bigmap = + let f source_file entry_point expression syntax display_format michelson_format = toplevel ~display_format @@ let%bind value = trace (simple_error "compile-storage") @@ - Ligo.Run.Of_source.compile_file_contract_storage ~value:bigmap source_file entry_point expression (Syntax_name syntax) in + Ligo.Run.Of_source.compile_file_contract_storage source_file entry_point expression (Syntax_name syntax) in ok @@ Format.asprintf "%a\n" (Main.Display.michelson_pp michelson_format) value in let term = - Term.(const f $ source_file 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format $ michelson_code_format $ bigmap) in + Term.(const f $ source_file 0 $ entry_point 1 $ expression "STORAGE" 2 $ syntax $ display_format $ michelson_code_format) in let cmdname = "compile-storage" in let docs = "Subcommand: compile an initial storage in ligo syntax to a michelson expression. The resulting michelson expression can be passed as an argument in a transaction which originates a contract. See `ligo " ^ cmdname ^ " --help' for a list of options specific to this subcommand." in (term , Term.info ~docs cmdname) let dry_run = - let f source_file entry_point storage input amount sender source syntax display_format bigmap = + let f source_file entry_point storage input amount sender source syntax display_format = toplevel ~display_format @@ let%bind output = Ligo.Run.Of_source.run_contract ~options:{ amount ; sender ; source } - ~storage_value:bigmap source_file entry_point storage input (Syntax_name syntax) in ok @@ Format.asprintf "%a\n" Ast_simplified.PP.expression output in let term = - Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format $ bigmap) in + Term.(const f $ source_file 0 $ entry_point 1 $ expression "PARAMETER" 2 $ expression "STORAGE" 3 $ amount $ sender $ source $ syntax $ display_format) in let cmdname = "dry-run" in let docs = "Subcommand: run a smart-contract with the given storage and input." in (term , Term.info ~docs cmdname) diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index 5606adf54..d8419b435 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -2,17 +2,6 @@ open Trace open Mini_c open Tezos_utils -let compile_value : value -> type_value -> Michelson.t result = fun x a -> - let%bind body = Compiler.Program.translate_value x a in - let body = Self_michelson.optimize body in - ok body - -let compile_expression_as_value : expression -> _ result = fun e -> - let%bind value = expression_to_value e in - let%bind result = compile_value value e.type_value in - let result = Self_michelson.optimize result in - ok result - let compile_expression_as_function : expression -> _ result = fun e -> let (input , output) = t_unit , e.type_value in let%bind body = Compiler.Program.translate_expression e Compiler.Environment.empty in diff --git a/src/main/compile/of_simplified.ml b/src/main/compile/of_simplified.ml index 2c816338d..a006a6dc2 100644 --- a/src/main/compile/of_simplified.ml +++ b/src/main/compile/of_simplified.ml @@ -1,6 +1,5 @@ open Ast_simplified open Trace -open Tezos_utils let compile_contract_entry (program : program) entry_point = let%bind (prog_typed , state) = Typer.type_program program in @@ -18,17 +17,6 @@ let compile_expression_as_function_entry (program : program) entry_point : _ res 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_value ?(env = Ast_typed.Environment.full_empty) ~(state : Typer.Solver.state) ae : Michelson.t result = - let%bind (typed , state) = Typer.type_expression env state ae in - (* TODO: move this to typer.ml *) - let typed = - if Typer.use_new_typer then - let () = failwith "TODO : subst all" in let _todo = ignore (env, state) in typed - else - typed - in - Of_typed.compile_expression_as_value typed - 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 *) diff --git a/src/main/compile/of_typed.ml b/src/main/compile/of_typed.ml index 79ca90040..61a67c32e 100644 --- a/src/main/compile/of_typed.ml +++ b/src/main/compile/of_typed.ml @@ -1,13 +1,7 @@ open Trace open Ast_typed -open Tezos_utils -let compile_expression_as_value : annotated_expression -> Michelson.t result = fun e -> - let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in - let%bind expr = Of_mini_c.compile_expression_as_value mini_c_expression in - ok expr - let compile_expression_as_function : annotated_expression -> _ result = fun e -> let%bind mini_c_expression = Transpiler.transpile_annotated_expression e in let%bind expr = Of_mini_c.compile_expression_as_function mini_c_expression in @@ -18,12 +12,6 @@ let compile_function : annotated_expression -> _ result = fun e -> let%bind expr = Of_mini_c.compile_function mini_c_expression in ok expr -(* - val compile_value : annotated_expression -> Michelson.t result - This requires writing a function - `transpile_expression_as_value : annotated_expression -> Mini_c.value result` - *) - 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 diff --git a/src/main/run/of_mini_c.ml b/src/main/run/of_mini_c.ml index 131bf4ac5..558667044 100644 --- a/src/main/run/of_mini_c.ml +++ b/src/main/run/of_mini_c.ml @@ -29,18 +29,6 @@ let evaluate_entry ?options program entry = let%bind ex_ty_value = Of_michelson.evaluate ?options code in Compile.Of_mini_c.uncompile_value ex_ty_value -let run_function ?options expression input ty = - let%bind code = Compile.Of_mini_c.compile_function expression in - let%bind input = Compile.Of_mini_c.compile_value input ty in - let%bind ex_ty_value = Of_michelson.run ?options code input in - Compile.Of_mini_c.uncompile_value ex_ty_value - -let run_function_value ?options expression input ty = - let%bind code = Compile.Of_mini_c.compile_function expression in - let%bind input = Compile.Of_mini_c.compile_value input ty in - let%bind ex_ty_value = Of_michelson.run ?options code input 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 = diff --git a/src/main/run/of_simplified.ml b/src/main/run/of_simplified.ml index 63b52746e..b022ed98b 100644 --- a/src/main/run/of_simplified.ml +++ b/src/main/run/of_simplified.ml @@ -1,36 +1,30 @@ open Trace open Ast_simplified -let compile_expression ?(value = false) ?env ~state expr = (* TODO: state optional *) - if value - then ( - Compile.Of_simplified.compile_expression_as_value ?env ~state expr - ) - else ( - let%bind code = Compile.Of_simplified.compile_expression_as_function ?env ~state expr in - Of_michelson.evaluate_michelson code - ) +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 ?input_to_value + ?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 ?value:input_to_value ~env ~state input + 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 ?input_to_value + ?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 ?value:input_to_value ~env ~state input + compile_expression ~env ~state input in Of_michelson.get_exec_error ?options code input diff --git a/src/main/run/of_source.ml b/src/main/run/of_source.ml index 641e0b1a5..f61ee8785 100644 --- a/src/main/run/of_source.ml +++ b/src/main/run/of_source.ml @@ -70,23 +70,23 @@ let compile_expression : string -> Typer.Solver.state -> Compile.Helpers.s_synta let%bind simplified = Compile.Helpers.parsify_expression syntax expression in Of_simplified.compile_expression ~state simplified -let compile_file_contract_storage ~value : string -> string -> string -> Compile.Helpers.s_syntax -> Michelson.t result = +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 ~value simplified ~env ~state + Of_simplified.compile_expression simplified ~env ~state let compile_file_contract_args = - fun ?value source_filename _entry_point storage parameter syntax -> + 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 ?value args ~env ~state + Of_simplified.compile_expression args ~env ~state type dry_run_options = { amount : string ; @@ -120,11 +120,11 @@ let make_dry_run_options (opts : dry_run_options) : Of_michelson.options result ok (Some source) in ok @@ make_options ~amount ?source:sender ?payer:source () -let run_contract ~options ?storage_value source_filename entry_point storage parameter syntax = +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 ?value:storage_value source_filename entry_point storage parameter syntax 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 diff --git a/src/main/run/of_typed.ml b/src/main/run/of_typed.ml index 644e99d26..bd90f2bcb 100644 --- a/src/main/run/of_typed.ml +++ b/src/main/run/of_typed.ml @@ -1,15 +1,9 @@ open Trace open Ast_typed -let compile_expression ?(value = false) expr = - if value - then ( - Compile.Of_typed.compile_expression_as_value expr - ) - else ( - let%bind code = Compile.Of_typed.compile_expression_as_function expr in - Of_michelson.evaluate_michelson code - ) +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 diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 9fa3499da..8ddca53c9 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -466,7 +466,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re bind_map_pair (transpile_annotated_expression) (k , v') in return @@ E_constant ("UPDATE", [k' ; v' ; prev']) in - let init = return @@ E_make_empty_map (src, dst) in + let init = return @@ E_make_empty_big_map (src, dst) in List.fold_left aux init m ) | E_look_up dsi -> ( diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/7-self_mini_c/helpers.ml index f3931e6ce..17e27803d 100644 --- a/src/passes/7-self_mini_c/helpers.ml +++ b/src/passes/7-self_mini_c/helpers.ml @@ -25,7 +25,9 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini let%bind init' = f init e in match e.content with | E_variable _ | E_skip | E_make_none _ - | E_make_empty_map (_,_) | E_make_empty_list _ + | E_make_empty_map _ + | E_make_empty_big_map _ + | E_make_empty_list _ | E_make_empty_set _ -> ( ok init' ) @@ -91,7 +93,10 @@ let rec map_expression : mapper -> expression -> expression result = fun f e -> let return content = ok { e' with content } in match e'.content with | E_variable _ | E_literal _ | E_skip | E_make_none _ - | E_make_empty_map (_,_) | E_make_empty_list _ | E_make_empty_set _ as em -> return em + | E_make_empty_map _ + | E_make_empty_big_map _ + | E_make_empty_list _ + | E_make_empty_set _ as em -> return em | E_constant (name, lst) -> ( let%bind lst' = bind_map_list self lst in return @@ E_constant (name,lst') diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/7-self_mini_c/self_mini_c.ml index 57831e93b..af24dae97 100644 --- a/src/passes/7-self_mini_c/self_mini_c.ml +++ b/src/passes/7-self_mini_c/self_mini_c.ml @@ -22,6 +22,7 @@ let rec is_pure : expression -> bool = fun e -> | E_skip | E_variable _ | E_make_empty_map _ + | E_make_empty_big_map _ | E_make_empty_list _ | E_make_empty_set _ | E_make_none _ diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index e8358ce22..7bc85aeed 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -238,6 +238,9 @@ and translate_expression (expr:expression) (env:environment) : michelson result | E_make_empty_map sd -> let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in return @@ i_empty_map src dst + | E_make_empty_big_map sd -> + let%bind (src, dst) = bind_map_pair Compiler_type.type_ sd in + return @@ i_empty_big_map src dst | E_make_empty_list t -> let%bind t' = Compiler_type.type_ t in return @@ i_nil t' diff --git a/src/passes/8-compiler/uncompiler.ml b/src/passes/8-compiler/uncompiler.ml index 0ec7e8320..ee5a45b96 100644 --- a/src/passes/8-compiler/uncompiler.ml +++ b/src/passes/8-compiler/uncompiler.ml @@ -6,19 +6,19 @@ open Protocol open Script_typed_ir open Script_ir_translator -let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result = +let rec translate_value (Ex_typed_value (ty, value)) : value result = match (ty, value) with | Pair_t ((a_ty, _, _), (b_ty, _, _), _ , _), (a, b) -> ( - let%bind a = translate_value ?bm_opt @@ Ex_typed_value(a_ty, a) in - let%bind b = translate_value ?bm_opt @@ Ex_typed_value(b_ty, b) in + let%bind a = translate_value @@ Ex_typed_value(a_ty, a) in + let%bind b = translate_value @@ Ex_typed_value(b_ty, b) in ok @@ D_pair(a, b) ) | Union_t ((a_ty, _), _, _ , _), L a -> ( - let%bind a = translate_value ?bm_opt @@ Ex_typed_value(a_ty, a) in + let%bind a = translate_value @@ Ex_typed_value(a_ty, a) in ok @@ D_left a ) | Union_t (_, (b_ty, _), _ , _), R b -> ( - let%bind b = translate_value ?bm_opt @@ Ex_typed_value(b_ty, b) in + let%bind b = translate_value @@ Ex_typed_value(b_ty, b) in ok @@ D_right b ) | (Int_t _), n -> @@ -77,12 +77,6 @@ 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 = - match bm_opt with - | Some (D_big_map l) -> ok @@ l - | _ -> 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 @@ -93,7 +87,7 @@ let rec translate_value ?bm_opt (Ex_typed_value (ty, value)) : value result = if (List.mem_assoc k' orig) then ok @@ (k', v')::orig_rem else ok @@ (k', v')::orig | None -> ok orig_rem in - bind_fold_list aux original_big_map lst in + bind_fold_list aux [] lst in ok @@ D_big_map lst' | (List_t (ty, _ , _)), lst -> let%bind lst' = diff --git a/src/passes/8-compiler/uncompiler.mli b/src/passes/8-compiler/uncompiler.mli index d8b07a19d..4b717d01c 100644 --- a/src/passes/8-compiler/uncompiler.mli +++ b/src/passes/8-compiler/uncompiler.mli @@ -3,4 +3,4 @@ open Proto_alpha_utils.Memory_proto_alpha open X open Proto_alpha_utils.Trace -val translate_value : ?bm_opt:value -> ex_typed_value -> value result +val translate_value : ex_typed_value -> value result diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index b36ae77a0..1fcf8479b 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -77,6 +77,7 @@ and expression' ppf (e:expression') = match e with | E_constant(p, lst) -> fprintf ppf "%s %a" p (pp_print_list ~pp_sep:space_sep expression) lst | E_literal v -> fprintf ppf "L(%a)" value v | E_make_empty_map _ -> fprintf ppf "map[]" + | E_make_empty_big_map _ -> fprintf ppf "big_map[]" | E_make_empty_list _ -> fprintf ppf "list[]" | E_make_empty_set _ -> fprintf ppf "set[]" | E_make_none _ -> fprintf ppf "none" diff --git a/src/stages/mini_c/mini_c.ml b/src/stages/mini_c/mini_c.ml index 891f746d7..0eca16a75 100644 --- a/src/stages/mini_c/mini_c.ml +++ b/src/stages/mini_c/mini_c.ml @@ -2,10 +2,7 @@ module Types = Types include Types module PP = PP -module Combinators = struct - include Combinators - include Combinators_smart -end +module Combinators = Combinators include Combinators module Environment = Environment include Misc diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index 0cc51fcd0..90f9bb2eb 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -42,6 +42,7 @@ module Free_variables = struct | E_application (f, x) -> unions @@ [ self f ; self x ] | E_variable n -> var_name b n | E_make_empty_map _ -> empty + | E_make_empty_big_map _ -> empty | E_make_empty_list _ -> empty | E_make_empty_set _ -> empty | E_make_none _ -> empty @@ -195,61 +196,3 @@ 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/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index dd9a40d5b..56259d152 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -65,6 +65,7 @@ and expression' = | E_application of (expression * expression) | E_variable of var_name | E_make_empty_map of (type_value * type_value) + | E_make_empty_big_map of (type_value * type_value) | E_make_empty_list of type_value | E_make_empty_set of type_value | E_make_none of type_value diff --git a/src/test/compiler_tests.ml b/src/test/compiler_tests.ml deleted file mode 100644 index a93fb2ee7..000000000 --- a/src/test/compiler_tests.ml +++ /dev/null @@ -1,34 +0,0 @@ -open Trace -open Mini_c -open Combinators -open Test_helpers - -let run_entry_int e (n:int) : int result = - let param : value = D_int n in - let%bind result = Run.Of_mini_c.run_function_value e param t_int in - match result with - | D_int n -> ok n - | _ -> simple_fail "result is not an int" - -let identity () : unit result = - let%bind f = basic_int_quote (e_var_int "input") in - let%bind result = run_entry_int f 42 in - let%bind _ = Assert.assert_equal_int ~msg:__LOC__ 42 result in - ok () - -let multiple_vars () : unit result = - let expr = - e_let_in "a" t_int (e_var_int "input") @@ - e_let_in "b" t_int (e_var_int "input") @@ - e_let_in "c" t_int (e_var_int "a") @@ - e_let_in "output" t_int (e_var_int "c") @@ - e_var_int "output" in - let%bind f = basic_int_quote expr in - let%bind result = run_entry_int f 42 in - let%bind _ = Assert.assert_equal_int ~msg:__LOC__ 42 result in - ok () - -let main = test_suite "Compiler (from Mini_C)" [ - test "identity" identity ; - test "multiple_vars" multiple_vars ; - ] diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index 2a7370845..ceafd6264 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -685,7 +685,7 @@ let big_map_ type_f path : 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:true program "gf" make_input make_expected + expect_eq_n program "gf" make_input make_expected in let%bind () = let make_input = fun n -> @@ -693,17 +693,17 @@ let big_map_ type_f path : unit result = e_tuple [(e_int n) ; m] in let make_expected = fun n -> ez [(23 , n) ; (42 , 0)] in - expect_eq_n_pos_small ?input_to_value:(Some true) program "set_" make_input make_expected + expect_eq_n_pos_small program "set_" make_input make_expected in let%bind () = let make_input = fun n -> ez [(23, n) ; (42, 4)] in let make_expected = fun _ -> e_some @@ e_int 4 in - expect_eq_n ?input_to_value:(Some true) program "get" make_input make_expected + expect_eq_n program "get" make_input make_expected in let%bind () = let input = ez [(23, 23) ; (42, 42)] in let expected = ez [23, 23] in - expect_eq ?input_to_value:(Some true) program "rm" input expected + expect_eq program "rm" input expected in ok () diff --git a/src/test/test.ml b/src/test/test.ml index aebade390..40969bd45 100644 --- a/src/test/test.ml +++ b/src/test/test.ml @@ -6,7 +6,6 @@ let () = Printexc.record_backtrace true ; run_test @@ test_suite "LIGO" [ Integration_tests.main ; - Compiler_tests.main ; Transpiler_tests.main ; Typer_tests.main ; Heap_tests.main ; diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 97e378688..0fc77fca9 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -31,14 +31,14 @@ let test_suite name lst = Test_suite (name , lst) open Ast_simplified.Combinators -let expect ?input_to_value ?options program entry_point input expecter = +let expect ?options program entry_point input expecter = let%bind result = let run_error = let title () = "expect run" in let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace run_error @@ - Ligo.Run.Of_simplified.run_typed_program ?input_to_value ?options program Typer.Solver.initial_state entry_point input in + Ligo.Run.Of_simplified.run_typed_program ?options program Typer.Solver.initial_state entry_point input in expecter result let expect_fail ?options program entry_point input = @@ -58,7 +58,7 @@ let expect_string_failwith ?options program entry_point input expected_failwith | Ligo.Run.Of_michelson.Failwith_string s -> Assert.assert_equal_string expected_failwith s | _ -> simple_fail "Expected to fail with a string" -let expect_eq ?input_to_value ?options program entry_point input expected = +let expect_eq ?options program entry_point input expected = let expecter = fun result -> let expect_error = let title () = "expect result" in @@ -68,7 +68,7 @@ let expect_eq ?input_to_value ?options program entry_point input expected = error title content in trace expect_error @@ Ast_simplified.Misc.assert_value_eq (expected , result) in - expect ?input_to_value ?options program entry_point input expecter + expect ?options program entry_point input expecter let expect_evaluate program entry_point expecter = let error = @@ -95,23 +95,23 @@ let expect_n_aux ?options lst program entry_point make_input make_expecter = let%bind _ = bind_map_list aux lst in ok () -let expect_eq_n_aux ?input_to_value ?options lst program entry_point make_input make_expected = +let expect_eq_n_aux ?options lst program entry_point make_input make_expected = let aux n = let input = make_input n in let expected = make_expected n in trace (simple_error ("expect_eq_n " ^ (string_of_int n))) @@ - let result = expect_eq ?input_to_value ?options program entry_point input expected in + let result = expect_eq ?options program entry_point input expected in result in let%bind _ = bind_map_list_seq aux lst in ok () -let expect_eq_n ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [0 ; 1 ; 2 ; 42 ; 163 ; -1] -let expect_eq_n_pos ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [0 ; 1 ; 2 ; 42 ; 163] -let expect_eq_n_strict_pos ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [2 ; 42 ; 163] -let expect_eq_n_pos_small ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [0 ; 1 ; 2 ; 10] -let expect_eq_n_strict_pos_small ?input_to_value ?options = expect_eq_n_aux ?input_to_value ?options [1 ; 2 ; 10] -let expect_eq_n_pos_mid ?input_to_value = expect_eq_n_aux ?input_to_value [0 ; 1 ; 2 ; 10 ; 33] +let expect_eq_n ?options = expect_eq_n_aux ?options [0 ; 1 ; 2 ; 42 ; 163 ; -1] +let expect_eq_n_pos ?options = expect_eq_n_aux ?options [0 ; 1 ; 2 ; 42 ; 163] +let expect_eq_n_strict_pos ?options = expect_eq_n_aux ?options [2 ; 42 ; 163] +let expect_eq_n_pos_small ?options = expect_eq_n_aux ?options [0 ; 1 ; 2 ; 10] +let expect_eq_n_strict_pos_small ?options = expect_eq_n_aux ?options [1 ; 2 ; 10] +let expect_eq_n_pos_mid = expect_eq_n_aux [0 ; 1 ; 2 ; 10 ; 33] let expect_n_pos_small ?options = expect_n_aux ?options [0 ; 2 ; 10] let expect_n_strict_pos_small ?options = expect_n_aux ?options [2 ; 10] diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index 8e0654317..1267b3b2f 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -58,6 +58,7 @@ let i_map body = prim ~children:[body] I_MAP let i_some = prim I_SOME let i_lambda arg ret body = prim ~children:[arg;ret;body] I_LAMBDA let i_empty_map src dst = prim ~children:[src;dst] I_EMPTY_MAP +let i_empty_big_map src dst = prim ~children:[src;dst] I_EMPTY_BIG_MAP let i_drop = prim I_DROP let i_dropn n = prim I_DROP ~children:[int (Z.of_int n)] let i_exec = prim I_EXEC