more coase; better tests

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)
+    ?(amount = Alpha_context.Tez.one) ()
-    ?visitor
+  = {
-    (instr:('a, 'b) descr) (bef:'a stack) : 'b stack tzresult Lwt.t  =
+    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

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

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

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
 

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 =

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
+        Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 10000000000 in
-      let options = make_options ~amount () 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
+        Memory_proto_alpha.Alpha_context.Tez.of_mutez @@ Int64.of_int 0 in
-      let options = make_options ~amount () 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 ; *)
   ]

src/ligo/test/test_helpers.ml

@@ -13,22 +13,14 @@ let test name f =
 
 open Ast_simplified.Combinators
 
-type options = {
+let expect ?options program entry_point input expecter =
-  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%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