Merge branch 'feature/fix-michelson-pair-detection' into 'dev'

now check the label to detect michelson pairs

Closes #183

See merge request ligolang/ligo!602

src/bin/expect_tests/michelson_converter.ml

@@ -180,4 +180,26 @@ let%expect_test _ =
   [%expect {|
     { parameter (pair (pair (int %foo) (nat %bar)) (string %baz)) ;
       storage unit ;
-      code { UNIT ; NIL operation ; PAIR ; DIP { DROP } } } |}]
+      code { UNIT ; NIL operation ; PAIR ; DIP { DROP } } } |}]
+
+let%expect_test _ =
+  run_ligo_good [ "compile-contract" ; (contract "michelson_converter_mixed_pair_or.mligo") ; "main2" ] ;
+  [%expect {|
+    { parameter
+        (or (pair %option1 (string %bar) (nat %baz)) (pair %option2 (string %bar) (nat %baz))) ;
+      storage nat ;
+      code { DUP ;
+             CAR ;
+             IF_LEFT
+               { DUP ; LEFT (pair (string %bar) (nat %baz)) ; DIP { DROP } }
+               { DUP ; RIGHT (pair (string %bar) (nat %baz)) ; DIP { DROP } } ;
+             DUP ;
+             IF_LEFT
+               { DUP ; LEFT (pair (string %bar) (nat %baz)) ; DIP { DROP } }
+               { DUP ; RIGHT (pair (string %bar) (nat %baz)) ; DIP { DROP } } ;
+             DIP { DROP } ;
+             DUP ;
+             IF_LEFT
+               { DUP ; CDR ; NIL operation ; PAIR ; DIP { DROP } }
+               { DUP ; CDR ; NIL operation ; PAIR ; DIP { DROP } } ;
+             DIP { DROP 2 } } } |}]

src/stages/4-ast_typed/helpers.ml

@@ -179,4 +179,5 @@ let is_michelson_pair (t: _ label_map) =
       | Some _ -> true
       | None -> prev)
     false 
-    l
+    l &&
+  List.for_all (fun i -> LMap.mem i t) @@ (label_range 0 (LMap.cardinal t))

src/test/contracts/michelson_converter_mixed_pair_or.mligo

@@ -0,0 +1,34 @@
+
+type foo = {
+  bar : string;
+  baz : nat;
+}
+
+type foo_michelson = foo michelson_pair_right_comb
+
+type union1 =
+| Choice1 of foo
+| Choice2 of foo
+
+type union1_aux =
+| Option1 of foo_michelson
+| Option2 of foo_michelson
+
+type union1_michelson = union1_aux michelson_or_right_comb
+
+let union1_from_michelson (m : union1_michelson) : union1 =
+ let aux : union1_aux = Layout.convert_from_right_comb m in
+ match aux with
+ | Option1 fm ->
+  let f : foo = Layout.convert_from_right_comb fm in
+  Choice1 f
+| Option2 fm ->
+  let f : foo = Layout.convert_from_right_comb fm in
+  Choice2 f
+
+let main2 (pm, s : union1_michelson * nat) =
+  let p = union1_from_michelson pm in
+  match p with
+  | Choice1 f -> ([] : operation list), f.baz
+  | Choice2 f -> ([] : operation list), f.baz
+