diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 124ef3fb3..c2b26dc9a 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -1084,7 +1084,7 @@ let%expect_test _ = let%expect_test _ = run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_toplevel.mligo" ; "main" ] ; [%expect {| -ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return\n let rhs#723 = #P in\n let p = rhs#723.0 in\n let s = rhs#723.1 in\n ( LIST_EMPTY() : (type_operator: list(operation)) , store ) ,\n NONE() : (type_operator: option(key_hash)) ,\n 300000000mutez ,\n \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"} +ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, character 8. No free variable allowed in this lambda: variable 'store' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * string ))) : None return\n let rhs#727 = #P in\n let p = rhs#727.0 in\n let s = rhs#727.1 in\n ( LIST_EMPTY() : (type_operator: list(operation)) , store ) ,\n NONE() : (type_operator: option(key_hash)) ,\n 300000000mutez ,\n \"un\")","location":"in file \"create_contract_toplevel.mligo\", line 4, character 35 to line 8, character 8"} If you're not sure how to fix this error, you can @@ -1097,7 +1097,7 @@ ligo: in file "create_contract_toplevel.mligo", line 4, character 35 to line 8, run_ligo_bad [ "compile-contract" ; bad_contract "create_contract_var.mligo" ; "main" ] ; [%expect {| -ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return\n let rhs#726 = #P in\n let p = rhs#726.0 in\n let s = rhs#726.1 in\n ( LIST_EMPTY() : (type_operator: list(operation)) , a ) ,\n NONE() : (type_operator: option(key_hash)) ,\n 300000000mutez ,\n 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"} +ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, character 5. No free variable allowed in this lambda: variable 'a' {"expression":"CREATE_CONTRACT(lambda (#P:Some(( nat * int ))) : None return\n let rhs#730 = #P in\n let p = rhs#730.0 in\n let s = rhs#730.1 in\n ( LIST_EMPTY() : (type_operator: list(operation)) , a ) ,\n NONE() : (type_operator: option(key_hash)) ,\n 300000000mutez ,\n 1)","location":"in file \"create_contract_var.mligo\", line 6, character 35 to line 10, character 5"} If you're not sure how to fix this error, you can diff --git a/src/bin/expect_tests/michelson_or_tests.ml b/src/bin/expect_tests/michelson_or_tests.ml index d1e8b7c85..2bf4c6475 100644 --- a/src/bin/expect_tests/michelson_or_tests.ml +++ b/src/bin/expect_tests/michelson_or_tests.ml @@ -17,7 +17,7 @@ let%expect_test _ = run_ligo_good [ "compile-contract" ; contract "michelson_or_tree.mligo" ; "main" ] ; [%expect {| { parameter unit ; - storage (or int (or int nat)) ; + storage (or (int %three) (or %four (int %one) (nat %two))) ; code { PUSH int 1 ; LEFT nat ; RIGHT int ; diff --git a/src/bin/expect_tests/michelson_pair_test.ml b/src/bin/expect_tests/michelson_pair_test.ml new file mode 100644 index 000000000..1b77033e6 --- /dev/null +++ b/src/bin/expect_tests/michelson_pair_test.ml @@ -0,0 +1,46 @@ +open Cli_expect + +let contract basename = + "../../test/contracts/" ^ basename + +let%expect_test _ = + run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree.ligo" ; "main" ] ; + [%expect {| + { parameter unit ; + storage (pair (string %three) (pair %four (int %one) (nat %two))) ; + code { PUSH nat 2 ; + PUSH int 1 ; + PAIR ; + PUSH string "foo" ; + PAIR ; + NIL operation ; + PAIR ; + DIP { DROP } } } |}] + +let%expect_test _ = + run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree.mligo" ; "main" ] ; + [%expect {| + { parameter unit ; + storage (pair (int %three) (pair %four (int %one) (nat %two))) ; + code { PUSH nat 2 ; + PUSH int 1 ; + PAIR ; + PUSH int 3 ; + PAIR ; + NIL operation ; + PAIR ; + DIP { DROP } } } |}] + +let%expect_test _ = + run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree.religo" ; "main" ] ; + [%expect {| + { parameter unit ; + storage (pair (int %three) (pair %four (int %one) (nat %two))) ; + code { PUSH nat 2 ; + PUSH int 1 ; + PAIR ; + PUSH int 3 ; + PAIR ; + NIL operation ; + PAIR ; + DIP { DROP } } } |}] \ No newline at end of file diff --git a/src/bin/expect_tests/syntax_error_tests.ml b/src/bin/expect_tests/syntax_error_tests.ml index 2f591ab00..0968c1d5b 100644 --- a/src/bin/expect_tests/syntax_error_tests.ml +++ b/src/bin/expect_tests/syntax_error_tests.ml @@ -4,7 +4,7 @@ let%expect_test _ = run_ligo_bad [ "compile-contract" ; "../../test/contracts/negative/error_syntax.ligo" ; "main" ] ; [%expect {| ligo: : Parse error in file "error_syntax.ligo", line 1, characters 16-17 at "-", after "bar": - 15: {} + 16: {} If you're not sure how to fix this error, you can diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index e8dea1820..7a1c02ada 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -206,6 +206,7 @@ type_args: core_type: type_name { TVar $1 } +| "" { TStringLiteral $1 } | par(fun_type) { TPar $1 } | module_name "." type_name { let module_name = $1.value in diff --git a/src/passes/2-concrete_to_imperative/cameligo.ml b/src/passes/2-concrete_to_imperative/cameligo.ml index d8984bb50..1bf3b3ffe 100644 --- a/src/passes/2-concrete_to_imperative/cameligo.ml +++ b/src/passes/2-concrete_to_imperative/cameligo.ml @@ -256,6 +256,21 @@ and compile_type_expression : Raw.type_expr -> type_expression result = fun te - ok @@ t_michelson_or ~loc a' b' c' d' ) | _ -> simple_fail "michelson_or does not have the right number of argument") + | "michelson_pair" -> + let lst = npseq_to_list tuple.value.inside in + (match lst with + | [a ; b ; c ; d ] -> ( + let%bind b' = + trace_option (simple_error "second argument of michelson_pair must be a string singleton") @@ + get_t_string_singleton_opt b in + let%bind d' = + trace_option (simple_error "fourth argument of michelson_pair must be a string singleton") @@ + get_t_string_singleton_opt d in + let%bind a' = compile_type_expression a in + let%bind c' = compile_type_expression c in + ok @@ t_michelson_pair ~loc a' b' c' d' + ) + | _ -> simple_fail "michelson_pair does not have the right number of argument") | _ -> let lst = npseq_to_list tuple.value.inside in let%bind lst' = bind_map_list compile_type_expression lst in diff --git a/src/passes/2-concrete_to_imperative/pascaligo.ml b/src/passes/2-concrete_to_imperative/pascaligo.ml index ca3139655..be855993f 100644 --- a/src/passes/2-concrete_to_imperative/pascaligo.ml +++ b/src/passes/2-concrete_to_imperative/pascaligo.ml @@ -196,7 +196,7 @@ let rec compile_type_expression (t:Raw.type_expr) : type_expression result = let%bind c' = compile_type_expression c in ok @@ t_michelson_pair ~loc a' b' c' d' ) - | _ -> simple_fail "michelson_or does not have the right number of argument") + | _ -> simple_fail "michelson_pair does not have the right number of argument") | _ -> let lst = npseq_to_list tuple.value.inside in let%bind lst = diff --git a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml index 318fe942d..75f8906fb 100644 --- a/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml +++ b/src/passes/4-imperative_to_sugar/imperative_to_sugar.ml @@ -153,8 +153,8 @@ let rec compile_type_expression : I.type_expression -> O.type_expression result | I.T_operator (TC_michelson_pair (l,l_ann,r,r_ann)) -> let%bind (l,r) = bind_map_pair compile_type_expression (l,r) in let sum : (O.label * O.field_content) list = [ - (O.Label "M_left" , {field_type = l ; michelson_annotation = Some l_ann}); - (O.Label "M_right", {field_type = r ; michelson_annotation = Some r_ann}); ] + (O.Label "0" , {field_type = l ; michelson_annotation = Some l_ann}); + (O.Label "1", {field_type = r ; michelson_annotation = Some r_ann}); ] in return @@ O.T_record (O.LMap.of_list sum) | I.T_operator type_operator -> diff --git a/src/test/contracts/double_michelson_or.ligo b/src/test/contracts/double_michelson_or.ligo index e1b1d6595..3250ec37d 100644 --- a/src/test/contracts/double_michelson_or.ligo +++ b/src/test/contracts/double_michelson_or.ligo @@ -1,5 +1,5 @@ -type storage is michelson_or (int, string) -type foobar is michelson_or (int, int) +type storage is michelson_or (int,"foo",string,"bar") +type foobar is michelson_or (int,"baz",int,"fooo") type return is list (operation) * storage diff --git a/src/test/contracts/double_michelson_or.mligo b/src/test/contracts/double_michelson_or.mligo index f69f2b151..9b497b72e 100644 --- a/src/test/contracts/double_michelson_or.mligo +++ b/src/test/contracts/double_michelson_or.mligo @@ -1,5 +1,5 @@ -type storage = (int,string) michelson_or -type foobar = (int, int ) michelson_or +type storage = (int,"foo",string,"bar") michelson_or +type foobar = (int,"baz", int, "fooo" ) michelson_or type return = operation list * storage diff --git a/src/test/contracts/michelson_pair_tree.mligo b/src/test/contracts/michelson_pair_tree.mligo new file mode 100644 index 000000000..55624bbb4 --- /dev/null +++ b/src/test/contracts/michelson_pair_tree.mligo @@ -0,0 +1,8 @@ +type inner_storage = (int,"one",nat,"two") michelson_pair +type storage = (int,"three",inner_storage,"four") michelson_pair + +type return = operation list * storage + +let main (action, store : unit * storage) : return = + let foo = (3,(1,2n)) in + (([] : operation list), (foo: storage)) \ No newline at end of file diff --git a/src/test/contracts/michelson_pair_tree.religo b/src/test/contracts/michelson_pair_tree.religo new file mode 100644 index 000000000..8fa2c827b --- /dev/null +++ b/src/test/contracts/michelson_pair_tree.religo @@ -0,0 +1,9 @@ +type inner_storage = michelson_pair(int,"one",nat,"two"); +type storage = michelson_pair(int,"three",inner_storage,"four"); + +type return = (list (operation) , storage); + +let main = ((action, store) : (unit , storage)) : return => { + let foo = (3,(1,2n)) ; + (([] : list(operation)), (foo: storage)) +}; \ No newline at end of file diff --git a/src/test/contracts/negative/bad_michelson_or.mligo b/src/test/contracts/negative/bad_michelson_or.mligo index 08c7fe035..1b4cdec56 100644 --- a/src/test/contracts/negative/bad_michelson_or.mligo +++ b/src/test/contracts/negative/bad_michelson_or.mligo @@ -1,4 +1,4 @@ -type storage = (int,string) michelson_or +type storage = (int,"foo",string,"bar") michelson_or type return = operation list * storage