From a4a8e9d2bcbd99a1102bf0ea340e44ef7a04c8a7 Mon Sep 17 00:00:00 2001 From: Sander Spies Date: Mon, 13 Apr 2020 10:24:40 +0200 Subject: [PATCH 1/5] Remove tuple annotation. --- src/passes/10-transpiler/transpiler.ml | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/src/passes/10-transpiler/transpiler.ml b/src/passes/10-transpiler/transpiler.ml index 29640ada5..f2ddbcd9b 100644 --- a/src/passes/10-transpiler/transpiler.ml +++ b/src/passes/10-transpiler/transpiler.ml @@ -176,7 +176,14 @@ let rec transpile_type (t:AST.type_expression) : type_value result = aux node in ok @@ snd m' | T_record m -> - let node = Append_tree.of_list @@ Stage_common.Helpers.kv_list_of_record_or_tuple m in + let is_tuple_lmap = Stage_common.Helpers.is_tuple_lmap m in + let node = Append_tree.of_list @@ ( + if is_tuple_lmap then + Stage_common.Helpers.tuple_of_record m + else + List.rev @@ LMap.to_kv_list m + ) + in let aux a b : type_value annotated result = let%bind a = a in let%bind b = b in @@ -184,8 +191,13 @@ let rec transpile_type (t:AST.type_expression) : type_value result = in let%bind m' = Append_tree.fold_ne (fun (Stage_common.Types.Label ann, a) -> - let%bind a = transpile_type a in - ok (Some ann, a)) + let%bind a = transpile_type a in + ok ((if is_tuple_lmap then + None + else + Some ann), + a) + ) aux node in ok @@ snd m' | T_arrow {type1;type2} -> ( From 42b05c0437ae0d86dc2f6534e42f7634b6c855de Mon Sep 17 00:00:00 2001 From: Sander Spies Date: Mon, 13 Apr 2020 10:31:09 +0200 Subject: [PATCH 2/5] Test tuples without annotations. --- src/bin/expect_tests/contract_tests.ml | 15 ++++++++++++++- src/test/contracts/tuples_no_annotation.religo | 7 +++++++ 2 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 src/test/contracts/tuples_no_annotation.religo diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index f16a38e0b..05f5cef7a 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -1173,7 +1173,20 @@ ligo: in file "create_contract_var.mligo", line 6, character 35 to line 10, char CONS ; DIP { DIP { DUP } ; SWAP ; CDR } ; PAIR ; - DIP { DROP 2 } } } |}] + DIP { DROP 2 } } } |}]; + + run_ligo_good [ "compile-contract" ; contract "tuples_no_annotation.religo" ; "main" ] ; + [%expect {| + { parameter int ; + storage (pair (pair int string) (pair nat bool)) ; + code { PUSH string "2" ; + PUSH int 2 ; + PAIR ; + DIP { PUSH bool False ; PUSH nat 2 ; PAIR } ; + PAIR ; + NIL operation ; + PAIR ; + DIP { DROP } } } |}] let%expect_test _ = run_ligo_bad [ "compile-contract" ; bad_contract "self_type_annotation.ligo" ; "main" ] ; diff --git a/src/test/contracts/tuples_no_annotation.religo b/src/test/contracts/tuples_no_annotation.religo new file mode 100644 index 000000000..6858c60a5 --- /dev/null +++ b/src/test/contracts/tuples_no_annotation.religo @@ -0,0 +1,7 @@ +type storage = (int, string, nat, bool) + +type parameter = int + +let main = ((p,storage): (parameter, storage)) => { +([]: list (operation), (2, "2", 2n, false)); +}; From 6a6c8468a624127043d0a19058f124f83d2f9b11 Mon Sep 17 00:00:00 2001 From: Sander Spies Date: Mon, 13 Apr 2020 10:59:36 +0200 Subject: [PATCH 3/5] Remove annotations from michelson or. --- src/bin/expect_tests/michelson_or_tests.ml | 2 +- src/passes/10-transpiler/transpiler.ml | 8 +++++++- src/stages/common/helpers.ml | 5 +++++ src/stages/common/helpers.mli | 2 +- 4 files changed, 14 insertions(+), 3 deletions(-) diff --git a/src/bin/expect_tests/michelson_or_tests.ml b/src/bin/expect_tests/michelson_or_tests.ml index 2656620c9..595a76c5e 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 %m_left) (or %m_right (int %m_left) (nat %m_right))) ; + storage (or int (or int nat)) ; code { PUSH int 1 ; LEFT nat ; RIGHT int ; diff --git a/src/passes/10-transpiler/transpiler.ml b/src/passes/10-transpiler/transpiler.ml index f2ddbcd9b..121764b82 100644 --- a/src/passes/10-transpiler/transpiler.ml +++ b/src/passes/10-transpiler/transpiler.ml @@ -163,6 +163,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result = ) (* TODO hmm *) | T_sum m -> + let is_michelson_or = Stage_common.Helpers.is_michelson_or m in let node = Append_tree.of_list @@ kv_list_of_cmap m in let aux a b : type_value annotated result = let%bind a = a in @@ -172,7 +173,12 @@ let rec transpile_type (t:AST.type_expression) : type_value result = let%bind m' = Append_tree.fold_ne (fun (Stage_common.Types.Constructor ann, a) -> let%bind a = transpile_type a in - ok (Some (String.uncapitalize_ascii ann), a)) + ok (( + if is_michelson_or then + None + else + Some (String.uncapitalize_ascii ann)), + a)) aux node in ok @@ snd m' | T_record m -> diff --git a/src/stages/common/helpers.ml b/src/stages/common/helpers.ml index 91cd0eae1..3a7c387de 100644 --- a/src/stages/common/helpers.ml +++ b/src/stages/common/helpers.ml @@ -66,3 +66,8 @@ let kv_list_of_record_or_tuple (m: _ LMap.t) = tuple_of_record m else List.rev @@ LMap.to_kv_list m + +let is_michelson_or (t: _ constructor_map) = + CMap.cardinal t = 2 && + (CMap.mem (Constructor "M_left") t) && + (CMap.mem (Constructor "M_right") t) diff --git a/src/stages/common/helpers.mli b/src/stages/common/helpers.mli index 1292bb807..6b8dd6e2f 100644 --- a/src/stages/common/helpers.mli +++ b/src/stages/common/helpers.mli @@ -24,7 +24,7 @@ val get_pair : val tuple_of_record : 'a LMap.t -> (label * 'a) list val list_of_record_or_tuple : 'a LMap.t -> 'a list val kv_list_of_record_or_tuple : 'a LMap.t -> (label * 'a) list - +val is_michelson_or : 'a Types.constructor_map -> bool val bind_map_lmapi : From d9148699cc1535eb07340abf117b583859d9e4a7 Mon Sep 17 00:00:00 2001 From: Sander Spies Date: Mon, 13 Apr 2020 11:44:52 +0200 Subject: [PATCH 4/5] Fix contract tests --- src/bin/expect_tests/contract_tests.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index 05f5cef7a..7152d3e9b 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -10,7 +10,7 @@ let%expect_test _ = [%expect {| 1872 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ; - [%expect {| 1294 bytes |}] ; + [%expect {| 1282 bytes |}] ; run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ; [%expect {| 2974 bytes |}] ; @@ -297,7 +297,7 @@ let%expect_test _ = [%expect {| { parameter (pair (pair (nat %counter) (lambda %message unit (list operation))) - (list %signatures (pair (key_hash %0) (signature %1)))) ; + (list %signatures (pair key_hash signature))) ; storage (pair (pair (list %auth key) (nat %counter)) (pair (string %id) (nat %threshold))) ; code { DUP ; From 422623ce1e402767e51b1cb8250083866d3e2f0d Mon Sep 17 00:00:00 2001 From: Sander Spies Date: Tue, 14 Apr 2020 13:13:07 +0200 Subject: [PATCH 5/5] Fix build. --- src/passes/10-transpiler/transpiler.ml | 10 +++++----- src/stages/4-ast_typed/helpers.ml | 6 ++++++ src/stages/common/helpers.ml | 4 ---- src/stages/common/helpers.mli | 1 - 4 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/passes/10-transpiler/transpiler.ml b/src/passes/10-transpiler/transpiler.ml index 83f2a79eb..7168af974 100644 --- a/src/passes/10-transpiler/transpiler.ml +++ b/src/passes/10-transpiler/transpiler.ml @@ -278,7 +278,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result = ) (* TODO hmm *) | T_sum m -> - let is_michelson_or = Stage_common.Helpers.is_michelson_or m in + let is_michelson_or = Ast_typed.Helpers.is_michelson_or m in let node = Append_tree.of_list @@ kv_list_of_cmap m in let aux a b : type_value annotated result = let%bind a = a in @@ -297,12 +297,12 @@ let rec transpile_type (t:AST.type_expression) : type_value result = aux node in ok @@ snd m' | T_record m -> - let is_tuple_lmap = Stage_common.Helpers.is_tuple_lmap m in + let is_tuple_lmap = Ast_typed.Helpers.is_tuple_lmap m in let node = Append_tree.of_list @@ ( if is_tuple_lmap then - Stage_common.Helpers.tuple_of_record m + Ast_typed.Helpers.tuple_of_record m else - List.rev @@ LMap.to_kv_list m + List.rev @@ Ast_typed.Types.LMap.to_kv_list m ) in let aux a b : type_value annotated result = @@ -311,7 +311,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result = ok (None, T_pair (a, b)) in let%bind m' = Append_tree.fold_ne - (fun (Stage_common.Types.Label ann, a) -> + (fun (Ast_typed.Types.Label ann, a) -> let%bind a = transpile_type a in ok ((if is_tuple_lmap then None diff --git a/src/stages/4-ast_typed/helpers.ml b/src/stages/4-ast_typed/helpers.ml index bb3962846..c7dff6989 100644 --- a/src/stages/4-ast_typed/helpers.ml +++ b/src/stages/4-ast_typed/helpers.ml @@ -163,3 +163,9 @@ let kv_list_of_record_or_tuple (m: _ LMap.t) = tuple_of_record m else List.rev @@ LMap.to_kv_list m + + +let is_michelson_or (t: _ constructor_map) = + CMap.cardinal t = 2 && + (CMap.mem (Constructor "M_left") t) && + (CMap.mem (Constructor "M_right") t) \ No newline at end of file diff --git a/src/stages/common/helpers.ml b/src/stages/common/helpers.ml index 3a7c387de..dded3a7d8 100644 --- a/src/stages/common/helpers.ml +++ b/src/stages/common/helpers.ml @@ -67,7 +67,3 @@ let kv_list_of_record_or_tuple (m: _ LMap.t) = else List.rev @@ LMap.to_kv_list m -let is_michelson_or (t: _ constructor_map) = - CMap.cardinal t = 2 && - (CMap.mem (Constructor "M_left") t) && - (CMap.mem (Constructor "M_right") t) diff --git a/src/stages/common/helpers.mli b/src/stages/common/helpers.mli index 6b8dd6e2f..03817d6d4 100644 --- a/src/stages/common/helpers.mli +++ b/src/stages/common/helpers.mli @@ -24,7 +24,6 @@ val get_pair : val tuple_of_record : 'a LMap.t -> (label * 'a) list val list_of_record_or_tuple : 'a LMap.t -> 'a list val kv_list_of_record_or_tuple : 'a LMap.t -> (label * 'a) list -val is_michelson_or : 'a Types.constructor_map -> bool val bind_map_lmapi :