Merge branch '181-cannot-declare-michelson_or-michelson_pair-element-w-o-annotation' into 'dev'

Resolve "Cannot declare michelson_or/michelson_pair element w/o annotation"

Closes #181

See merge request ligolang/ligo!583

src/bin/expect_tests/michelson_or_tests.ml

@@ -39,3 +39,16 @@ let%expect_test _ =
     * Ask a question on our Discord: https://discord.gg/9rhYaEt
     * Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
     * Check the changelog by running 'ligo changelog' |}]
+
+let%expect_test _ =
+  run_ligo_good [ "compile-contract" ; contract "michelson_or_tree_intermediary.ligo" ; "main" ] ;
+  [%expect {|
+    { parameter unit ;
+      storage (or (int %three) (or (int %one) (nat %two))) ;
+      code { PUSH int 1 ;
+             LEFT nat ;
+             RIGHT int ;
+             DUP ;
+             NIL operation ;
+             PAIR ;
+             DIP { DROP 2 } } } |}]

src/bin/expect_tests/michelson_pair_test.ml

@@ -44,3 +44,17 @@ let%expect_test _ =
              NIL operation ;
              PAIR ;
              DIP { DROP } } } |}]
+
+let%expect_test _ =
+  run_ligo_good [ "compile-contract" ; contract "michelson_pair_tree_intermediary.ligo" ; "main" ] ;
+  [%expect {|
+    { parameter unit ;
+      storage (pair (string %three) (pair (int %one) (nat %two))) ;
+      code { PUSH nat 2 ;
+             PUSH int 1 ;
+             PAIR ;
+             PUSH string "foo" ;
+             PAIR ;
+             NIL operation ;
+             PAIR ;
+             DIP { DROP } } } |}]

src/passes/10-transpiler/transpiler.ml

@@ -282,7 +282,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
       let%bind m' = Append_tree.fold_ne
                       (fun (_, ({ctor_type ; michelson_annotation}: AST.ctor_content)) ->
                         let%bind a = transpile_type ctor_type in
-                        ok (michelson_annotation, a) )
+                        ok (Ast_typed.Helpers.remove_empty_annotation michelson_annotation, a) )
                       aux node in
       ok @@ snd m'
   | T_sum m ->
@@ -308,7 +308,7 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
       let%bind m' = Append_tree.fold_ne
                       (fun (_, ({field_type ; michelson_annotation} : AST.field_content)) ->
                         let%bind a = transpile_type field_type in
-                        ok (michelson_annotation, a) )
+                        ok (Ast_typed.Helpers.remove_empty_annotation michelson_annotation, a) )
                       aux node in
       ok @@ snd m'
   | T_record m ->

src/stages/4-ast_typed/helpers.ml

@@ -166,12 +166,18 @@ let kv_list_of_record_or_tuple (m: _ LMap.t) =
     List.rev @@ LMap.to_kv_list m
 
 
+let remove_empty_annotation (ann : string option) : string option =
+  match ann with
+  | Some "" -> None
+  | _ -> ann
+
 let is_michelson_or (t: _ constructor_map) =
   CMap.cardinal t = 2 && 
   (CMap.mem (Constructor "M_left") t) &&
   (CMap.mem (Constructor "M_right") t)
 
 let is_michelson_pair (t: _ label_map) =
+  LMap.cardinal t = 2 && 
   let l = LMap.to_list t in
   List.fold_left
     (fun prev {field_type=_;michelson_annotation} -> match michelson_annotation with

src/test/contracts/michelson_or_tree_intermediary.ligo

@@ -0,0 +1,8 @@
+type inner_storage is michelson_or(int,"one",nat,"two")
+type storage is michelson_or (int,"three",inner_storage,"")
+
+type return is list(operation) * storage
+
+function main (const action : unit; const store : storage) : return is block {
+  const foo : storage = (M_right ((M_left(1) : inner_storage)) : storage) ;
+} with ((nil : list(operation)), (foo: storage))

src/test/contracts/michelson_pair_tree_intermediary.ligo

@@ -0,0 +1,8 @@
+type inner_storage is michelson_pair(int,"one",nat,"two")
+type storage is michelson_pair (string,"three",inner_storage,"")
+
+type return is list(operation) * storage
+
+function main (const action : unit; const store : storage) : return is block {
+  const foo : storage = ("foo",(1,2n)) ;
+} with ((nil : list(operation)), (foo: storage))