Merge branch 'feature/carthage-comparable-pairs' into 'dev'
[LIGO-460] Feature/carthage comparable pairs See merge request ligolang/ligo!419
This commit is contained in:
commit
abfd561ffb
@ -111,6 +111,27 @@ let%expect_test _ =
|
|||||||
If you're not sure how to fix this error, you can
|
If you're not sure how to fix this error, you can
|
||||||
do one of the following:
|
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' |}]
|
||||||
|
|
||||||
|
(*
|
||||||
|
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/
|
* Visit our documentation: https://ligolang.org/docs/intro/what-and-why/
|
||||||
* Ask a question on our Discord: https://discord.gg/9rhYaEt
|
* Ask a question on our Discord: https://discord.gg/9rhYaEt
|
||||||
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
|
* Open a gitlab issue: https://gitlab.com/ligolang/ligo/issues/new
|
||||||
|
@ -20,6 +20,7 @@ module Ty = struct
|
|||||||
let address_k = Address_key None
|
let address_k = Address_key None
|
||||||
let timestamp_k = Timestamp_key None
|
let timestamp_k = Timestamp_key None
|
||||||
let bytes_k = Bytes_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 timestamp_k = Timestamp_key None *)
|
||||||
|
|
||||||
let unit = Unit_t None
|
let unit = Unit_t None
|
||||||
@ -77,12 +78,30 @@ module Ty = struct
|
|||||||
| TC_key_hash -> return key_hash_k
|
| TC_key_hash -> return key_hash_k
|
||||||
| TC_chain_id -> fail (not_comparable "chain_id")
|
| 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
|
match tv with
|
||||||
| T_base b -> comparable_type_base b
|
| T_base b -> comparable_type_base b
|
||||||
| T_function _ -> fail (not_comparable "function")
|
| T_function _ -> fail (not_comparable "function")
|
||||||
| T_or _ -> fail (not_comparable "or")
|
| 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_map _ -> fail (not_comparable "map")
|
||||||
| T_big_map _ -> fail (not_comparable "big_map")
|
| T_big_map _ -> fail (not_comparable "big_map")
|
||||||
| T_list _ -> fail (not_comparable "list")
|
| T_list _ -> fail (not_comparable "list")
|
||||||
|
Loading…
Reference in New Issue
Block a user