balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix/simplify big_maps using Babylon

Browse Source
This commit is contained in:
Tom Jack 2019-11-04 17:01:39 -06:00
parent ae7c92844c
commit 81c49f4342
23 changed files with 61 additions and 218 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/bin/cli.ml
View File

@ -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)

11
src/main/compile/of_mini_c.ml
View File

@ -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

12
src/main/compile/of_simplified.ml
View File

@ -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 *)

12
src/main/compile/of_typed.ml
View File

@ -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

12
src/main/run/of_mini_c.ml
View File

@ -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 =

20
src/main/run/of_simplified.ml
View File

@ -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

12
src/main/run/of_source.ml
View File

@ -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

12
src/main/run/of_typed.ml
View File

@ -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

2
src/passes/6-transpiler/transpiler.ml
View File

@ -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 -> (

9
src/passes/7-self_mini_c/helpers.ml
View File

@ -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')

1
src/passes/7-self_mini_c/self_mini_c.ml
View File

@ -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 _

3
src/passes/8-compiler/compiler_program.ml
View File

@ -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'

18
src/passes/8-compiler/uncompiler.ml
View File

@ -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' =

2
src/passes/8-compiler/uncompiler.mli
View File

@ -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

1
src/stages/mini_c/PP.ml
View File

@ -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"

5
src/stages/mini_c/mini_c.ml
View File

@ -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

59
src/stages/mini_c/misc.ml
View File

@ -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")

1
src/stages/mini_c/types.ml
View File

@ -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

34
src/test/compiler_tests.ml
View File

@ -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 ;
]

8
src/test/integration_tests.ml
View File

@ -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 ()

1
src/test/test.ml
View File

@ -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 ;

24
src/test/test_helpers.ml
View File

@ -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]

1
vendors/ligo-utils/tezos-utils/x_michelson.ml vendored
View File

@ -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