diff --git a/src/lib_utils/x_memory_proto_alpha.ml b/src/lib_utils/x_memory_proto_alpha.ml index 7e383da7c..1657f7a16 100644 --- a/src/lib_utils/x_memory_proto_alpha.ml +++ b/src/lib_utils/x_memory_proto_alpha.ml @@ -97,13 +97,37 @@ let unparse_michelson_ty Script_ir_translator.unparse_ty tezos_context ty >>=?? fun (michelson, _) -> return michelson -let interpret +type options = { + tezos_context: Alpha_context.t ; + source: Alpha_context.Contract.t ; + payer: Alpha_context.Contract.t ; + self: Alpha_context.Contract.t ; + amount: Alpha_context.Tez.t ; +} + +let make_options ?(tezos_context = dummy_environment.tezos_context) ?(source = (List.nth dummy_environment.identities 0).implicit_contract) ?(self = (List.nth dummy_environment.identities 0).implicit_contract) ?(payer = (List.nth dummy_environment.identities 1).implicit_contract) - ?(amount = Alpha_context.Tez.one) - ?visitor - (instr:('a, 'b) descr) (bef:'a stack) : 'b stack tzresult Lwt.t = + ?(amount = Alpha_context.Tez.one) () + = { + tezos_context ; + source ; + self ; + payer ; + amount ; + } + +let default_options = make_options () + +let interpret ?(options = default_options) ?visitor (instr:('a, 'b) descr) (bef:'a stack) : 'b stack tzresult Lwt.t = + let { + tezos_context ; + source ; + self ; + payer ; + amount ; + } = options in Script_interpreter.step tezos_context ~source ~self ~payer ?visitor amount instr bef >>=?? fun (stack, _) -> return stack diff --git a/src/ligo/contracts/coase.ligo b/src/ligo/contracts/coase.ligo index ba81e26bc..8d5ad912f 100644 --- a/src/ligo/contracts/coase.ligo +++ b/src/ligo/contracts/coase.ligo @@ -27,7 +27,7 @@ type action_buy_single is record [ type action_sell_single is record [ card_to_sell : card_id ; ] -type action_transfer is record [ +type action_transfer_single is record [ card_to_transfer : card_id ; destination : address ; ] @@ -35,7 +35,18 @@ type action_transfer is record [ type action is | Buy_single of action_buy_single | Sell_single of action_sell_single -// | Transfer of action_transfer +| Transfer_single of action_transfer_single + +function transfer_single(const action : action_transfer_single ; const s : storage_type) : (list(operation) * storage_type) is + begin + const cards : cards = s.cards ; + const card : card = get_force(action.card_to_transfer , cards) ; + if (card.card_owner =/= source) then fail "This card doesn't belong to you" else skip ; + card.card_owner := action.destination ; + cards[action.card_to_transfer] := card ; + s.cards := cards ; + const operations : list(operation) = nil ; + end with (operations , s) ; function sell_single(const action : action_sell_single ; const s : storage_type) : (list(operation) * storage_type) is begin @@ -83,5 +94,5 @@ function main(const action : action ; const s : storage_type) : (list(operation) case action of | Buy_single bs -> buy_single (bs , s) | Sell_single as -> sell_single (as , s) - // | Transfer at -> transfer (at , s) + | Transfer_single at -> transfer_single (at , s) end diff --git a/src/ligo/main/main.ml b/src/ligo/main/main.ml index c52e06d79..a8debaf63 100644 --- a/src/ligo/main/main.ml +++ b/src/ligo/main/main.ml @@ -87,7 +87,7 @@ let easy_evaluate_typed_simplified (entry:string) (program:AST_Typed.program) : let easy_evaluate_typed = trace_f_2_ez easy_evaluate_typed (thunk "easy evaluate typed") let easy_run_typed - ?(debug_mini_c = false) ?amount (entry:string) + ?(debug_mini_c = false) ?options (entry:string) (program:AST_Typed.program) (input:AST_Typed.annotated_expression) : AST_Typed.annotated_expression result = let%bind () = let open Ast_typed in @@ -115,7 +115,7 @@ let easy_run_typed in error title content in trace error @@ - Run_mini_c.run_entry ?amount mini_c_main mini_c_value in + Run_mini_c.run_entry ?options mini_c_main mini_c_value in let%bind typed_result = let%bind main_result_type = let%bind typed_main = Ast_typed.get_functional_entry program entry in @@ -126,7 +126,7 @@ let easy_run_typed ok typed_result let easy_run_typed_simplified - ?(debug_mini_c = false) ?(debug_michelson = false) ?amount (entry:string) + ?(debug_mini_c = false) ?(debug_michelson = false) ?options (entry:string) (program:AST_Typed.program) (input:Ast_simplified.annotated_expression) : Ast_simplified.annotated_expression result = let%bind mini_c_main = trace (simple_error "transpile mini_c entry") @@ @@ -152,7 +152,7 @@ let easy_run_typed_simplified in error title content in trace error @@ - Run_mini_c.run_entry ~debug_michelson ?amount mini_c_main mini_c_value in + Run_mini_c.run_entry ~debug_michelson ?options mini_c_main mini_c_value in let%bind typed_result = let%bind main_result_type = let%bind typed_main = Ast_typed.get_functional_entry program entry in diff --git a/src/ligo/main/run_mini_c.ml b/src/ligo/main/run_mini_c.ml index 360b38f27..5fb8d908f 100644 --- a/src/ligo/main/run_mini_c.ml +++ b/src/ligo/main/run_mini_c.ml @@ -3,7 +3,7 @@ open Mini_c open! Compiler.Program open Memory_proto_alpha.Script_ir_translator -let run_aux ?amount (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result = +let run_aux ?options (program:compiled_program) (input_michelson:Michelson.t) : ex_typed_value result = let Compiler.Program.{input;output;body} : compiled_program = program in let (Ex_ty input_ty) = input in let (Ex_ty output_ty) = output in @@ -18,7 +18,7 @@ let run_aux ?amount (program:compiled_program) (input_michelson:Michelson.t) : e let open! Memory_proto_alpha.Script_interpreter in let%bind (Item(output, Empty)) = Trace.trace_tzresult_lwt (simple_error "error of execution") @@ - Tezos_utils.Memory_proto_alpha.interpret ?amount descr (Item(input, Empty)) in + Tezos_utils.Memory_proto_alpha.interpret ?options descr (Item(input, Empty)) in ok (Ex_typed_value (output_ty, output)) let run_node (program:program) (input:Michelson.t) : Michelson.t result = @@ -29,7 +29,7 @@ let run_node (program:program) (input:Michelson.t) : Michelson.t result = Tezos_utils.Memory_proto_alpha.unparse_michelson_data output_ty output in ok output -let run_entry ?(debug_michelson = false) ?amount (entry:anon_function) (input:value) : value result = +let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:value) : value result = let%bind compiled = let error = let title () = "compile entry" in @@ -41,7 +41,7 @@ let run_entry ?(debug_michelson = false) ?amount (entry:anon_function) (input:va translate_entry entry in if debug_michelson then Format.printf "Program: %a\n" Michelson.pp compiled.body ; let%bind input_michelson = translate_value input in - let%bind ex_ty_value = run_aux ?amount compiled input_michelson in + let%bind ex_ty_value = run_aux ?options compiled input_michelson in let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in ok result diff --git a/src/ligo/meta_michelson/misc.ml b/src/ligo/meta_michelson/misc.ml index 307a8b163..9ee94effe 100644 --- a/src/ligo/meta_michelson/misc.ml +++ b/src/ligo/meta_michelson/misc.ml @@ -65,7 +65,8 @@ module Context_init = struct let open Tezos_base.TzPervasives.Error_monad in let bootstrap_accounts = List.map (fun ({ pk ; pkh ; _ }, amount) -> - Parameters_repr.{ public_key_hash = pkh ; public_key = Some pk ; amount } + let open! Parameters_repr in + { public_key_hash = pkh ; public_key = Some pk ; amount } ) initial_accounts in let json = diff --git a/src/ligo/test/coase_tests.ml b/src/ligo/test/coase_tests.ml index 7ab498d44..19b352e15 100644 --- a/src/ligo/test/coase_tests.ml +++ b/src/ligo/test/coase_tests.ml @@ -69,11 +69,11 @@ let cards_ez owner n = @@ List.map (Function.constant owner) @@ List.range n -let first_owner = +let (first_owner , first_contract) = let open Tezos_utils.Memory_proto_alpha in let id = List.nth dummy_environment.identities 0 in let kt = id.implicit_contract in - Alpha_context.Contract.to_b58check kt + Alpha_context.Contract.to_b58check kt , kt let second_owner = let open Tezos_utils.Memory_proto_alpha in @@ -111,14 +111,14 @@ let buy () = let%bind () = let%bind amount = trace_option (simple_error "getting amount for run") @@ - Tezos_utils.Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in - let options = make_options ~amount () in + Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in + let options = Memory_proto_alpha.make_options ~amount () in expect_eq_n_pos_small ~options program "buy_single" make_input make_expected in let%bind () = let%bind amount = trace_option (simple_error "getting amount for run") @@ - Tezos_utils.Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in - let options = make_options ~amount () in + Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in + let options = Memory_proto_alpha.make_options ~amount () in trace_strong (simple_error "could buy without money") @@ Assert.assert_fail @@ expect_eq_n_pos_small ~options program "buy_single" make_input make_expected in @@ -126,6 +126,37 @@ let buy () = in ok () +let transfer () = + let%bind program = get_program () in + let%bind () = + let make_input = fun n -> + let transfer_action = ez_e_a_record [ + ("card_to_transfer" , e_a_nat 0) ; + ("destination" , e_a_address second_owner) ; + ] in + let storage = basic 100 1000 (cards_ez first_owner n) (2 * n) in + e_a_pair transfer_action storage + in + let make_expected = fun n -> + let ops = e_a_list [] t_operation in + let storage = + let cards = + let new_card = card_ez second_owner in + let old_cards = cards_ez first_owner n in + (e_a_nat 0 , new_card) :: (List.tl old_cards) + in + basic 100 1000 cards (2 * n) in + e_a_pair ops storage + in + let%bind () = + let amount = Memory_proto_alpha.Alpha_context.Tez.zero in + let payer = first_contract in + let options = Memory_proto_alpha.make_options ~amount ~payer () in + expect_eq_n_strict_pos_small ~options program "transfer_single" make_input make_expected in + ok () + in + ok () + let sell () = let%bind program = get_program () in let%bind () = @@ -148,7 +179,7 @@ let sell () = in let%bind () = let amount = Memory_proto_alpha.Alpha_context.Tez.zero in - let options = make_options ~amount () in + let options = Memory_proto_alpha.make_options ~amount () in expect_eq_n_pos_small ~options program "sell_single" make_input make_expected in ok () in @@ -157,5 +188,6 @@ let sell () = let main = "Coase (End to End)", [ test "buy" buy ; + test "transfer" transfer ; (* test "sell" sell ; *) ] diff --git a/src/ligo/test/test_helpers.ml b/src/ligo/test/test_helpers.ml index 5c568eddc..fbd7d5822 100644 --- a/src/ligo/test/test_helpers.ml +++ b/src/ligo/test/test_helpers.ml @@ -13,22 +13,14 @@ let test name f = open Ast_simplified.Combinators -type options = { - amount : Memory_proto_alpha.Alpha_context.Tez.t option ; -} - -let make_options ?amount () = { - amount ; -} - -let expect ?(options = make_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.easy_run_typed_simplified ~debug_michelson:false ?amount:options.amount entry_point program input in + Ligo.easy_run_typed_simplified ~debug_michelson:false ?options entry_point program input in expecter result let expect_eq ?options program entry_point input expected = @@ -39,7 +31,7 @@ let expect_eq ?options program entry_point input expected = Ast_simplified.PP.value expected Ast_simplified.PP.value result in error title content in - trace_strong expect_error @@ + trace expect_error @@ Ast_simplified.assert_value_eq (expected , result) in expect ?options program entry_point input expecter