diff --git a/src/bin/expect_tests/typer_error_tests.ml b/src/bin/expect_tests/typer_error_tests.ml index 041fb2e93..4aa7b95e8 100644 --- a/src/bin/expect_tests/typer_error_tests.ml +++ b/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' |}]; \ No newline at end of file diff --git a/src/passes/8-compiler/compiler_type.ml b/src/passes/8-compiler/compiler_type.ml index 9e7d874b0..c4874ef38 100644 --- a/src/passes/8-compiler/compiler_type.ml +++ b/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")