Merge branch 'feature/carthage-comparable-pairs' into 'dev'

[LIGO-460] Feature/carthage comparable pairs

See merge request ligolang/ligo!419

src/bin/expect_tests/typer_error_tests.ml

@@ -114,4 +114,25 @@ let%expect_test _ =
     * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
     * 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' |}] ;
+    * Check the changelog by running 'ligo changelog' |}]
+
+(* 
+  This test is here to ensure compatibility with comparable pairs introduced in carthage
+  note that only "comb pairs" are allowed to be compared (would be beter if any pair would be comparable ?)
+*)
+let%expect_test _ =
+  run_ligo_good [ "interpret" ; "Set.literal [ (1,(2,3)) ; (2,(3,4)) ]" ; "--syntax=cameligo" ] ;
+  [%expect {|
+    set[( 2 , ( 3 , 4 ) ) , ( 1 , ( 2 , 3 ) )] |}];
+
+  run_ligo_bad [ "interpret" ; "Set.literal [ (1,2,3) ; (2,3,4) ]" ; "--syntax=cameligo" ] ;
+  [%expect {|
+    ligo: not a comparable type: pair (use (a,(b,c)) instead of (a,b,c))
+
+     If you're not sure how to fix this error, you can
+     do one of the following:
+
+    * Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
+    * 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' |}];

src/passes/8-compiler/compiler_type.ml

@@ -20,6 +20,7 @@ module Ty = struct
   let address_k = Address_key None
   let timestamp_k = Timestamp_key None
   let bytes_k = Bytes_key None
+  let pair_k a b = Pair_key ((a,None),(b,None),None)
   (* let timestamp_k = Timestamp_key None *)
 
   let unit = Unit_t None
@@ -77,12 +78,30 @@ module Ty = struct
     | TC_key_hash -> return key_hash_k
     | TC_chain_id -> fail (not_comparable "chain_id")
 
-  let comparable_type : type_value -> ex_comparable_ty result = fun tv ->
+  let comparable_leaf : type a. (a, _) comparable_struct -> (a , leaf) comparable_struct result =
+      fun a ->
+    match a with
+    | Pair_key _ -> fail (not_comparable "pair (use (a,(b,c)) instead of (a,b,c))")
+    | Int_key annot -> ok (Int_key annot)
+    | Nat_key annot -> ok (Nat_key annot)
+    | String_key annot -> ok (String_key annot)
+    | Bytes_key annot -> ok (Bytes_key annot)
+    | Mutez_key annot -> ok (Mutez_key annot)
+    | Bool_key annot -> ok (Bool_key annot)
+    | Key_hash_key annot -> ok (Key_hash_key annot)
+    | Timestamp_key annot -> ok (Timestamp_key annot)
+    | Address_key annot -> ok (Address_key annot)
+
+  let rec comparable_type : type_value -> ex_comparable_ty result = fun tv ->
     match tv with
     | T_base b -> comparable_type_base b
     | T_function _ -> fail (not_comparable "function")
     | T_or _ -> fail (not_comparable "or")
-    | T_pair _ -> fail (not_comparable "pair")
+    | T_pair ((_,a),(_,b)) ->
+      let%bind (Ex_comparable_ty a') = comparable_type a in
+      let%bind (Ex_comparable_ty b') = comparable_type b in
+      let%bind a'' = comparable_leaf a' in
+      ok @@ Ex_comparable_ty (pair_k a'' b')
     | T_map _ -> fail (not_comparable "map")
     | T_big_map _ -> fail (not_comparable "big_map")
     | T_list _ -> fail (not_comparable "list")