diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst index d1110e8e078e373bce869459c5bd78e2525ee3ef..40d4f92cd94b163dbe6c79542f04343b79935d05 100644 --- a/docs/protocols/alpha.rst +++ b/docs/protocols/alpha.rst @@ -53,6 +53,9 @@ Michelson - Variable annotations in pairs are ignored and not propagated. (MR :gl:`!4140`) +- Type annotations are ignored and not propagated. + (MR :gl:`!4141`) + Internal -------- diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml index fc28a39a99c7ac5de2231ea1ab04fbfd7e0f00e1..a00f7ec100885e00f350d8b129f5b039dd959a4a 100644 --- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml +++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml @@ -289,43 +289,42 @@ end) let type_of_atomic_type_name (at_tn : atomic_type_name) : Script_ir_translator.ex_ty = match at_tn with - | `TString -> Ex_ty (string_t ~annot:None) - | `TNat -> Ex_ty (nat_t ~annot:None) - | `TKey -> Ex_ty (key_t ~annot:None) - | `TBytes -> Ex_ty (bytes_t ~annot:None) - | `TBool -> Ex_ty (bool_t ~annot:None) - | `TAddress -> Ex_ty (address_t ~annot:None) - | `TTimestamp -> Ex_ty (timestamp_t ~annot:None) - | `TKey_hash -> Ex_ty (key_hash_t ~annot:None) - | `TMutez -> Ex_ty (mutez_t ~annot:None) - | `TSignature -> Ex_ty (signature_t ~annot:None) - | `TUnit -> Ex_ty (unit_t ~annot:None) - | `TInt -> Ex_ty (int_t ~annot:None) - | `TSapling_state -> Ex_ty (sapling_state_t ~memo_size ~annot:None) - | `TSapling_transaction -> - Ex_ty (sapling_transaction_t ~memo_size ~annot:None) - | `TChain_id -> Ex_ty (chain_id_t ~annot:None) - | `TBls12_381_g1 -> Ex_ty (bls12_381_g1_t ~annot:None) - | `TBls12_381_g2 -> Ex_ty (bls12_381_g2_t ~annot:None) - | `TBls12_381_fr -> Ex_ty (bls12_381_fr_t ~annot:None) + | `TString -> Ex_ty string_t + | `TNat -> Ex_ty nat_t + | `TKey -> Ex_ty key_t + | `TBytes -> Ex_ty bytes_t + | `TBool -> Ex_ty bool_t + | `TAddress -> Ex_ty address_t + | `TTimestamp -> Ex_ty timestamp_t + | `TKey_hash -> Ex_ty key_hash_t + | `TMutez -> Ex_ty mutez_t + | `TSignature -> Ex_ty signature_t + | `TUnit -> Ex_ty unit_t + | `TInt -> Ex_ty int_t + | `TSapling_state -> Ex_ty (sapling_state_t ~memo_size) + | `TSapling_transaction -> Ex_ty (sapling_transaction_t ~memo_size) + | `TChain_id -> Ex_ty chain_id_t + | `TBls12_381_g1 -> Ex_ty bls12_381_g1_t + | `TBls12_381_g2 -> Ex_ty bls12_381_g2_t + | `TBls12_381_fr -> Ex_ty bls12_381_fr_t let comparable_type_of_comparable_atomic_type_name (cmp_tn : 'a comparable_and_atomic) : Script_ir_translator.ex_comparable_ty = match cmp_tn with - | `TString -> Ex_comparable_ty (string_key ~annot:None) - | `TNat -> Ex_comparable_ty (nat_key ~annot:None) - | `TBytes -> Ex_comparable_ty (bytes_key ~annot:None) - | `TBool -> Ex_comparable_ty (bool_key ~annot:None) - | `TAddress -> Ex_comparable_ty (address_key ~annot:None) - | `TTimestamp -> Ex_comparable_ty (timestamp_key ~annot:None) - | `TKey_hash -> Ex_comparable_ty (key_hash_key ~annot:None) - | `TMutez -> Ex_comparable_ty (mutez_key ~annot:None) - | `TInt -> Ex_comparable_ty (int_key ~annot:None) - | `TUnit -> Ex_comparable_ty (unit_key ~annot:None) - | `TSignature -> Ex_comparable_ty (signature_key ~annot:None) - | `TKey -> Ex_comparable_ty (key_key ~annot:None) - | `TChain_id -> Ex_comparable_ty (chain_id_key ~annot:None) + | `TString -> Ex_comparable_ty string_key + | `TNat -> Ex_comparable_ty nat_key + | `TBytes -> Ex_comparable_ty bytes_key + | `TBool -> Ex_comparable_ty bool_key + | `TAddress -> Ex_comparable_ty address_key + | `TTimestamp -> Ex_comparable_ty timestamp_key + | `TKey_hash -> Ex_comparable_ty key_hash_key + | `TMutez -> Ex_comparable_ty mutez_key + | `TInt -> Ex_comparable_ty int_key + | `TUnit -> Ex_comparable_ty unit_key + | `TSignature -> Ex_comparable_ty signature_key + | `TKey -> Ex_comparable_ty key_key + | `TChain_id -> Ex_comparable_ty chain_id_key let rec m_type ~size : Script_ir_translator.ex_ty sampler = let open Script_ir_translator in @@ -340,27 +339,27 @@ end) @@ function | `TOption -> ( let* (Ex_ty t) = m_type ~size:1 in - match option_t (-1) t ~annot:None with + match option_t (-1) t with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TList -> ( let* (Ex_ty t) = m_type ~size:1 in - match list_t (-1) t ~annot:None with + match list_t (-1) t with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TSet -> ( let* (Ex_comparable_ty t) = m_comparable_type ~size:1 in - match set_t (-1) t ~annot:None with + match set_t (-1) t with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TTicket -> ( let* (Ex_comparable_ty contents) = m_comparable_type ~size:1 in - match ticket_t (-1) contents ~annot:None with + match ticket_t (-1) contents with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TContract -> ( let* (Ex_ty t) = m_type ~size:1 in - match contract_t (-1) t ~annot:None with + match contract_t (-1) t with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) else @@ -369,57 +368,57 @@ end) let* (lsize, rsize) = pick_split (size - 1) in let* (Ex_ty left) = m_type ~size:lsize in let* (Ex_ty right) = m_type ~size:rsize in - match pair_t (-1) (left, None) (right, None) ~annot:None with + match pair_t (-1) (left, None) (right, None) with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TLambda -> ( let* (lsize, rsize) = pick_split (size - 1) in let* (Ex_ty domain) = m_type ~size:lsize in let* (Ex_ty range) = m_type ~size:rsize in - match lambda_t (-1) domain range ~annot:None with + match lambda_t (-1) domain range with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TUnion -> ( let* (lsize, rsize) = pick_split (size - 1) in let* (Ex_ty left) = m_type ~size:lsize in let* (Ex_ty right) = m_type ~size:rsize in - match union_t (-1) (left, None) (right, None) ~annot:None with + match union_t (-1) (left, None) (right, None) with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TOption -> ( let* (Ex_ty t) = m_type ~size:(size - 1) in - match option_t (-1) t ~annot:None with + match option_t (-1) t with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TMap -> ( let* (lsize, rsize) = pick_split (size - 1) in let* (Ex_comparable_ty key) = m_comparable_type ~size:lsize in let* (Ex_ty elt) = m_type ~size:rsize in - match map_t (-1) key elt ~annot:None with + match map_t (-1) key elt with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TSet -> ( let* (Ex_comparable_ty key_ty) = m_comparable_type ~size:(size - 1) in - match set_t (-1) key_ty ~annot:None with + match set_t (-1) key_ty with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TList -> ( let* (Ex_ty elt) = m_type ~size:(size - 1) in - match list_t (-1) elt ~annot:None with + match list_t (-1) elt with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TTicket -> ( let* (Ex_comparable_ty contents) = m_comparable_type ~size:(size - 1) in - match ticket_t (-1) contents ~annot:None with + match ticket_t (-1) contents with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TContract -> ( let* (Ex_ty t) = m_type ~size:(size - 1) in - match contract_t (-1) t ~annot:None with + match contract_t (-1) t with | Error _ -> assert false | Ok res_ty -> return @@ Ex_ty res_ty) | `TBig_map -> @@ -437,7 +436,7 @@ end) let option_case size = let size = size - 1 in let* (Ex_comparable_ty t) = m_comparable_type ~size in - match option_key (-1) t ~annot:None with + match option_key (-1) t with | Error _ -> (* what should be done here? *) assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in @@ -449,7 +448,7 @@ end) let size_right = size - size_left in let* (Ex_comparable_ty l) = m_comparable_type ~size:size_left in let* (Ex_comparable_ty r) = m_comparable_type ~size:size_right in - match pair_key (-1) (l, None) (r, None) ~annot:None with + match pair_key (-1) (l, None) (r, None) with | Error _ -> assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in @@ -461,7 +460,7 @@ end) let size_right = size - size_left in let* (Ex_comparable_ty l) = m_comparable_type ~size:size_left in let* (Ex_comparable_ty r) = m_comparable_type ~size:size_right in - match union_key (-1) (l, None) (r, None) ~annot:None with + match union_key (-1) (l, None) (r, None) with | Error _ -> assert false | Ok res_ty -> return @@ Ex_comparable_ty res_ty in @@ -640,7 +639,7 @@ end) ( Execution_context.make ~rng_state >>=? fun (ctxt, _) -> let big_map = Script_ir_translator.empty_big_map key_ty elt_ty in (* Cannot have big maps under big maps *) - option_t (-1) elt_ty ~annot:None |> Environment.wrap_tzresult + option_t (-1) elt_ty |> Environment.wrap_tzresult >>?= fun opt_elt_ty -> let map = generate_map key_ty opt_elt_ty rng_state in Script_map.fold @@ -666,7 +665,7 @@ end) arg Script_typed_ir.ty -> arg Script_typed_ir.typed_contract sampler = fun arg_ty -> let open M in - let* address = value (address_t ~annot:None) in + let* address = value address_t in return {arg_ty; address} and generate_operation : Script_typed_ir.operation sampler = diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml index c89d4241b00888542e034a421c92ad3bd5edac32..b7cd662b07a89288f5c80c30991a43ef99b1c667 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_benchmarks.ml @@ -1421,7 +1421,7 @@ module Registration_section = struct (Lwt_main.run ( Execution_context.make ~rng_state >>=? fun (ctxt, _) -> let big_map = - Script_ir_translator.empty_big_map int_cmp (unit_t ~annot:None) + Script_ir_translator.empty_big_map int_cmp unit_t in Script_map.fold (fun k v acc -> @@ -1558,9 +1558,7 @@ module Registration_section = struct let (_, (module Samplers)) = make_default_samplers cfg.sampler in fun () -> let string = - Samplers.Random_value.value - Script_typed_ir.(string_t ~annot:None) - rng_state + Samplers.Random_value.value Script_typed_ir.string_t rng_state in let len = nat_of_positive_int (length string) in (* worst case: offset = 0 *) @@ -1606,9 +1604,7 @@ module Registration_section = struct let (_, (module Samplers)) = make_default_samplers cfg.sampler in fun () -> let bytes = - Samplers.Random_value.value - Script_typed_ir.(bytes_t ~annot:None) - rng_state + Samplers.Random_value.value Script_typed_ir.bytes_t rng_state in let len = nat_of_positive_int (Bytes.length bytes) in (* worst case: offset = 0 *) @@ -2279,10 +2275,7 @@ module Registration_section = struct let (_pkh, pk, sk) = Crypto_samplers.all rng_state in let unsigned_message = if for_intercept then Environment.Bytes.empty - else - Samplers.Random_value.value - Script_typed_ir.(bytes_t ~annot:None) - rng_state + else Samplers.Random_value.value Script_typed_ir.bytes_t rng_state in let signed_message = Signature.sign sk unsigned_message in let signed_message = Script_signature.make signed_message in diff --git a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml index 5569ca6340daf9301f81b12ecdb91db45ad1b958..9befe563374556c7d1f4e41f04ee3e708433da94 100644 --- a/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml +++ b/src/proto_alpha/lib_benchmarks_proto/michelson_types.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2021-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -32,107 +32,99 @@ let ( @$ ) x y = Item_t (x, y) let bot = Bot_t -let unit = unit_t ~annot:None +let unit = unit_t -let unit_cmp = unit_key ~annot:None +let unit_cmp = unit_key -let int_cmp = int_key ~annot:None +let int_cmp = int_key -let string_cmp = string_key ~annot:None +let string_cmp = string_key (* the type of integers *) -let int = int_t ~annot:None +let int = int_t (* the type of naturals *) -let nat = nat_t ~annot:None +let nat = nat_t (* the type of strings *) -let string = string_t ~annot:None +let string = string_t (* the type of bytes *) -let bytes = bytes_t ~annot:None +let bytes = bytes_t (* the type of booleans *) -let bool = bool_t ~annot:None +let bool = bool_t (* the type of mutez *) -let mutez = mutez_t ~annot:None +let mutez = mutez_t (* the type of public key *) -let public_key = key_t ~annot:None +let public_key = key_t (* the type of key hashes *) -let key_hash = key_hash_t ~annot:None +let key_hash = key_hash_t (* the type of signatures *) -let signature = signature_t ~annot:None +let signature = signature_t (* the type of addresses *) -let address = address_t ~annot:None +let address = address_t (* the type of chain ids *) -let chain_id = chain_id_t ~annot:None +let chain_id = chain_id_t (* the type of timestamps *) -let timestamp = timestamp_t ~annot:None +let timestamp = timestamp_t (* list type constructor *) -let list x = - match list_t (-1) x ~annot:None with Error _ -> assert false | Ok t -> t +let list x = match list_t (-1) x with Error _ -> assert false | Ok t -> t (* option type constructor *) -let option x = - match option_t (-1) x ~annot:None with Error _ -> assert false | Ok t -> t +let option x = match option_t (-1) x with Error _ -> assert false | Ok t -> t (* map type constructor*) -let map k v = - match map_t (-1) k v ~annot:None with Error _ -> assert false | Ok t -> t +let map k v = match map_t (-1) k v with Error _ -> assert false | Ok t -> t (* map type constructor*) let big_map k v = - match big_map_t (-1) k v ~annot:None with - | Error _ -> assert false - | Ok t -> t + match big_map_t (-1) k v with Error _ -> assert false | Ok t -> t (* set type constructor*) -let set k = - match set_t (-1) k ~annot:None with Error _ -> assert false | Ok t -> t +let set k = match set_t (-1) k with Error _ -> assert false | Ok t -> t (* pair type constructor*) let pair k1 k2 = - match pair_t (-1) (k1, None) (k2, None) ~annot:None with + match pair_t (-1) (k1, None) (k2, None) with | Error _ -> assert false | Ok t -> t (* union type constructor*) let union k1 k2 = - match union_t (-1) (k1, None) (k2, None) ~annot:None with + match union_t (-1) (k1, None) (k2, None) with | Error _ -> assert false | Ok t -> t let lambda x y = - match lambda_t (-1) x y ~annot:None with Error _ -> assert false | Ok t -> t + match lambda_t (-1) x y with Error _ -> assert false | Ok t -> t let contract arg_ty = - match contract_t (-1) arg_ty ~annot:None with - | Error _ -> assert false - | Ok t -> t + match contract_t (-1) arg_ty with Error _ -> assert false | Ok t -> t -let operation = operation_t ~annot:None +let operation = operation_t -let sapling_state memo_size = sapling_state_t ~memo_size ~annot:None +let sapling_state memo_size = sapling_state_t ~memo_size -let sapling_transaction memo_size = sapling_transaction_t ~memo_size ~annot:None +let sapling_transaction memo_size = sapling_transaction_t ~memo_size -let bls12_381_g1 = bls12_381_g1_t ~annot:None +let bls12_381_g1 = bls12_381_g1_t -let bls12_381_g2 = bls12_381_g2_t ~annot:None +let bls12_381_g2 = bls12_381_g2_t -let bls12_381_fr = bls12_381_fr_t ~annot:None +let bls12_381_fr = bls12_381_fr_t let ticket ty = - match ticket_t (-1) ty ~annot:None with Error _ -> assert false | Ok t -> t + match ticket_t (-1) ty with Error _ -> assert false | Ok t -> t -let chest_key = chest_key_t ~annot:None +let chest_key = chest_key_t -let chest = chest_t ~annot:None +let chest = chest_t diff --git a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml index 03c225cbce16f92c6181494fab93f4a24eea6dde..82eec3c31975879fa83000062cba030df8d3dab8 100644 --- a/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml +++ b/src/proto_alpha/lib_benchmarks_proto/translator_benchmarks.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2021-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -619,13 +619,13 @@ let () = Registration_helpers.register (module Merge_types) let rec dummy_type_generator size = let open Script_ir_translator in let open Script_typed_ir in - if size <= 1 then Ex_ty (unit_t ~annot:None) + if size <= 1 then Ex_ty unit_t else match dummy_type_generator (size - 2) with | Ex_ty r -> - let l = unit_t ~annot:None in + let l = unit_t in Ex_ty - (match pair_t (-1) (l, None) (r, None) ~annot:None with + (match pair_t (-1) (l, None) (r, None) with | Error _ -> assert false | Ok t -> t) @@ -633,13 +633,13 @@ let rec dummy_type_generator size = let rec dummy_comparable_type_generator size = let open Script_ir_translator in let open Script_typed_ir in - if size <= 0 then Ex_comparable_ty (unit_key ~annot:None) + if size <= 0 then Ex_comparable_ty unit_key else match dummy_comparable_type_generator (size - 2) with | Ex_comparable_ty r -> - let l = unit_key ~annot:None in + let l = unit_key in Ex_comparable_ty - (match pair_key (-1) (l, None) (r, None) ~annot:None with + (match pair_key (-1) (l, None) (r, None) with | Error _ -> assert false | Ok t -> t) diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml index 1270254f0ffbeadabb8fe1c3099deceba89bcfee..050a5abfcb137a52f5bf93cd0ec19ea7b2f8b9d7 100644 --- a/src/proto_alpha/lib_plugin/plugin.ml +++ b/src/proto_alpha/lib_plugin/plugin.ml @@ -2,7 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Nomadic Development. *) -(* Copyright (c) 2021 Nomadic Labs, *) +(* Copyright (c) 2021-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -1914,50 +1914,36 @@ module RPC = struct open Script_ir_translator open Micheline open Michelson_v1_primitives - open Script_ir_annot open Script_typed_ir let rec unparse_comparable_ty : type a loc. loc:loc -> a comparable_ty -> (loc, Script.prim) Micheline.node = fun ~loc -> function - | Unit_key meta -> Prim (loc, T_unit, [], unparse_type_annot meta.annot) - | Never_key meta -> - Prim (loc, T_never, [], unparse_type_annot meta.annot) - | Int_key meta -> Prim (loc, T_int, [], unparse_type_annot meta.annot) - | Nat_key meta -> Prim (loc, T_nat, [], unparse_type_annot meta.annot) - | Signature_key meta -> - Prim (loc, T_signature, [], unparse_type_annot meta.annot) - | String_key meta -> - Prim (loc, T_string, [], unparse_type_annot meta.annot) - | Bytes_key meta -> - Prim (loc, T_bytes, [], unparse_type_annot meta.annot) - | Mutez_key meta -> - Prim (loc, T_mutez, [], unparse_type_annot meta.annot) - | Bool_key meta -> Prim (loc, T_bool, [], unparse_type_annot meta.annot) - | Key_hash_key meta -> - Prim (loc, T_key_hash, [], unparse_type_annot meta.annot) - | Key_key meta -> Prim (loc, T_key, [], unparse_type_annot meta.annot) - | Timestamp_key meta -> - Prim (loc, T_timestamp, [], unparse_type_annot meta.annot) - | Address_key meta -> - Prim (loc, T_address, [], unparse_type_annot meta.annot) - | Chain_id_key meta -> - Prim (loc, T_chain_id, [], unparse_type_annot meta.annot) - | Pair_key ((l, al), (r, ar), meta) -> + | Unit_key _meta -> Prim (loc, T_unit, [], []) + | Never_key _meta -> Prim (loc, T_never, [], []) + | Int_key _meta -> Prim (loc, T_int, [], []) + | Nat_key _meta -> Prim (loc, T_nat, [], []) + | Signature_key _meta -> Prim (loc, T_signature, [], []) + | String_key _meta -> Prim (loc, T_string, [], []) + | Bytes_key _meta -> Prim (loc, T_bytes, [], []) + | Mutez_key _meta -> Prim (loc, T_mutez, [], []) + | Bool_key _meta -> Prim (loc, T_bool, [], []) + | Key_hash_key _meta -> Prim (loc, T_key_hash, [], []) + | Key_key _meta -> Prim (loc, T_key, [], []) + | Timestamp_key _meta -> Prim (loc, T_timestamp, [], []) + | Address_key _meta -> Prim (loc, T_address, [], []) + | Chain_id_key _meta -> Prim (loc, T_chain_id, [], []) + | Pair_key ((l, al), (r, ar), _meta) -> let tl = add_field_annot al (unparse_comparable_ty ~loc l) in let tr = add_field_annot ar (unparse_comparable_ty ~loc r) in - Prim (loc, T_pair, [tl; tr], unparse_type_annot meta.annot) - | Union_key ((l, al), (r, ar), meta) -> + Prim (loc, T_pair, [tl; tr], []) + | Union_key ((l, al), (r, ar), _meta) -> let tl = add_field_annot al (unparse_comparable_ty ~loc l) in let tr = add_field_annot ar (unparse_comparable_ty ~loc r) in - Prim (loc, T_or, [tl; tr], unparse_type_annot meta.annot) - | Option_key (t, meta) -> - Prim - ( loc, - T_option, - [unparse_comparable_ty ~loc t], - unparse_type_annot meta.annot ) + Prim (loc, T_or, [tl; tr], []) + | Option_key (t, _meta) -> + Prim (loc, T_option, [unparse_comparable_ty ~loc t], []) let unparse_memo_size ~loc memo_size = let z = Alpha_context.Sapling.Memo_size.unparse_to_z memo_size in @@ -1968,87 +1954,73 @@ module RPC = struct fun ~loc ty -> let return (name, args, annot) = Prim (loc, name, args, annot) in match ty with - | Unit_t meta -> return (T_unit, [], unparse_type_annot meta.annot) - | Int_t meta -> return (T_int, [], unparse_type_annot meta.annot) - | Nat_t meta -> return (T_nat, [], unparse_type_annot meta.annot) - | Signature_t meta -> - return (T_signature, [], unparse_type_annot meta.annot) - | String_t meta -> return (T_string, [], unparse_type_annot meta.annot) - | Bytes_t meta -> return (T_bytes, [], unparse_type_annot meta.annot) - | Mutez_t meta -> return (T_mutez, [], unparse_type_annot meta.annot) - | Bool_t meta -> return (T_bool, [], unparse_type_annot meta.annot) - | Key_hash_t meta -> - return (T_key_hash, [], unparse_type_annot meta.annot) - | Key_t meta -> return (T_key, [], unparse_type_annot meta.annot) - | Timestamp_t meta -> - return (T_timestamp, [], unparse_type_annot meta.annot) - | Address_t meta -> return (T_address, [], unparse_type_annot meta.annot) - | Operation_t meta -> - return (T_operation, [], unparse_type_annot meta.annot) - | Chain_id_t meta -> - return (T_chain_id, [], unparse_type_annot meta.annot) - | Never_t meta -> return (T_never, [], unparse_type_annot meta.annot) - | Bls12_381_g1_t meta -> - return (T_bls12_381_g1, [], unparse_type_annot meta.annot) - | Bls12_381_g2_t meta -> - return (T_bls12_381_g2, [], unparse_type_annot meta.annot) - | Bls12_381_fr_t meta -> - return (T_bls12_381_fr, [], unparse_type_annot meta.annot) - | Contract_t (ut, meta) -> + | Unit_t _meta -> return (T_unit, [], []) + | Int_t _meta -> return (T_int, [], []) + | Nat_t _meta -> return (T_nat, [], []) + | Signature_t _meta -> return (T_signature, [], []) + | String_t _meta -> return (T_string, [], []) + | Bytes_t _meta -> return (T_bytes, [], []) + | Mutez_t _meta -> return (T_mutez, [], []) + | Bool_t _meta -> return (T_bool, [], []) + | Key_hash_t _meta -> return (T_key_hash, [], []) + | Key_t _meta -> return (T_key, [], []) + | Timestamp_t _meta -> return (T_timestamp, [], []) + | Address_t _meta -> return (T_address, [], []) + | Operation_t _meta -> return (T_operation, [], []) + | Chain_id_t _meta -> return (T_chain_id, [], []) + | Never_t _meta -> return (T_never, [], []) + | Bls12_381_g1_t _meta -> return (T_bls12_381_g1, [], []) + | Bls12_381_g2_t _meta -> return (T_bls12_381_g2, [], []) + | Bls12_381_fr_t _meta -> return (T_bls12_381_fr, [], []) + | Contract_t (ut, _meta) -> let t = unparse_ty ~loc ut in - return (T_contract, [t], unparse_type_annot meta.annot) - | Pair_t ((utl, l_field), (utr, r_field), meta) -> - let annot = unparse_type_annot meta.annot in + return (T_contract, [t], []) + | Pair_t ((utl, l_field), (utr, r_field), _meta) -> + let annot = [] in let utl = unparse_ty ~loc utl in let tl = add_field_annot l_field utl in let utr = unparse_ty ~loc utr in let tr = add_field_annot r_field utr in return (T_pair, [tl; tr], annot) - | Union_t ((utl, l_field), (utr, r_field), meta) -> - let annot = unparse_type_annot meta.annot in + | Union_t ((utl, l_field), (utr, r_field), _meta) -> + let annot = [] in let utl = unparse_ty ~loc utl in let tl = add_field_annot l_field utl in let utr = unparse_ty ~loc utr in let tr = add_field_annot r_field utr in return (T_or, [tl; tr], annot) - | Lambda_t (uta, utr, meta) -> + | Lambda_t (uta, utr, _meta) -> let ta = unparse_ty ~loc uta in let tr = unparse_ty ~loc utr in - return (T_lambda, [ta; tr], unparse_type_annot meta.annot) - | Option_t (ut, meta) -> - let annot = unparse_type_annot meta.annot in + return (T_lambda, [ta; tr], []) + | Option_t (ut, _meta) -> + let annot = [] in let ut = unparse_ty ~loc ut in return (T_option, [ut], annot) - | List_t (ut, meta) -> + | List_t (ut, _meta) -> let t = unparse_ty ~loc ut in - return (T_list, [t], unparse_type_annot meta.annot) - | Ticket_t (ut, meta) -> + return (T_list, [t], []) + | Ticket_t (ut, _meta) -> let t = unparse_comparable_ty ~loc ut in - return (T_ticket, [t], unparse_type_annot meta.annot) - | Set_t (ut, meta) -> + return (T_ticket, [t], []) + | Set_t (ut, _meta) -> let t = unparse_comparable_ty ~loc ut in - return (T_set, [t], unparse_type_annot meta.annot) - | Map_t (uta, utr, meta) -> + return (T_set, [t], []) + | Map_t (uta, utr, _meta) -> let ta = unparse_comparable_ty ~loc uta in let tr = unparse_ty ~loc utr in - return (T_map, [ta; tr], unparse_type_annot meta.annot) - | Big_map_t (uta, utr, meta) -> + return (T_map, [ta; tr], []) + | Big_map_t (uta, utr, _meta) -> let ta = unparse_comparable_ty ~loc uta in let tr = unparse_ty ~loc utr in - return (T_big_map, [ta; tr], unparse_type_annot meta.annot) - | Sapling_transaction_t (memo_size, meta) -> + return (T_big_map, [ta; tr], []) + | Sapling_transaction_t (memo_size, _meta) -> return - ( T_sapling_transaction, - [unparse_memo_size ~loc memo_size], - unparse_type_annot meta.annot ) - | Sapling_state_t (memo_size, meta) -> - return - ( T_sapling_state, - [unparse_memo_size ~loc memo_size], - unparse_type_annot meta.annot ) - | Chest_t meta -> return (T_chest, [], unparse_type_annot meta.annot) - | Chest_key_t meta -> - return (T_chest_key, [], unparse_type_annot meta.annot) + (T_sapling_transaction, [unparse_memo_size ~loc memo_size], []) + | Sapling_state_t (memo_size, _meta) -> + return (T_sapling_state, [unparse_memo_size ~loc memo_size], []) + | Chest_t _meta -> return (T_chest, [], []) + | Chest_key_t _meta -> return (T_chest_key, [], []) end let run_operation_service ctxt () diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml index 04032bfaa65567b13f8392245a374fd49952a87d..dec735d47a3b283a3db560ab09bd6a7a47b39987 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml @@ -1427,9 +1427,7 @@ module Cost_of = struct let view_mem (elt : Script_string.t) (m : Script_typed_ir.view Script_typed_ir.SMap.t) = let open S_syntax in - let per_elt_cost = - compare (Script_typed_ir.string_key ~annot:None) elt elt - in + let per_elt_cost = compare Script_typed_ir.string_key elt elt in let size = S.safe_int (Script_typed_ir.SMap.cardinal m) in let intercept = atomic_step_cost (S.safe_int 80) in Gas.(intercept +@ (log2 size *@ per_elt_cost)) @@ -1439,9 +1437,7 @@ module Cost_of = struct let view_update (elt : Script_string.t) (m : Script_typed_ir.view Script_typed_ir.SMap.t) = let open S_syntax in - let per_elt_cost = - compare (Script_typed_ir.string_key ~annot:None) elt elt - in + let per_elt_cost = compare Script_typed_ir.string_key elt elt in let size = S.safe_int (Script_typed_ir.SMap.cardinal m) in let intercept = atomic_step_cost (S.safe_int 80) in Gas.(intercept +@ (S.safe_int 2 * log2 size *@ per_elt_cost)) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index 9846ee56642aa7966d0801ba80a78915d04ea08f..f15f7165c4467bbf53d2f739355fae5490611fca 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -1015,7 +1015,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack | IImplicit_account (_, k) -> let key = accu in - let arg_ty = unit_t ~annot:None in + let arg_ty = unit_t in let contract = Contract.implicit_contract key in let address = {contract; entrypoint = Entrypoint.default} in let res = {arg_ty; address} in @@ -1071,11 +1071,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = kinstr; }, _script_view ) -> ( - pair_t - kloc - (input_ty, None) - (storage_type, None) - ~annot:None + pair_t kloc (input_ty, None) (storage_type, None) >>?= fun pair_ty -> let open Gas_monad in let io_ty = diff --git a/src/proto_alpha/lib_protocol/script_ir_annot.ml b/src/proto_alpha/lib_protocol/script_ir_annot.ml index 01fa09bea1d81a7843f45f9583667f71ebbf400d..cae86bb3bd38955469691f7230954e897dfc55a4 100644 --- a/src/proto_alpha/lib_protocol/script_ir_annot.ml +++ b/src/proto_alpha/lib_protocol/script_ir_annot.ml @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -34,17 +35,10 @@ type type_annot = Type_annot of Non_empty_string.t [@@ocaml.unboxed] type field_annot = Field_annot of Non_empty_string.t [@@ocaml.unboxed] module FOR_TESTS = struct - let unsafe_type_annot_of_string s = - Type_annot (Non_empty_string.of_string_exn s) - let unsafe_field_annot_of_string s = Field_annot (Non_empty_string.of_string_exn s) end -let unparse_type_annot : type_annot option -> string list = function - | None -> [] - | Some (Type_annot a) -> [":" ^ (a :> string)] - let unparse_field_annot : field_annot option -> string list = function | None -> [] | Some (Field_annot a) -> ["%" ^ (a :> string)] @@ -61,27 +55,6 @@ let field_annot_opt_eq_entrypoint_lax field_annot_opt entrypoint = | None -> false | Some a' -> Entrypoint.(a' = entrypoint)) -let merge_type_annot : - type error_trace. - legacy:bool -> - error_details:error_trace error_details -> - type_annot option -> - type_annot option -> - (type_annot option, error_trace) result = - fun ~legacy ~error_details annot1 annot2 -> - match (annot1, annot2) with - | (None, None) | (Some _, None) | (None, Some _) -> Result.return_none - | (Some (Type_annot a1), Some (Type_annot a2)) -> - if legacy || Non_empty_string.(a1 = a2) then ok annot1 - else - Error - (match error_details with - | Fast -> Inconsistent_types_fast - | Informative -> - trace_of_error - @@ Inconsistent_annotations - (":" ^ (a1 :> string), ":" ^ (a2 :> string))) - let merge_field_annot : type error_trace. legacy:bool -> @@ -219,22 +192,22 @@ let get_two_annot loc = function | [a; b] -> ok (a, b) | _ -> error (Unexpected_annotation loc) -let parse_type_annot : - Script.location -> string list -> type_annot option tzresult = +let check_type_annot : Script.location -> string list -> unit tzresult = fun loc annot -> parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) -> error_unexpected_annot loc vars >>? fun () -> - error_unexpected_annot loc fields >>? fun () -> get_one_annot loc types + error_unexpected_annot loc fields >>? fun () -> + get_one_annot loc types >|? fun _a -> () let parse_composed_type_annot : Script.location -> string list -> - (type_annot option * field_annot option * field_annot option) tzresult = + (field_annot option * field_annot option) tzresult = fun loc annot -> parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) -> error_unexpected_annot loc vars >>? fun () -> - get_one_annot loc types >>? fun t -> - get_two_annot loc fields >|? fun (f1, f2) -> (t, f1, f2) + get_one_annot loc types >>? fun _t -> + get_two_annot loc fields >|? fun (f1, f2) -> (f1, f2) let parse_field_annot : Script.location -> string list -> field_annot option tzresult = @@ -287,15 +260,15 @@ let ignore_special f = let parse_constr_annot : Script.location -> string list -> - (type_annot option * field_annot option * field_annot option) tzresult = + (field_annot option * field_annot option) tzresult = fun loc annot -> parse_annots ~allow_special_field:true loc annot >>? classify_annot loc >>? fun (vars, types, fields) -> get_one_annot loc vars >>? fun (_v : var_annot option) -> - get_one_annot loc types >>? fun t -> + get_one_annot loc types >>? fun (_t : type_annot option) -> get_two_annot loc fields >>? fun (f1, f2) -> ignore_special f1 >>? fun f1 -> - ignore_special f2 >|? fun f2 -> (t, f1, f2) + ignore_special f2 >|? fun f2 -> (f1, f2) let check_two_var_annot : Script.location -> string list -> unit tzresult = fun loc annot -> @@ -331,10 +304,9 @@ let parse_entrypoint_annot : get_one_annot loc fields >>? fun f -> get_one_annot loc vars >|? fun (_v : var_annot option) -> f -let parse_var_type_annot : - Script.location -> string list -> type_annot option tzresult = +let check_var_type_annot : Script.location -> string list -> unit tzresult = fun loc annot -> parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) -> error_unexpected_annot loc fields >>? fun () -> get_one_annot loc vars >>? fun (_v : var_annot option) -> - get_one_annot loc types + get_one_annot loc types >|? fun (_t : type_annot option) -> () diff --git a/src/proto_alpha/lib_protocol/script_ir_annot.mli b/src/proto_alpha/lib_protocol/script_ir_annot.mli index cf7c5f0cb51d2f2b46d5df0cc762882c581e9464..7d6035356aa0fa9904d0feec3e0480ca6b86d9a6 100644 --- a/src/proto_alpha/lib_protocol/script_ir_annot.mli +++ b/src/proto_alpha/lib_protocol/script_ir_annot.mli @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. *) +(* Copyright (c) 2019-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -25,20 +26,14 @@ open Alpha_context -type type_annot = private Type_annot of Non_empty_string.t [@@ocaml.unboxed] - type field_annot = private Field_annot of Non_empty_string.t [@@ocaml.unboxed] module FOR_TESTS : sig - val unsafe_type_annot_of_string : string -> type_annot - val unsafe_field_annot_of_string : string -> field_annot end (** Unparse annotations to their string representation *) -val unparse_type_annot : type_annot option -> string list - val unparse_field_annot : field_annot option -> string list (** Converts a field annot option to an entrypoint. @@ -53,16 +48,6 @@ val field_annot_opt_to_entrypoint_strict : val field_annot_opt_eq_entrypoint_lax : field_annot option -> Entrypoint.t -> bool -(** Merge type annotations. - @return an error {!Inconsistent_type_annotations} if they are both present - and different, unless [legacy] *) -val merge_type_annot : - legacy:bool -> - error_details:'error_trace Script_tc_errors.error_details -> - type_annot option -> - type_annot option -> - (type_annot option, 'error_trace) result - (** Merge field annotations. @return an error {!Inconsistent_type_annotations} if they are both present and different, unless [legacy] *) @@ -77,8 +62,7 @@ val merge_field_annot : val error_unexpected_annot : Script.location -> 'a list -> unit tzresult (** Parse a type annotation only. *) -val parse_type_annot : - Script.location -> string list -> type_annot option tzresult +val check_type_annot : Script.location -> string list -> unit tzresult (** Parse a field annotation only. *) val parse_field_annot : @@ -89,7 +73,7 @@ val parse_field_annot : val parse_composed_type_annot : Script.location -> string list -> - (type_annot option * field_annot option * field_annot option) tzresult + (field_annot option * field_annot option) tzresult (** Extract and remove a field annotation from a node *) val extract_field_annot : @@ -109,7 +93,7 @@ val is_allowed_char : char -> bool val parse_constr_annot : Script.location -> string list -> - (type_annot option * field_annot option * field_annot option) tzresult + (field_annot option * field_annot option) tzresult val check_two_var_annot : Script.location -> string list -> unit tzresult @@ -124,5 +108,4 @@ val parse_unpair_annot : val parse_entrypoint_annot : Script.location -> string list -> field_annot option tzresult -val parse_var_type_annot : - Script.location -> string list -> type_annot option tzresult +val check_var_type_annot : Script.location -> string list -> unit tzresult diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index c0ba5ea23ca041cab1e2879916666f6860fc4041..fc8f93c9181b902248dd79eb0159a40e6819a6d7 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -186,44 +186,35 @@ let add_field_annot a = function let rec unparse_comparable_ty_uncarbonated : type a loc. loc:loc -> a comparable_ty -> loc Script.michelson_node = fun ~loc -> function - | Unit_key meta -> Prim (loc, T_unit, [], unparse_type_annot meta.annot) - | Never_key meta -> Prim (loc, T_never, [], unparse_type_annot meta.annot) - | Int_key meta -> Prim (loc, T_int, [], unparse_type_annot meta.annot) - | Nat_key meta -> Prim (loc, T_nat, [], unparse_type_annot meta.annot) - | Signature_key meta -> - Prim (loc, T_signature, [], unparse_type_annot meta.annot) - | String_key meta -> Prim (loc, T_string, [], unparse_type_annot meta.annot) - | Bytes_key meta -> Prim (loc, T_bytes, [], unparse_type_annot meta.annot) - | Mutez_key meta -> Prim (loc, T_mutez, [], unparse_type_annot meta.annot) - | Bool_key meta -> Prim (loc, T_bool, [], unparse_type_annot meta.annot) - | Key_hash_key meta -> - Prim (loc, T_key_hash, [], unparse_type_annot meta.annot) - | Key_key meta -> Prim (loc, T_key, [], unparse_type_annot meta.annot) - | Timestamp_key meta -> - Prim (loc, T_timestamp, [], unparse_type_annot meta.annot) - | Address_key meta -> Prim (loc, T_address, [], unparse_type_annot meta.annot) - | Chain_id_key meta -> - Prim (loc, T_chain_id, [], unparse_type_annot meta.annot) - | Pair_key ((l, al), (r, ar), meta) -> ( + | Unit_key _meta -> Prim (loc, T_unit, [], []) + | Never_key _meta -> Prim (loc, T_never, [], []) + | Int_key _meta -> Prim (loc, T_int, [], []) + | Nat_key _meta -> Prim (loc, T_nat, [], []) + | Signature_key _meta -> Prim (loc, T_signature, [], []) + | String_key _meta -> Prim (loc, T_string, [], []) + | Bytes_key _meta -> Prim (loc, T_bytes, [], []) + | Mutez_key _meta -> Prim (loc, T_mutez, [], []) + | Bool_key _meta -> Prim (loc, T_bool, [], []) + | Key_hash_key _meta -> Prim (loc, T_key_hash, [], []) + | Key_key _meta -> Prim (loc, T_key, [], []) + | Timestamp_key _meta -> Prim (loc, T_timestamp, [], []) + | Address_key _meta -> Prim (loc, T_address, [], []) + | Chain_id_key _meta -> Prim (loc, T_chain_id, [], []) + | Pair_key ((l, al), (r, ar), _meta) -> ( let tl = add_field_annot al (unparse_comparable_ty_uncarbonated ~loc l) in let tr = add_field_annot ar (unparse_comparable_ty_uncarbonated ~loc r) in (* Fold [pair a1 (pair ... (pair an-1 an))] into [pair a1 ... an] *) (* Note that the folding does not happen if the pair on the right has a field annotation because this annotation would be lost *) match tr with - | Prim (_, T_pair, ts, []) -> - Prim (loc, T_pair, tl :: ts, unparse_type_annot meta.annot) - | _ -> Prim (loc, T_pair, [tl; tr], unparse_type_annot meta.annot)) - | Union_key ((l, al), (r, ar), meta) -> + | Prim (_, T_pair, ts, []) -> Prim (loc, T_pair, tl :: ts, []) + | _ -> Prim (loc, T_pair, [tl; tr], [])) + | Union_key ((l, al), (r, ar), _meta) -> let tl = add_field_annot al (unparse_comparable_ty_uncarbonated ~loc l) in let tr = add_field_annot ar (unparse_comparable_ty_uncarbonated ~loc r) in - Prim (loc, T_or, [tl; tr], unparse_type_annot meta.annot) - | Option_key (t, meta) -> - Prim - ( loc, - T_option, - [unparse_comparable_ty_uncarbonated ~loc t], - unparse_type_annot meta.annot ) + Prim (loc, T_or, [tl; tr], []) + | Option_key (t, _meta) -> + Prim (loc, T_option, [unparse_comparable_ty_uncarbonated ~loc t], []) let unparse_memo_size ~loc memo_size = let z = Sapling.Memo_size.unparse_to_z memo_size in @@ -234,32 +225,29 @@ let rec unparse_ty_uncarbonated : fun ~loc ty -> let prim (name, args, annot) = Prim (loc, name, args, annot) in match ty with - | Unit_t meta -> prim (T_unit, [], unparse_type_annot meta.annot) - | Int_t meta -> prim (T_int, [], unparse_type_annot meta.annot) - | Nat_t meta -> prim (T_nat, [], unparse_type_annot meta.annot) - | Signature_t meta -> prim (T_signature, [], unparse_type_annot meta.annot) - | String_t meta -> prim (T_string, [], unparse_type_annot meta.annot) - | Bytes_t meta -> prim (T_bytes, [], unparse_type_annot meta.annot) - | Mutez_t meta -> prim (T_mutez, [], unparse_type_annot meta.annot) - | Bool_t meta -> prim (T_bool, [], unparse_type_annot meta.annot) - | Key_hash_t meta -> prim (T_key_hash, [], unparse_type_annot meta.annot) - | Key_t meta -> prim (T_key, [], unparse_type_annot meta.annot) - | Timestamp_t meta -> prim (T_timestamp, [], unparse_type_annot meta.annot) - | Address_t meta -> prim (T_address, [], unparse_type_annot meta.annot) - | Operation_t meta -> prim (T_operation, [], unparse_type_annot meta.annot) - | Chain_id_t meta -> prim (T_chain_id, [], unparse_type_annot meta.annot) - | Never_t meta -> prim (T_never, [], unparse_type_annot meta.annot) - | Bls12_381_g1_t meta -> - prim (T_bls12_381_g1, [], unparse_type_annot meta.annot) - | Bls12_381_g2_t meta -> - prim (T_bls12_381_g2, [], unparse_type_annot meta.annot) - | Bls12_381_fr_t meta -> - prim (T_bls12_381_fr, [], unparse_type_annot meta.annot) - | Contract_t (ut, meta) -> + | Unit_t _meta -> prim (T_unit, [], []) + | Int_t _meta -> prim (T_int, [], []) + | Nat_t _meta -> prim (T_nat, [], []) + | Signature_t _meta -> prim (T_signature, [], []) + | String_t _meta -> prim (T_string, [], []) + | Bytes_t _meta -> prim (T_bytes, [], []) + | Mutez_t _meta -> prim (T_mutez, [], []) + | Bool_t _meta -> prim (T_bool, [], []) + | Key_hash_t _meta -> prim (T_key_hash, [], []) + | Key_t _meta -> prim (T_key, [], []) + | Timestamp_t _meta -> prim (T_timestamp, [], []) + | Address_t _meta -> prim (T_address, [], []) + | Operation_t _meta -> prim (T_operation, [], []) + | Chain_id_t _meta -> prim (T_chain_id, [], []) + | Never_t _meta -> prim (T_never, [], []) + | Bls12_381_g1_t _meta -> prim (T_bls12_381_g1, [], []) + | Bls12_381_g2_t _meta -> prim (T_bls12_381_g2, [], []) + | Bls12_381_fr_t _meta -> prim (T_bls12_381_fr, [], []) + | Contract_t (ut, _meta) -> let t = unparse_ty_uncarbonated ~loc ut in - prim (T_contract, [t], unparse_type_annot meta.annot) - | Pair_t ((utl, l_field), (utr, r_field), meta) -> - let annot = unparse_type_annot meta.annot in + prim (T_contract, [t], []) + | Pair_t ((utl, l_field), (utr, r_field), _meta) -> + let annot = [] in let utl = unparse_ty_uncarbonated ~loc utl in let tl = add_field_annot l_field utl in let utr = unparse_ty_uncarbonated ~loc utr in @@ -271,50 +259,44 @@ let rec unparse_ty_uncarbonated : (match tr with | Prim (_, T_pair, ts, []) -> (T_pair, tl :: ts, annot) | _ -> (T_pair, [tl; tr], annot)) - | Union_t ((utl, l_field), (utr, r_field), meta) -> - let annot = unparse_type_annot meta.annot in + | Union_t ((utl, l_field), (utr, r_field), _meta) -> + let annot = [] in let utl = unparse_ty_uncarbonated ~loc utl in let tl = add_field_annot l_field utl in let utr = unparse_ty_uncarbonated ~loc utr in let tr = add_field_annot r_field utr in prim (T_or, [tl; tr], annot) - | Lambda_t (uta, utr, meta) -> + | Lambda_t (uta, utr, _meta) -> let ta = unparse_ty_uncarbonated ~loc uta in let tr = unparse_ty_uncarbonated ~loc utr in - prim (T_lambda, [ta; tr], unparse_type_annot meta.annot) - | Option_t (ut, meta) -> - let annot = unparse_type_annot meta.annot in + prim (T_lambda, [ta; tr], []) + | Option_t (ut, _meta) -> + let annot = [] in let ut = unparse_ty_uncarbonated ~loc ut in prim (T_option, [ut], annot) - | List_t (ut, meta) -> + | List_t (ut, _meta) -> let t = unparse_ty_uncarbonated ~loc ut in - prim (T_list, [t], unparse_type_annot meta.annot) - | Ticket_t (ut, meta) -> + prim (T_list, [t], []) + | Ticket_t (ut, _meta) -> let t = unparse_comparable_ty_uncarbonated ~loc ut in - prim (T_ticket, [t], unparse_type_annot meta.annot) - | Set_t (ut, meta) -> + prim (T_ticket, [t], []) + | Set_t (ut, _meta) -> let t = unparse_comparable_ty_uncarbonated ~loc ut in - prim (T_set, [t], unparse_type_annot meta.annot) - | Map_t (uta, utr, meta) -> + prim (T_set, [t], []) + | Map_t (uta, utr, _meta) -> let ta = unparse_comparable_ty_uncarbonated ~loc uta in let tr = unparse_ty_uncarbonated ~loc utr in - prim (T_map, [ta; tr], unparse_type_annot meta.annot) - | Big_map_t (uta, utr, meta) -> + prim (T_map, [ta; tr], []) + | Big_map_t (uta, utr, _meta) -> let ta = unparse_comparable_ty_uncarbonated ~loc uta in let tr = unparse_ty_uncarbonated ~loc utr in - prim (T_big_map, [ta; tr], unparse_type_annot meta.annot) - | Sapling_transaction_t (memo_size, meta) -> - prim - ( T_sapling_transaction, - [unparse_memo_size ~loc memo_size], - unparse_type_annot meta.annot ) - | Sapling_state_t (memo_size, meta) -> - prim - ( T_sapling_state, - [unparse_memo_size ~loc memo_size], - unparse_type_annot meta.annot ) - | Chest_key_t meta -> prim (T_chest_key, [], unparse_type_annot meta.annot) - | Chest_t meta -> prim (T_chest, [], unparse_type_annot meta.annot) + prim (T_big_map, [ta; tr], []) + | Sapling_transaction_t (memo_size, _meta) -> + prim (T_sapling_transaction, [unparse_memo_size ~loc memo_size], []) + | Sapling_state_t (memo_size, _meta) -> + prim (T_sapling_state, [unparse_memo_size ~loc memo_size], []) + | Chest_key_t _meta -> prim (T_chest_key, [], []) + | Chest_t _meta -> prim (T_chest, [], []) let unparse_ty ~loc ctxt ty = Gas.consume ctxt (Unparse_costs.unparse_type ty) >|? fun ctxt -> @@ -725,18 +707,12 @@ type ('ta, 'tb) eq = Eq : ('same, 'same) eq let merge_type_metadata : type error_trace. - legacy:bool -> error_details:error_trace error_details -> 'a ty_metadata -> 'b ty_metadata -> ('a ty_metadata, error_trace) result = - fun ~legacy - ~error_details - {size = size_a; annot = annot_a} - {size = size_b; annot = annot_b} -> - Type_size.merge ~error_details size_a size_b >>? fun size -> - merge_type_annot ~legacy ~error_details annot_a annot_b >|? fun annot -> - {annot; size} + fun ~error_details {size = size_a} {size = size_b} -> + Type_size.merge ~error_details size_a size_b >|? fun size -> {size} let default_merge_type_error ty1 ty2 = let ty1 = serialize_ty_for_error ty1 in @@ -770,8 +746,8 @@ let rec merge_comparable_types : let open Gas_monad in fun ~legacy ~error_details ta tb -> consume_gas Typecheck_costs.merge_cycle >>$ fun () -> - let merge_type_metadata ~legacy meta_a meta_b = - of_result @@ merge_type_metadata ~legacy ~error_details meta_a meta_b + let merge_type_metadata meta_a meta_b = + of_result @@ merge_type_metadata ~error_details meta_a meta_b in let merge_field_annot ~legacy annot_a annot_b = of_result @@ merge_field_annot ~legacy ~error_details annot_a annot_b @@ -780,8 +756,7 @@ let rec merge_comparable_types : ( (ta comparable_ty, tb comparable_ty) eq * ta comparable_ty, error_trace ) gas_monad = - merge_type_metadata ~legacy annot_a annot_b >>$ fun annot -> - return (eq, f annot) + merge_type_metadata annot_a annot_b >>$ fun annot -> return (eq, f annot) in match (ta, tb) with | (Unit_key annot_a, Unit_key annot_b) -> @@ -815,7 +790,7 @@ let rec merge_comparable_types : | ( Pair_key ((left_a, annot_left_a), (right_a, annot_right_a), annot_a), Pair_key ((left_b, annot_left_b), (right_b, annot_right_b), annot_b) ) -> - merge_type_metadata ~legacy annot_a annot_b >>$ fun annot -> + merge_type_metadata annot_a annot_b >>$ fun annot -> merge_field_annot ~legacy annot_left_a annot_left_b >>$ fun annot_left -> merge_field_annot ~legacy annot_right_a annot_right_b @@ -829,7 +804,7 @@ let rec merge_comparable_types : | ( Union_key ((left_a, annot_left_a), (right_a, annot_right_a), annot_a), Union_key ((left_b, annot_left_b), (right_b, annot_right_b), annot_b) ) -> - merge_type_metadata ~legacy annot_a annot_b >>$ fun annot -> + merge_type_metadata annot_a annot_b >>$ fun annot -> merge_field_annot ~legacy annot_left_a annot_left_b >>$ fun annot_left -> merge_field_annot ~legacy annot_right_a annot_right_b @@ -841,7 +816,7 @@ let rec merge_comparable_types : ( (Eq : (ta comparable_ty, tb comparable_ty) eq), Union_key ((left, annot_left), (right, annot_right), annot) ) | (Option_key (ta, annot_a), Option_key (tb, annot_b)) -> - merge_type_metadata ~legacy annot_a annot_b >>$ fun annot -> + merge_type_metadata annot_a annot_b >>$ fun annot -> merge_comparable_types ~legacy ~error_details ta tb >|$ fun (Eq, t) -> ((Eq : (ta comparable_ty, tb comparable_ty) eq), Option_key (t, annot)) | (_, _) -> @@ -898,7 +873,7 @@ let merge_types : let open Gas_monad in fun ~legacy ~error_details loc ty1 ty2 -> let merge_type_metadata tn1 tn2 = - of_result @@ merge_type_metadata ~legacy ~error_details tn1 tn2 + of_result @@ merge_type_metadata ~error_details tn1 tn2 |> Gas_monad.record_trace_eval ~error_details (fun () -> let ty1 = serialize_ty_for_error ty1 in let ty2 = serialize_ty_for_error ty2 in @@ -1172,47 +1147,44 @@ let[@coq_struct "ty"] rec parse_comparable_ty : else match ty with | Prim (loc, T_unit, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (unit_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty unit_key, ctxt) | Prim (loc, T_never, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (never_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty never_key, ctxt) | Prim (loc, T_int, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (int_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty int_key, ctxt) | Prim (loc, T_nat, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (nat_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty nat_key, ctxt) | Prim (loc, T_signature, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (signature_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty signature_key, ctxt) | Prim (loc, T_string, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (string_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty string_key, ctxt) | Prim (loc, T_bytes, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (bytes_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty bytes_key, ctxt) | Prim (loc, T_mutez, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (mutez_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty mutez_key, ctxt) | Prim (loc, T_bool, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (bool_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty bool_key, ctxt) | Prim (loc, T_key_hash, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (key_hash_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty key_hash_key, ctxt) | Prim (loc, T_key, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (key_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> (Ex_comparable_ty key_key, ctxt) | Prim (loc, T_timestamp, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (timestamp_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty timestamp_key, ctxt) | Prim (loc, T_chain_id, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (chain_id_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty chain_id_key, ctxt) | Prim (loc, T_address, [], annot) -> - parse_type_annot loc annot >|? fun annot -> - (Ex_comparable_ty (address_key ~annot), ctxt) + check_type_annot loc annot >|? fun () -> + (Ex_comparable_ty address_key, ctxt) | Prim ( loc, (( T_unit | T_never | T_int | T_nat | T_string | T_bytes | T_mutez @@ -1222,7 +1194,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : _ ) -> error (Invalid_arity (loc, prim, 0, List.length l)) | Prim (loc, T_pair, left :: right, annot) -> - parse_type_annot loc annot >>? fun annot -> + check_type_annot loc annot >>? fun () -> extract_field_annot left >>? fun (left, left_annot) -> (match right with | [right] -> extract_field_annot right @@ -1234,25 +1206,25 @@ let[@coq_struct "ty"] rec parse_comparable_ty : >>? fun (Ex_comparable_ty right, ctxt) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt left >>? fun (Ex_comparable_ty left, ctxt) -> - pair_key loc (left, left_annot) (right, right_annot) ~annot - >|? fun ty -> (Ex_comparable_ty ty, ctxt) + pair_key loc (left, left_annot) (right, right_annot) >|? fun ty -> + (Ex_comparable_ty ty, ctxt) | Prim (loc, T_or, [left; right], annot) -> - parse_type_annot loc annot >>? fun annot -> + check_type_annot loc annot >>? fun () -> extract_field_annot left >>? fun (left, left_annot) -> extract_field_annot right >>? fun (right, right_annot) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt right >>? fun (Ex_comparable_ty right, ctxt) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt left >>? fun (Ex_comparable_ty left, ctxt) -> - union_key loc (left, left_annot) (right, right_annot) ~annot - >|? fun ty -> (Ex_comparable_ty ty, ctxt) + union_key loc (left, left_annot) (right, right_annot) >|? fun ty -> + (Ex_comparable_ty ty, ctxt) | Prim (loc, ((T_pair | T_or) as prim), l, _) -> error (Invalid_arity (loc, prim, 2, List.length l)) | Prim (loc, T_option, [t], annot) -> - parse_type_annot loc annot >>? fun annot -> + check_type_annot loc annot >>? fun () -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt t >>? fun (Ex_comparable_ty t, ctxt) -> - option_key loc t ~annot >|? fun ty -> (Ex_comparable_ty ty, ctxt) + option_key loc t >|? fun ty -> (Ex_comparable_ty ty, ctxt) | Prim (loc, T_option, l, _) -> error (Invalid_arity (loc, T_option, 1, List.length l)) | Prim @@ -1416,73 +1388,53 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : else match node with | Prim (loc, T_unit, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (unit_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty unit_t, ctxt) | Prim (loc, T_int, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (int_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty int_t, ctxt) | Prim (loc, T_nat, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (nat_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty nat_t, ctxt) | Prim (loc, T_string, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (string_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty string_t, ctxt) | Prim (loc, T_bytes, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (bytes_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty bytes_t, ctxt) | Prim (loc, T_mutez, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (mutez_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty mutez_t, ctxt) | Prim (loc, T_bool, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (bool_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty bool_t, ctxt) | Prim (loc, T_key, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (key_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty key_t, ctxt) | Prim (loc, T_key_hash, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (key_hash_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty key_hash_t, ctxt) | Prim (loc, T_chest_key, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (chest_key_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty chest_key_t, ctxt) | Prim (loc, T_chest, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (chest_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty chest_t, ctxt) | Prim (loc, T_timestamp, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (timestamp_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty timestamp_t, ctxt) | Prim (loc, T_address, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (address_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty address_t, ctxt) | Prim (loc, T_signature, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (signature_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty signature_t, ctxt) | Prim (loc, T_operation, [], annot) -> if allow_operation then - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (operation_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty operation_t, ctxt) else error (Unexpected_operation loc) | Prim (loc, T_chain_id, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (chain_id_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty chain_id_t, ctxt) | Prim (loc, T_never, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (never_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty never_t, ctxt) | Prim (loc, T_bls12_381_g1, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (bls12_381_g1_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty bls12_381_g1_t, ctxt) | Prim (loc, T_bls12_381_g2, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (bls12_381_g2_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty bls12_381_g2_t, ctxt) | Prim (loc, T_bls12_381_fr, [], annot) -> - parse_type_annot loc annot >>? fun annot -> - ok (Ex_ty (bls12_381_fr_t ~annot), ctxt) + check_type_annot loc annot >>? fun () -> ok (Ex_ty bls12_381_fr_t, ctxt) | Prim (loc, T_contract, [utl], annot) -> if allow_contract then parse_parameter_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy utl >>? fun (Ex_ty tl, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - contract_t loc tl ~annot >|? fun ty -> (Ex_ty ty, ctxt) + check_type_annot loc annot >>? fun () -> + contract_t loc tl >|? fun ty -> (Ex_ty ty, ctxt) else error (Unexpected_contract loc) | Prim (loc, T_pair, utl :: utr, annot) -> extract_field_annot utl >>? fun (utl, left_field) -> @@ -1512,8 +1464,8 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : ~allow_ticket utr >>? fun (Ex_ty tr, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - pair_t loc (tl, left_field) (tr, right_field) ~annot >|? fun ty -> + check_type_annot loc annot >>? fun () -> + pair_t loc (tl, left_field) (tr, right_field) >|? fun ty -> (Ex_ty ty, ctxt) | Prim (loc, T_or, [utl; utr], annot) -> extract_field_annot utl >>? fun (utl, left_constr) -> @@ -1538,24 +1490,23 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : ~allow_ticket utr >>? fun (Ex_ty tr, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - union_t loc (tl, left_constr) (tr, right_constr) ~annot >|? fun ty -> + check_type_annot loc annot >>? fun () -> + union_t loc (tl, left_constr) (tr, right_constr) >|? fun ty -> (Ex_ty ty, ctxt) | Prim (loc, T_lambda, [uta; utr], annot) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy uta >>? fun (Ex_ty ta, ctxt) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy utr >>? fun (Ex_ty tr, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - lambda_t loc ta tr ~annot >|? fun ty -> (Ex_ty ty, ctxt) + check_type_annot loc annot >>? fun () -> + lambda_t loc ta tr >|? fun ty -> (Ex_ty ty, ctxt) | Prim (loc, T_option, [ut], annot) -> (if legacy then (* legacy semantics with (broken) field annotations *) extract_field_annot ut >>? fun (ut, _some_constr) -> - parse_composed_type_annot loc annot - >>? fun (ty_name, _none_constr, _) -> ok (ut, ty_name) - else parse_type_annot loc annot >>? fun annot -> ok (ut, annot)) - >>? fun (ut, annot) -> + parse_composed_type_annot loc annot >>? fun (_none_constr, _) -> ok ut + else check_type_annot loc annot >>? fun () -> ok ut) + >>? fun ut -> parse_ty ctxt ~stack_depth:(stack_depth + 1) @@ -1566,7 +1517,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : ~allow_ticket ut >>? fun (Ex_ty t, ctxt) -> - option_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt) + option_t loc t >|? fun ty -> (Ex_ty ty, ctxt) | Prim (loc, T_list, [ut], annot) -> parse_ty ctxt @@ -1578,20 +1529,20 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : ~allow_ticket ut >>? fun (Ex_ty t, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - list_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt) + check_type_annot loc annot >>? fun () -> + list_t loc t >|? fun ty -> (Ex_ty ty, ctxt) | Prim (loc, T_ticket, [ut], annot) -> if allow_ticket then parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt ut >>? fun (Ex_comparable_ty t, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - ticket_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt) + check_type_annot loc annot >>? fun () -> + ticket_t loc t >|? fun ty -> (Ex_ty ty, ctxt) else error (Unexpected_ticket loc) | Prim (loc, T_set, [ut], annot) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt ut >>? fun (Ex_comparable_ty t, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - set_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt) + check_type_annot loc annot >>? fun () -> + set_t loc t >|? fun ty -> (Ex_ty ty, ctxt) | Prim (loc, T_map, [uta; utr], annot) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt uta >>? fun (Ex_comparable_ty ta, ctxt) -> @@ -1605,12 +1556,12 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : ~allow_ticket utr >>? fun (Ex_ty tr, ctxt) -> - parse_type_annot loc annot >>? fun annot -> - map_t loc ta tr ~annot >|? fun ty -> (Ex_ty ty, ctxt) + check_type_annot loc annot >>? fun () -> + map_t loc ta tr >|? fun ty -> (Ex_ty ty, ctxt) | Prim (loc, T_sapling_transaction, [memo_size], annot) -> - parse_type_annot loc annot >>? fun annot -> + check_type_annot loc annot >>? fun () -> parse_memo_size memo_size >|? fun memo_size -> - (Ex_ty (sapling_transaction_t ~memo_size ~annot), ctxt) + (Ex_ty (sapling_transaction_t ~memo_size), ctxt) (* /!\ When adding new lazy storage kinds, be careful to use [when allow_lazy_storage] /!\ @@ -1620,9 +1571,9 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : | Prim (loc, T_big_map, args, annot) when allow_lazy_storage -> (parse_big_map_ty [@tailcall]) ctxt ~stack_depth ~legacy loc args annot | Prim (loc, T_sapling_state, [memo_size], annot) when allow_lazy_storage -> - parse_type_annot loc annot >>? fun annot -> + check_type_annot loc annot >>? fun () -> parse_memo_size memo_size >|? fun memo_size -> - (Ex_ty (sapling_state_t ~memo_size ~annot), ctxt) + (Ex_ty (sapling_state_t ~memo_size), ctxt) | Prim (loc, (T_big_map | T_sapling_state), _, _) -> error (Unexpected_lazy_storage loc) | Prim @@ -1689,8 +1640,8 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_ma ~legacy value_ty >>? fun (Ex_ty value_ty, ctxt) -> - parse_type_annot big_map_loc map_annot >>? fun annot -> - big_map_t big_map_loc key_ty value_ty ~annot >|? fun big_map_ty -> + check_type_annot big_map_loc map_annot >>? fun () -> + big_map_t big_map_loc key_ty value_ty >|? fun big_map_ty -> (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) @@ -1745,12 +1696,8 @@ let parse_storage_ty : remaining_storage >>? fun (Ex_ty remaining_storage, ctxt) -> parse_composed_type_annot loc storage_annot - >>? fun (annot, map_field, storage_field) -> - pair_t - loc - (big_map_ty, map_field) - (remaining_storage, storage_field) - ~annot + >>? fun (map_field, storage_field) -> + pair_t loc (big_map_ty, map_field) (remaining_storage, storage_field) >|? fun ty -> (Ex_ty ty, ctxt)) | _ -> (parse_normal_storage_ty [@tailcall]) ctxt ~stack_depth ~legacy node @@ -2012,11 +1959,7 @@ let parse_uint11 = parse_uint ~nb_bits:11 - serialize and deserialize tickets when they are stored or transferred, - type the READ_TICKET instruction. *) let opened_ticket_type loc ty = - pair_3_key - loc - (address_key ~annot:None, None) - (ty, None) - (nat_key ~annot:None, None) + pair_3_key loc (address_key, None) (ty, None) (nat_key, None) (* -- parse data of primitive types -- *) @@ -2664,7 +2607,7 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data : >|=? fun (diff, ctxt) -> (None, diff, ctxt) | Prim (loc, D_Pair, [Int (loc_id, id); Seq (_, vs)], annot) -> error_unexpected_annot loc annot >>?= fun () -> - option_t loc tv ~annot:None >>?= fun tv_opt -> + option_t loc tv >>?= fun tv_opt -> parse_big_map_items ?type_logger ctxt expr tk tv_opt vs (fun x -> x) >|=? fun (diff, ctxt) -> (Some (id, loc_id), diff, ctxt) | Prim (_, D_Pair, [Int _; expr], _) -> @@ -2815,8 +2758,7 @@ and parse_view_returning : (Some "return of view", strip_locations output_ty, output_ty_loc)) (parse_view_output_ty ctxt ~stack_depth:0 ~legacy output_ty) >>?= fun (Ex_ty output_ty', ctxt) -> - pair_t input_ty_loc (input_ty', None) (storage_type, None) ~annot:None - >>?= fun pair_ty -> + pair_t input_ty_loc (input_ty', None) (storage_type, None) >>?= fun pair_ty -> parse_instr ?type_logger ~stack_depth:0 @@ -3115,26 +3057,25 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let const = {apply = (fun kinfo k -> IConst (kinfo, v, k))} in typed ctxt loc const (Item_t (t, stack)) | (Prim (loc, I_UNIT, [], annot), stack) -> - parse_var_type_annot loc annot >>?= fun ty_name -> + check_var_type_annot loc annot >>?= fun () -> let const = {apply = (fun kinfo k -> IConst (kinfo, (), k))} in - typed ctxt loc const (Item_t (unit_t ~annot:ty_name, stack)) + typed ctxt loc const (Item_t (unit_t, stack)) (* options *) | (Prim (loc, I_SOME, [], annot), Item_t (t, rest)) -> - parse_var_type_annot loc annot >>?= fun ty_name -> + check_var_type_annot loc annot >>?= fun () -> let cons_some = {apply = (fun kinfo k -> ICons_some (kinfo, k))} in - option_t loc t ~annot:ty_name >>?= fun ty -> - typed ctxt loc cons_some (Item_t (ty, rest)) + option_t loc t >>?= fun ty -> typed ctxt loc cons_some (Item_t (ty, rest)) | (Prim (loc, I_NONE, [t], annot), stack) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy t >>?= fun (Ex_ty t, ctxt) -> - parse_var_type_annot loc annot >>?= fun ty_name -> + check_var_type_annot loc annot >>?= fun () -> let cons_none = {apply = (fun kinfo k -> ICons_none (kinfo, k))} in - option_t loc t ~annot:ty_name >>?= fun ty -> + option_t loc t >>?= fun ty -> let stack_ty = Item_t (ty, stack) in typed ctxt loc cons_none stack_ty | (Prim (loc, I_MAP, [body], annot), Item_t (Option_t (t, _), rest)) -> ( check_kind [Seq_kind] body >>?= fun () -> - parse_var_type_annot loc annot >>?= fun opt_ty_name -> + check_var_type_annot loc annot >>?= fun () -> non_terminal_recursion ?type_logger ~legacy @@ -3155,7 +3096,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : invalid_map_body ( merge_stacks ~legacy loc ctxt 1 aft_rest rest >>? fun (Eq, rest, ctxt) -> - option_t loc ret ~annot:opt_ty_name >>? fun opt_ty -> + option_t loc ret >>? fun opt_ty -> let final_stack = Item_t (opt_ty, rest) in let hinfo = {iloc = loc; kstack_ty = Item_t (ret, aft_rest)} in let cinfo = kinfo_of_descr kibody in @@ -3194,8 +3135,8 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : Lwt.return @@ merge_branches ~legacy ctxt loc btr bfr {branch} (* pairs *) | (Prim (loc, I_PAIR, [], annot), Item_t (a, Item_t (b, rest))) -> - parse_constr_annot loc annot >>?= fun (ty_name, l_field, r_field) -> - pair_t loc (a, l_field) (b, r_field) ~annot:ty_name >>?= fun ty -> + parse_constr_annot loc annot >>?= fun (l_field, r_field) -> + pair_t loc (a, l_field) (b, r_field) >>?= fun ty -> let stack_ty = Item_t (ty, rest) in let cons_pair = {apply = (fun kinfo k -> ICons_pair (kinfo, k))} in typed ctxt loc cons_pair stack_ty @@ -3212,7 +3153,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : make_proof_argument (n - 1) tl_ty >>? fun (Comb_proof_argument (comb_witness, Item_t (b_ty, tl_ty'))) -> - pair_t loc (a_ty, None) (b_ty, None) ~annot:None >|? fun pair_t -> + pair_t loc (a_ty, None) (b_ty, None) >|? fun pair_t -> Comb_proof_argument (Comb_succ comb_witness, Item_t (pair_t, tl_ty')) | _ -> let whole_stack = serialize_stack_for_error ctxt stack_ty in @@ -3292,13 +3233,13 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : fun n value_ty ty -> match (n, ty) with | (0, _) -> ok @@ Comb_set_proof_argument (Comb_set_zero, value_ty) - | (1, Pair_t ((_hd_ty, at1), (tl_ty, bt1), {annot; _})) -> - pair_t loc (value_ty, at1) (tl_ty, bt1) ~annot >|? fun after_ty -> + | (1, Pair_t ((_hd_ty, at1), (tl_ty, bt1), _)) -> + pair_t loc (value_ty, at1) (tl_ty, bt1) >|? fun after_ty -> Comb_set_proof_argument (Comb_set_one, after_ty) - | (n, Pair_t ((hd_ty, at1), (tl_ty, bt1), {annot; _})) -> + | (n, Pair_t ((hd_ty, at1), (tl_ty, bt1), _)) -> make_proof_argument (n - 2) value_ty tl_ty >>? fun (Comb_set_proof_argument (comb_set_left_witness, tl_ty')) -> - pair_t loc (hd_ty, at1) (tl_ty', bt1) ~annot >|? fun after_ty -> + pair_t loc (hd_ty, at1) (tl_ty', bt1) >|? fun after_ty -> Comb_set_proof_argument (Comb_set_plus_two comb_set_left_witness, after_ty) | _ -> @@ -3339,17 +3280,17 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_LEFT, [tr], annot), Item_t (tl, rest)) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tr >>?= fun (Ex_ty tr, ctxt) -> - parse_constr_annot loc annot >>?= fun (tname, l_field, r_field) -> + parse_constr_annot loc annot >>?= fun (l_field, r_field) -> let cons_left = {apply = (fun kinfo k -> ICons_left (kinfo, k))} in - union_t loc (tl, l_field) (tr, r_field) ~annot:tname >>?= fun ty -> + union_t loc (tl, l_field) (tr, r_field) >>?= fun ty -> let stack_ty = Item_t (ty, rest) in typed ctxt loc cons_left stack_ty | (Prim (loc, I_RIGHT, [tl], annot), Item_t (tr, rest)) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tl >>?= fun (Ex_ty tl, ctxt) -> - parse_constr_annot loc annot >>?= fun (tname, l_field, r_field) -> + parse_constr_annot loc annot >>?= fun (l_field, r_field) -> let cons_right = {apply = (fun kinfo k -> ICons_right (kinfo, k))} in - union_t loc (tl, l_field) (tr, r_field) ~annot:tname >>?= fun ty -> + union_t loc (tl, l_field) (tr, r_field) >>?= fun ty -> let stack_ty = Item_t (ty, rest) in typed ctxt loc cons_right stack_ty | ( Prim (loc, I_IF_LEFT, [bt; bf], annot), @@ -3392,10 +3333,9 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_NIL, [t], annot), stack) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy t >>?= fun (Ex_ty t, ctxt) -> - parse_var_type_annot loc annot >>?= fun ty_name -> + check_var_type_annot loc annot >>?= fun () -> let nil = {apply = (fun kinfo k -> INil (kinfo, k))} in - list_t loc t ~annot:ty_name >>?= fun ty -> - typed ctxt loc nil (Item_t (ty, stack)) + list_t loc t >>?= fun ty -> typed ctxt loc nil (Item_t (ty, stack)) | ( Prim (loc, I_CONS, [], annot), Item_t (tv, Item_t (List_t (t, ty_name), rest)) ) -> check_item_ty ctxt tv t loc I_CONS 1 2 >>?= fun (Eq, t, ctxt) -> @@ -3434,13 +3374,13 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : in Lwt.return @@ merge_branches ~legacy ctxt loc btr bfr {branch} | (Prim (loc, I_SIZE, [], annot), Item_t (List_t _, rest)) -> - parse_var_type_annot loc annot >>?= fun tname -> + check_var_type_annot loc annot >>?= fun () -> let list_size = {apply = (fun kinfo k -> IList_size (kinfo, k))} in - typed ctxt loc list_size (Item_t (nat_t ~annot:tname, rest)) + typed ctxt loc list_size (Item_t (nat_t, rest)) | (Prim (loc, I_MAP, [body], annot), Item_t (List_t (elt, _), starting_rest)) -> ( check_kind [Seq_kind] body >>?= fun () -> - parse_var_type_annot loc annot >>?= fun list_ty_name -> + check_var_type_annot loc annot >>?= fun () -> non_terminal_recursion ?type_logger tc_context @@ -3467,7 +3407,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let list_map = {apply = (fun kinfo k -> IList_map (kinfo, ibody, k))} in - list_t loc ret ~annot:list_ty_name >>? fun ty -> + list_t loc ret >>? fun ty -> let stack = Item_t (ty, rest) in typed_no_lwt ctxt loc list_map stack ) | Typed {aft; _} -> @@ -3515,10 +3455,9 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_EMPTY_SET, [t], annot), rest) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt t >>?= fun (Ex_comparable_ty t, ctxt) -> - parse_var_type_annot loc annot >>?= fun tname -> + check_var_type_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IEmpty_set (kinfo, t, k))} in - set_t loc t ~annot:tname >>?= fun ty -> - typed ctxt loc instr (Item_t (ty, rest)) + set_t loc t >>?= fun ty -> typed ctxt loc instr (Item_t (ty, rest)) | (Prim (loc, I_ITER, [body], annot), Item_t (Set_t (comp_elt, _), rest)) -> ( check_kind [Seq_kind] body >>?= fun () -> error_unexpected_annot loc annot >>?= fun () -> @@ -3559,10 +3498,10 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : ) | (Prim (loc, I_MEM, [], annot), Item_t (v, Item_t (Set_t (elt, _), rest))) -> let elt = ty_of_comparable_ty elt in - parse_var_type_annot loc annot >>?= fun tname -> + check_var_type_annot loc annot >>?= fun () -> check_item_ty ctxt elt v loc I_MEM 1 2 >>?= fun (Eq, _, ctxt) -> let instr = {apply = (fun kinfo k -> ISet_mem (kinfo, k))} in - (typed ctxt loc instr (Item_t (bool_t ~annot:tname, rest)) + (typed ctxt loc instr (Item_t (bool_t, rest)) : ((a, s) judgement * context) tzresult Lwt.t) | ( Prim (loc, I_UPDATE, [], annot), Item_t (v, Item_t (Bool_t _, Item_t (Set_t (elt, tname), rest))) ) -> @@ -3575,23 +3514,22 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_SIZE, [], annot), Item_t (Set_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISet_size (kinfo, k))} in - typed ctxt loc instr (Item_t (nat_t ~annot:None, rest)) + typed ctxt loc instr (Item_t (nat_t, rest)) (* maps *) | (Prim (loc, I_EMPTY_MAP, [tk; tv], annot), stack) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt tk >>?= fun (Ex_comparable_ty tk, ctxt) -> parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tv >>?= fun (Ex_ty tv, ctxt) -> - parse_var_type_annot loc annot >>?= fun ty_name -> + check_var_type_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IEmpty_map (kinfo, tk, k))} in - map_t loc tk tv ~annot:ty_name >>?= fun ty -> - typed ctxt loc instr (Item_t (ty, stack)) + map_t loc tk tv >>?= fun ty -> typed ctxt loc instr (Item_t (ty, stack)) | ( Prim (loc, I_MAP, [body], annot), Item_t (Map_t (ck, elt, _), starting_rest) ) -> ( let k = ty_of_comparable_ty ck in check_kind [Seq_kind] body >>?= fun () -> - parse_var_type_annot loc annot >>?= fun ty_name -> - pair_t loc (k, None) (elt, None) ~annot:None >>?= fun ty -> + check_var_type_annot loc annot >>?= fun () -> + pair_t loc (k, None) (elt, None) >>?= fun ty -> non_terminal_recursion ?type_logger tc_context @@ -3624,7 +3562,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : IMap_map (kinfo, ibody, k)); } in - map_t loc ck ret ~annot:ty_name >>? fun ty -> + map_t loc ck ret >>? fun ty -> let stack = Item_t (ty, rest) in typed_no_lwt ctxt loc instr stack ) | Typed {aft; _} -> @@ -3636,7 +3574,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : check_kind [Seq_kind] body >>?= fun () -> error_unexpected_annot loc annot >>?= fun () -> let key = ty_of_comparable_ty comp_elt in - pair_t loc (key, None) (element_ty, None) ~annot:None >>?= fun ty -> + pair_t loc (key, None) (element_ty, None) >>?= fun ty -> non_terminal_recursion ?type_logger tc_context @@ -3676,7 +3614,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : check_item_ty ctxt vk k loc I_MEM 1 2 >>?= fun (Eq, _, ctxt) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IMap_mem (kinfo, k))} in - (typed ctxt loc instr (Item_t (bool_t ~annot:None, rest)) + (typed ctxt loc instr (Item_t (bool_t, rest)) : ((a, s) judgement * context) tzresult Lwt.t) | ( Prim (loc, I_GET, [], annot), Item_t (vk, Item_t (Map_t (ck, elt, _), rest)) ) -> @@ -3684,7 +3622,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : check_item_ty ctxt vk k loc I_GET 1 2 >>?= fun (Eq, _, ctxt) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IMap_get (kinfo, k))} in - option_t loc elt ~annot:None + option_t loc elt >>?= fun ty : ((a, s) judgement * context) tzresult Lwt.t -> typed ctxt loc instr (Item_t (ty, rest)) | ( Prim (loc, I_UPDATE, [], annot), @@ -3715,18 +3653,18 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_SIZE, [], annot), Item_t (Map_t (_, _, _), rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IMap_size (kinfo, k))} in - typed ctxt loc instr (Item_t (nat_t ~annot:None, rest)) + typed ctxt loc instr (Item_t (nat_t, rest)) (* big_map *) | (Prim (loc, I_EMPTY_BIG_MAP, [tk; tv], annot), stack) -> parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt tk >>?= fun (Ex_comparable_ty tk, ctxt) -> parse_big_map_value_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tv >>?= fun (Ex_ty tv, ctxt) -> - parse_var_type_annot loc annot >>?= fun ty_name -> + check_var_type_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IEmpty_big_map (kinfo, tk, tv, k))} in - big_map_t loc tk tv ~annot:ty_name >>?= fun ty -> + big_map_t loc tk tv >>?= fun ty -> let stack = Item_t (ty, stack) in typed ctxt loc instr stack | ( Prim (loc, I_MEM, [], annot), @@ -3735,7 +3673,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : check_item_ty ctxt set_key k loc I_MEM 1 2 >>?= fun (Eq, _, ctxt) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IBig_map_mem (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t) | ( Prim (loc, I_GET, [], annot), Item_t (vk, Item_t (Big_map_t (ck, elt, _), rest)) ) -> @@ -3743,7 +3681,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : check_item_ty ctxt vk k loc I_GET 1 2 >>?= fun (Eq, _, ctxt) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IBig_map_get (kinfo, k))} in - option_t loc elt ~annot:None >>?= fun ty -> + option_t loc elt >>?= fun ty -> let stack = Item_t (ty, rest) in (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t) | ( Prim (loc, I_UPDATE, [], annot), @@ -3784,7 +3722,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let instr = {apply = (fun kinfo k -> ISapling_empty_state (kinfo, memo_size, k))} in - let stack = Item_t (sapling_state_t ~memo_size ~annot:None, rest) in + let stack = Item_t (sapling_state_t ~memo_size, rest) in typed ctxt loc instr stack | ( Prim (loc, I_SAPLING_VERIFY_UPDATE, [], _), Item_t @@ -3799,9 +3737,8 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let instr = {apply = (fun kinfo k -> ISapling_verify_update (kinfo, k))} in - pair_t loc (int_t ~annot:None, None) (state_ty, None) ~annot:None - >>?= fun pair_ty -> - option_t loc pair_ty ~annot:None >>?= fun ty -> + pair_t loc (int_t, None) (state_ty, None) >>?= fun pair_ty -> + option_t loc pair_ty >>?= fun ty -> let stack = Item_t (ty, rest) in typed ctxt loc instr stack (* control *) @@ -3966,7 +3903,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : code >>=? fun (lambda, ctxt) -> let instr = {apply = (fun kinfo k -> ILambda (kinfo, lambda, k))} in - lambda_t loc arg ret ~annot:None >>?= fun ty -> + lambda_t loc arg ret >>?= fun ty -> let stack = Item_t (ty, stack) in typed ctxt loc instr stack | ( Prim (loc, I_EXEC, [], annot), @@ -3980,17 +3917,14 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : Item_t ( capture, Item_t - ( Lambda_t - ( Pair_t ((capture_ty, _), (arg_ty, _), {annot = lam_annot; _}), - ret, - _ ), - rest ) ) ) -> + (Lambda_t (Pair_t ((capture_ty, _), (arg_ty, _), _), ret, _), rest) + ) ) -> check_packable ~legacy:false loc capture_ty >>?= fun () -> check_item_ty ctxt capture capture_ty loc I_APPLY 1 2 >>?= fun (Eq, capture_ty, ctxt) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IApply (kinfo, capture_ty, k))} in - lambda_t loc arg_ty ret ~annot:lam_annot + lambda_t loc arg_ty ret (* This cannot fail because the type [lambda 'arg 'ret] is always smaller than the input type [lambda (pair 'arg 'capture) 'ret]. In an ideal world, there would be a smart deconstructor to ensure this statically. *) @@ -4107,21 +4041,16 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let stack = Item_t (Timestamp_t tname, rest) in typed ctxt loc instr stack | ( Prim (loc, I_SUB, [], annot), - Item_t - ( Timestamp_t {annot = tn1; size = _}, - Item_t (Timestamp_t {annot = tn2; size = _}, rest) ) ) -> + Item_t (Timestamp_t _, Item_t (Timestamp_t _, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_annot ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> let instr = {apply = (fun kinfo k -> IDiff_timestamps (kinfo, k))} in - let stack = Item_t (int_t ~annot:tname, rest) in + let stack = Item_t (int_t, rest) in typed ctxt loc instr stack (* string operations *) | ( Prim (loc, I_CONCAT, [], annot), Item_t (String_t tn1, Item_t (String_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IConcat_string_pair (kinfo, k))} in typed ctxt loc instr (Item_t (String_t tname, rest)) | (Prim (loc, I_CONCAT, [], annot), Item_t (List_t (String_t tname, _), rest)) @@ -4130,22 +4059,21 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let instr = {apply = (fun kinfo k -> IConcat_string (kinfo, k))} in typed ctxt loc instr (Item_t (String_t tname, rest)) | ( Prim (loc, I_SLICE, [], annot), - Item_t (Nat_t _, Item_t (Nat_t _, Item_t (String_t tname, rest))) ) -> + Item_t (Nat_t _, Item_t (Nat_t _, Item_t (String_t _, rest))) ) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISlice_string (kinfo, k))} in - let stack = Item_t (option_string'_t tname, rest) in + let stack = Item_t (option_string_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_SIZE, [], annot), Item_t (String_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IString_size (kinfo, k))} in - let stack = Item_t (nat_t ~annot:None, rest) in + let stack = Item_t (nat_t, rest) in typed ctxt loc instr stack (* bytes operations *) | ( Prim (loc, I_CONCAT, [], annot), Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IConcat_bytes_pair (kinfo, k))} in let stack = Item_t (Bytes_t tname, rest) in typed ctxt loc instr stack @@ -4156,22 +4084,21 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let stack = Item_t (Bytes_t tname, rest) in typed ctxt loc instr stack | ( Prim (loc, I_SLICE, [], annot), - Item_t (Nat_t _, Item_t (Nat_t _, Item_t (Bytes_t tname, rest))) ) -> + Item_t (Nat_t _, Item_t (Nat_t _, Item_t (Bytes_t _, rest))) ) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISlice_bytes (kinfo, k))} in - let stack = Item_t (option_bytes'_t tname, rest) in + let stack = Item_t (option_bytes_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_SIZE, [], annot), Item_t (Bytes_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IBytes_size (kinfo, k))} in - let stack = Item_t (nat_t ~annot:None, rest) in + let stack = Item_t (nat_t, rest) in typed ctxt loc instr stack (* currency operations *) | ( Prim (loc, I_ADD, [], annot), Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAdd_tez (kinfo, k))} in let stack = Item_t (Mutez_t tname, rest) in typed ctxt loc instr stack @@ -4179,19 +4106,16 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest)) ) -> if legacy then check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> ISub_tez_legacy (kinfo, k))} in let stack = Item_t (Mutez_t tname, rest) in typed ctxt loc instr stack else fail (Deprecated_instruction I_SUB) | ( Prim (loc, I_SUB_MUTEZ, [], annot), - Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest)) ) -> + Item_t (Mutez_t _, Item_t (Mutez_t _, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> let instr = {apply = (fun kinfo k -> ISub_tez (kinfo, k))} in - let stack = Item_t (option_mutez'_t tname, rest) in + let stack = Item_t (option_mutez_t, rest) in typed ctxt loc instr stack | ( Prim (loc, I_MUL, [], annot), Item_t (Mutez_t tname, Item_t (Nat_t _, rest)) ) -> @@ -4211,24 +4135,21 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_OR, [], annot), Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IOr (kinfo, k))} in let stack = Item_t (Bool_t tname, rest) in typed ctxt loc instr stack | ( Prim (loc, I_AND, [], annot), Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAnd (kinfo, k))} in let stack = Item_t (Bool_t tname, rest) in typed ctxt loc instr stack | ( Prim (loc, I_XOR, [], annot), Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IXor (kinfo, k))} in let stack = Item_t (Bool_t tname, rest) in typed ctxt loc instr stack @@ -4241,7 +4162,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_ABS, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IAbs_int (kinfo, k))} in - let stack = Item_t (nat_t ~annot:None, rest) in + let stack = Item_t (nat_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_ISNAT, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> @@ -4251,7 +4172,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_INT, [], annot), Item_t (Nat_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IInt_nat (kinfo, k))} in - let stack = Item_t (int_t ~annot:None, rest) in + let stack = Item_t (int_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_NEG, [], annot), Item_t (Int_t tname, rest)) -> check_var_annot loc annot >>?= fun () -> @@ -4261,13 +4182,12 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_NEG, [], annot), Item_t (Nat_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> INeg (kinfo, k))} in - let stack = Item_t (int_t ~annot:None, rest) in + let stack = Item_t (int_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_ADD, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAdd_int (kinfo, k))} in let stack = Item_t (Int_t tname, rest) in typed ctxt loc instr stack @@ -4286,16 +4206,14 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_ADD, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAdd_nat (kinfo, k))} in let stack = Item_t (Nat_t tname, rest) in typed ctxt loc instr stack | (Prim (loc, I_SUB, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> ISub_int (kinfo, k))} in let stack = Item_t (Int_t tname, rest) in typed ctxt loc instr stack @@ -4311,19 +4229,15 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let instr = {apply = (fun kinfo k -> ISub_int (kinfo, k))} in let stack = Item_t (Int_t tname, rest) in typed ctxt loc instr stack - | (Prim (loc, I_SUB, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) - -> + | (Prim (loc, I_SUB, [], annot), Item_t (Nat_t _, Item_t (Nat_t _, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun _tname -> let instr = {apply = (fun kinfo k -> ISub_int (kinfo, k))} in - let stack = Item_t (int_t ~annot:None, rest) in + let stack = Item_t (int_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_MUL, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IMul_int (kinfo, k))} in let stack = Item_t (Int_t tname, rest) in typed ctxt loc instr stack @@ -4342,82 +4256,67 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_MUL, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IMul_nat (kinfo, k))} in let stack = Item_t (Nat_t tname, rest) in typed ctxt loc instr stack - | ( Prim (loc, I_EDIV, [], annot), - Item_t (Mutez_t tname, Item_t (Nat_t _, rest)) ) -> + | (Prim (loc, I_EDIV, [], annot), Item_t (Mutez_t _, Item_t (Nat_t _, rest))) + -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IEdiv_teznat (kinfo, k))} in - let stack = Item_t (option_pair_mutez'_mutez'_t tname, rest) in + let stack = Item_t (option_pair_mutez_mutez_t, rest) in typed ctxt loc instr stack - | ( Prim (loc, I_EDIV, [], annot), - Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest)) ) -> + | (Prim (loc, I_EDIV, [], annot), Item_t (Mutez_t _, Item_t (Mutez_t _, rest))) + -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> let instr = {apply = (fun kinfo k -> IEdiv_tez (kinfo, k))} in - let stack = Item_t (option_pair_nat_mutez'_t tname, rest) in + let stack = Item_t (option_pair_nat_mutez_t, rest) in typed ctxt loc instr stack - | (Prim (loc, I_EDIV, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest))) - -> + | (Prim (loc, I_EDIV, [], annot), Item_t (Int_t _, Item_t (Int_t _, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> let instr = {apply = (fun kinfo k -> IEdiv_int (kinfo, k))} in - let stack = Item_t (option_pair_int'_nat_t tname, rest) in + let stack = Item_t (option_pair_int_nat_t, rest) in typed ctxt loc instr stack - | (Prim (loc, I_EDIV, [], annot), Item_t (Int_t tname, Item_t (Nat_t _, rest))) - -> + | (Prim (loc, I_EDIV, [], annot), Item_t (Int_t _, Item_t (Nat_t _, rest))) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IEdiv_int (kinfo, k))} in - let stack = Item_t (option_pair_int'_nat_t tname, rest) in + let stack = Item_t (option_pair_int_nat_t, rest) in typed ctxt loc instr stack - | (Prim (loc, I_EDIV, [], annot), Item_t (Nat_t tname, Item_t (Int_t _, rest))) - -> + | (Prim (loc, I_EDIV, [], annot), Item_t (Nat_t _, Item_t (Int_t _, rest))) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IEdiv_nat (kinfo, k))} in - let stack = Item_t (option_pair_int_nat'_t tname, rest) in + let stack = Item_t (option_pair_int_nat_t, rest) in typed ctxt loc instr stack - | (Prim (loc, I_EDIV, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) - -> + | (Prim (loc, I_EDIV, [], annot), Item_t (Nat_t _, Item_t (Nat_t _, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> let instr = {apply = (fun kinfo k -> IEdiv_nat (kinfo, k))} in - let stack = Item_t (option_pair_nat'_nat'_t tname, rest) in + let stack = Item_t (option_pair_nat_nat_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_LSL, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> ILsl_nat (kinfo, k))} in let stack = Item_t (Nat_t tname, rest) in typed ctxt loc instr stack | (Prim (loc, I_LSR, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> ILsr_nat (kinfo, k))} in let stack = Item_t (Nat_t tname, rest) in typed ctxt loc instr stack | (Prim (loc, I_OR, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IOr_nat (kinfo, k))} in let stack = Item_t (Nat_t tname, rest) in typed ctxt loc instr stack | (Prim (loc, I_AND, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAnd_nat (kinfo, k))} in let stack = Item_t (Nat_t tname, rest) in typed ctxt loc instr stack @@ -4430,8 +4329,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_XOR, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest))) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IXor_nat (kinfo, k))} in let stack = Item_t (Nat_t tname, rest) in typed ctxt loc instr stack @@ -4443,7 +4341,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_NOT, [], annot), Item_t (Nat_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> INot_int (kinfo, k))} in - let stack = Item_t (int_t ~annot:None, rest) in + let stack = Item_t (int_t, rest) in typed ctxt loc instr stack (* comparison *) | (Prim (loc, I_COMPARE, [], annot), Item_t (t1, Item_t (t2, rest))) -> @@ -4451,38 +4349,38 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : check_item_ty ctxt t1 t2 loc I_COMPARE 1 2 >>?= fun (Eq, t, ctxt) -> comparable_ty_of_ty ctxt loc t >>?= fun (key, ctxt) -> let instr = {apply = (fun kinfo k -> ICompare (kinfo, key, k))} in - let stack = Item_t (int_t ~annot:None, rest) in + let stack = Item_t (int_t, rest) in (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t) (* comparators *) | (Prim (loc, I_EQ, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IEq (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_NEQ, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> INeq (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_LT, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ILt (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_GT, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IGt (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_LE, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ILe (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_GE, [], annot), Item_t (Int_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IGe (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack (* annotations *) | (Prim (loc, I_CAST, [cast_t], annot), Item_t (t, stack)) -> @@ -4508,13 +4406,13 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : >>?= fun () -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IPack (kinfo, t, k))} in - let stack = Item_t (bytes_t ~annot:None, rest) in + let stack = Item_t (bytes_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_UNPACK, [ty], annot), Item_t (Bytes_t _, rest)) -> parse_packable_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy ty >>?= fun (Ex_ty t, ctxt) -> - parse_var_type_annot loc annot >>?= fun ty_name -> - option_t loc t ~annot:ty_name >>?= fun res_ty -> + check_var_type_annot loc annot >>?= fun () -> + option_t loc t >>?= fun res_ty -> let instr = {apply = (fun kinfo k -> IUnpack (kinfo, t, k))} in let stack = Item_t (res_ty, rest) in typed ctxt loc instr stack @@ -4522,13 +4420,13 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_ADDRESS, [], annot), Item_t (Contract_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IAddress (kinfo, k))} in - let stack = Item_t (address_t ~annot:None, rest) in + let stack = Item_t (address_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_CONTRACT, [ty], annot), Item_t (Address_t _, rest)) -> parse_parameter_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy ty >>?= fun (Ex_ty t, ctxt) -> - contract_t loc t ~annot:None >>?= fun contract_ty -> - option_t loc contract_ty ~annot:None >>?= fun res_ty -> + contract_t loc t >>?= fun contract_ty -> + option_t loc contract_ty >>?= fun res_ty -> parse_entrypoint_annot loc annot >>?= fun entrypoint -> Script_ir_annot.field_annot_opt_to_entrypoint_strict ~loc entrypoint >>?= fun entrypoint -> @@ -4543,7 +4441,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : parse_view_name ctxt name >>?= fun (name, ctxt) -> parse_view_output_ty ctxt ~stack_depth:0 ~legacy output_ty >>?= fun (Ex_ty output_ty, ctxt) -> - option_t output_ty_loc output_ty ~annot:None >>?= fun res_ty -> + option_t output_ty_loc output_ty >>?= fun res_ty -> check_var_annot loc annot >>?= fun () -> let instr = { @@ -4560,14 +4458,14 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : check_item_ty ctxt p cp loc prim 1 4 >>?= fun (Eq, _, ctxt) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ITransfer_tokens (kinfo, k))} in - let stack = Item_t (operation_t ~annot:None, rest) in + let stack = Item_t (operation_t, rest) in (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t) | ( Prim (loc, (I_SET_DELEGATE as prim), [], annot), Item_t (Option_t (Key_hash_t _, _), rest) ) -> Tc_context.check_not_in_view loc ~legacy tc_context prim >>?= fun () -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISet_delegate (kinfo, k))} in - let stack = Item_t (operation_t ~annot:None, rest) in + let stack = Item_t (operation_t, rest) in typed ctxt loc instr stack | (Prim (_, I_CREATE_ACCOUNT, _, _), _) -> fail (Deprecated_instruction I_CREATE_ACCOUNT) @@ -4604,9 +4502,8 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : ~legacy storage_type) >>?= fun (Ex_ty storage_type, ctxt) -> - pair_t loc (arg_type, None) (storage_type, None) ~annot:None - >>?= fun arg_type_full -> - pair_t loc (list_operation_t, None) (storage_type, None) ~annot:None + pair_t loc (arg_type, None) (storage_type, None) >>?= fun arg_type_full -> + pair_t loc (list_operation_t, None) (storage_type, None) >>?= fun ret_type_full -> trace (Ill_typed_contract (canonical_code, [])) @@ -4639,56 +4536,54 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : {kinfo; storage_type; arg_type; lambda; views; root_name; k}); } in - let stack = - Item_t (operation_t ~annot:None, Item_t (address_t ~annot:None, rest)) - in + let stack = Item_t (operation_t, Item_t (address_t, rest)) in typed ctxt loc instr stack | (Prim (loc, I_NOW, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> INow (kinfo, k))} in - let stack = Item_t (timestamp_t ~annot:None, stack) in + let stack = Item_t (timestamp_t, stack) in typed ctxt loc instr stack | (Prim (loc, I_AMOUNT, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IAmount (kinfo, k))} in - let stack = Item_t (mutez_t ~annot:None, stack) in + let stack = Item_t (mutez_t, stack) in typed ctxt loc instr stack | (Prim (loc, I_CHAIN_ID, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IChainId (kinfo, k))} in - let stack = Item_t (chain_id_t ~annot:None, stack) in + let stack = Item_t (chain_id_t, stack) in typed ctxt loc instr stack | (Prim (loc, I_BALANCE, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IBalance (kinfo, k))} in - let stack = Item_t (mutez_t ~annot:None, stack) in + let stack = Item_t (mutez_t, stack) in typed ctxt loc instr stack | (Prim (loc, I_LEVEL, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ILevel (kinfo, k))} in - let stack = Item_t (nat_t ~annot:None, stack) in + let stack = Item_t (nat_t, stack) in typed ctxt loc instr stack | (Prim (loc, I_VOTING_POWER, [], annot), Item_t (Key_hash_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IVoting_power (kinfo, k))} in - let stack = Item_t (nat_t ~annot:None, rest) in + let stack = Item_t (nat_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_TOTAL_VOTING_POWER, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ITotal_voting_power (kinfo, k))} in - let stack = Item_t (nat_t ~annot:None, stack) in + let stack = Item_t (nat_t, stack) in typed ctxt loc instr stack | (Prim (_, I_STEPS_TO_QUOTA, _, _), _) -> fail (Deprecated_instruction I_STEPS_TO_QUOTA) | (Prim (loc, I_SOURCE, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISource (kinfo, k))} in - let stack = Item_t (address_t ~annot:None, stack) in + let stack = Item_t (address_t, stack) in typed ctxt loc instr stack | (Prim (loc, I_SENDER, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISender (kinfo, k))} in - let stack = Item_t (address_t ~annot:None, stack) in + let stack = Item_t (address_t, stack) in typed ctxt loc instr stack | (Prim (loc, (I_SELF as prim), [], annot), stack) -> Lwt.return @@ -4716,7 +4611,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : ~root_name entrypoint >>? fun (_, Ex_ty param_type) -> - contract_t loc param_type ~annot:None >>? fun res_ty -> + contract_t loc param_type >>? fun res_ty -> let instr = { apply = @@ -4728,66 +4623,63 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_SELF_ADDRESS, [], annot), stack) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISelf_address (kinfo, k))} in - let stack = Item_t (address_t ~annot:None, stack) in + let stack = Item_t (address_t, stack) in typed ctxt loc instr stack (* cryptography *) | (Prim (loc, I_HASH_KEY, [], annot), Item_t (Key_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IHash_key (kinfo, k))} in - let stack = Item_t (key_hash_t ~annot:None, rest) in + let stack = Item_t (key_hash_t, rest) in typed ctxt loc instr stack | ( Prim (loc, I_CHECK_SIGNATURE, [], annot), Item_t (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest))) ) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ICheck_signature (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_BLAKE2B, [], annot), Item_t (Bytes_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IBlake2b (kinfo, k))} in - let stack = Item_t (bytes_t ~annot:None, rest) in + let stack = Item_t (bytes_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_SHA256, [], annot), Item_t (Bytes_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISha256 (kinfo, k))} in - let stack = Item_t (bytes_t ~annot:None, rest) in + let stack = Item_t (bytes_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_SHA512, [], annot), Item_t (Bytes_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISha512 (kinfo, k))} in - let stack = Item_t (bytes_t ~annot:None, rest) in + let stack = Item_t (bytes_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_KECCAK, [], annot), Item_t (Bytes_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IKeccak (kinfo, k))} in - let stack = Item_t (bytes_t ~annot:None, rest) in + let stack = Item_t (bytes_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_SHA3, [], annot), Item_t (Bytes_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> ISha3 (kinfo, k))} in - let stack = Item_t (bytes_t ~annot:None, rest) in + let stack = Item_t (bytes_t, rest) in typed ctxt loc instr stack | ( Prim (loc, I_ADD, [], annot), Item_t (Bls12_381_g1_t tn1, Item_t (Bls12_381_g1_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAdd_bls12_381_g1 (kinfo, k))} in let stack = Item_t (Bls12_381_g1_t tname, rest) in typed ctxt loc instr stack | ( Prim (loc, I_ADD, [], annot), Item_t (Bls12_381_g2_t tn1, Item_t (Bls12_381_g2_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAdd_bls12_381_g2 (kinfo, k))} in let stack = Item_t (Bls12_381_g2_t tname, rest) in typed ctxt loc instr stack | ( Prim (loc, I_ADD, [], annot), Item_t (Bls12_381_fr_t tn1, Item_t (Bls12_381_fr_t tn2, rest)) ) -> check_var_annot loc annot >>?= fun () -> - merge_type_metadata ~legacy ~error_details:Informative tn1 tn2 - >>?= fun tname -> + merge_type_metadata ~error_details:Informative tn1 tn2 >>?= fun tname -> let instr = {apply = (fun kinfo k -> IAdd_bls12_381_fr (kinfo, k))} in let stack = Item_t (Bls12_381_fr_t tname, rest) in typed ctxt loc instr stack @@ -4810,16 +4702,16 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let stack = Item_t (Bls12_381_fr_t tname, rest) in typed ctxt loc instr stack | ( Prim (loc, I_MUL, [], annot), - Item_t (Nat_t {annot = tname; _}, Item_t (Bls12_381_fr_t _, rest)) ) -> + Item_t (Nat_t _, Item_t (Bls12_381_fr_t _, rest)) ) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IMul_bls12_381_fr_z (kinfo, k))} in - let stack = Item_t (bls12_381_fr_t ~annot:tname, rest) in + let stack = Item_t (bls12_381_fr_t, rest) in typed ctxt loc instr stack | ( Prim (loc, I_MUL, [], annot), - Item_t (Int_t {annot = tname; _}, Item_t (Bls12_381_fr_t _, rest)) ) -> + Item_t (Int_t _, Item_t (Bls12_381_fr_t _, rest)) ) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IMul_bls12_381_fr_z (kinfo, k))} in - let stack = Item_t (bls12_381_fr_t ~annot:tname, rest) in + let stack = Item_t (bls12_381_fr_t, rest) in typed ctxt loc instr stack | ( Prim (loc, I_MUL, [], annot), Item_t (Bls12_381_fr_t tname, Item_t (Int_t _, rest)) ) -> @@ -4836,7 +4728,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : | (Prim (loc, I_INT, [], annot), Item_t (Bls12_381_fr_t _, rest)) -> check_var_annot loc annot >>?= fun () -> let instr = {apply = (fun kinfo k -> IInt_bls12_381_fr (kinfo, k))} in - let stack = Item_t (int_t ~annot:None, rest) in + let stack = Item_t (int_t, rest) in typed ctxt loc instr stack | (Prim (loc, I_NEG, [], annot), Item_t (Bls12_381_g1_t tname, rest)) -> check_var_annot loc annot >>?= fun () -> @@ -4861,13 +4753,13 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : let instr = {apply = (fun kinfo k -> IPairing_check_bls12_381 (kinfo, k))} in - let stack = Item_t (bool_t ~annot:None, rest) in + let stack = Item_t (bool_t, rest) in typed ctxt loc instr stack (* Tickets *) | (Prim (loc, I_TICKET, [], annot), Item_t (t, Item_t (Nat_t _, rest))) -> check_var_annot loc annot >>?= fun () -> comparable_ty_of_ty ctxt loc t >>?= fun (ty, ctxt) -> - ticket_t loc ty ~annot:None >>?= fun res_ty -> + ticket_t loc ty >>?= fun res_ty -> let instr = {apply = (fun kinfo k -> ITicket (kinfo, k))} in let stack = Item_t (res_ty, rest) in typed ctxt loc instr stack @@ -4886,9 +4778,8 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : Item_t (Pair_t ((Nat_t _, fa_a), (Nat_t _, fa_b), _), rest) ) ) -> check_var_annot loc annot >>?= fun () -> let () = check_dupable_comparable_ty t in - pair_t loc (ticket_t, fa_a) (ticket_t, fa_b) ~annot:None - >>?= fun pair_tickets_ty -> - option_t loc pair_tickets_ty ~annot:None >>?= fun res_ty -> + pair_t loc (ticket_t, fa_a) (ticket_t, fa_b) >>?= fun pair_tickets_ty -> + option_t loc pair_tickets_ty >>?= fun res_ty -> let instr = {apply = (fun kinfo k -> ISplit_ticket (kinfo, k))} in let stack = Item_t (res_ty, rest) in typed ctxt loc instr stack @@ -4903,7 +4794,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : eq_ty >>?= fun (Eq, ty) -> match ty with | Ticket_t (contents_ty, _) -> - option_t loc ty ~annot:None >>?= fun res_ty -> + option_t loc ty >>?= fun res_ty -> let instr = {apply = (fun kinfo k -> IJoin_tickets (kinfo, contents_ty, k))} in @@ -5129,8 +5020,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contra if Entrypoint.is_default entrypoint then (* An implicit account on the "default" entrypoint always exists and has type unit. *) Lwt.return - ( ty_eq ~legacy:true ctxt loc arg (unit_t ~annot:None) - >|? fun (Eq, ctxt) -> + ( ty_eq ~legacy:true ctxt loc arg unit_t >|? fun (Eq, ctxt) -> (ctxt, {arg_ty = arg; address = {contract; entrypoint}}) ) else fail (No_such_entrypoint entrypoint) | None -> ( @@ -5306,12 +5196,7 @@ let parse_contract_for_script : (* An implicit account on the "default" entrypoint always exists and has type unit. *) Lwt.return ( Gas_monad.run ctxt - @@ merge_types - ~legacy:true - ~error_details:Fast - loc - arg - (unit_t ~annot:None) + @@ merge_types ~legacy:true ~error_details:Fast loc arg unit_t >|? fun (eq_ty, ctxt) -> match eq_ty with | Ok (Eq, _ty) -> @@ -5395,13 +5280,9 @@ let parse_code : (Ill_formed_type (Some "storage", code, storage_type_loc)) (parse_storage_ty ctxt ~stack_depth:0 ~legacy storage_type) >>?= fun (Ex_ty storage_type, ctxt) -> - pair_t storage_type_loc (arg_type, None) (storage_type, None) ~annot:None + pair_t storage_type_loc (arg_type, None) (storage_type, None) >>?= fun arg_type_full -> - pair_t - storage_type_loc - (list_operation_t, None) - (storage_type, None) - ~annot:None + pair_t storage_type_loc (list_operation_t, None) (storage_type, None) >>?= fun ret_type_full -> trace (Ill_typed_contract (code, [])) @@ -5510,13 +5391,9 @@ let typecheck_code : (Ill_formed_type (Some "storage", code, storage_type_loc)) (parse_storage_ty ctxt ~stack_depth:0 ~legacy storage_type) >>?= fun (Ex_ty storage_type, ctxt) -> - pair_t storage_type_loc (arg_type, None) (storage_type, None) ~annot:None + pair_t storage_type_loc (arg_type, None) (storage_type, None) >>?= fun arg_type_full -> - pair_t - storage_type_loc - (list_operation_t, None) - (storage_type, None) - ~annot:None + pair_t storage_type_loc (list_operation_t, None) (storage_type, None) >>?= fun ret_type_full -> let type_logger loc bef aft = type_map := (loc, (bef, aft)) :: !type_map in let type_logger = if show_types then Some type_logger else None in @@ -5720,7 +5597,7 @@ let[@coq_axiom_with_reason "gadt"] rec unparse_data : in (* this can't fail if the original type is well-formed because [option vt] is always strictly smaller than [big_map kt vt] *) - option_t loc vt ~annot:None >>?= fun vt -> + option_t loc vt >>?= fun vt -> unparse_items ctxt ~stack_depth:(stack_depth + 1) mode kt vt items >|=? fun (items, ctxt) -> ( Micheline.Prim diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index 9c7893c63a231a4b514180d6df41c013d1672aa4..3d22feafec8c94ff191aedb2887bb857b1a0e517 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -310,7 +310,7 @@ type empty_cell = EmptyCell type end_of_stack = empty_cell * empty_cell -type 'a ty_metadata = {annot : type_annot option; size : 'a Type_size.t} +type 'a ty_metadata = {size : 'a Type_size.t} [@@unboxed] type _ comparable_ty = | Unit_key : unit ty_metadata -> unit comparable_ty @@ -366,48 +366,47 @@ let comparable_ty_metadata : type a. a comparable_ty -> a ty_metadata = function let comparable_ty_size t = (comparable_ty_metadata t).size -let unit_key ~annot = Unit_key {annot; size = Type_size.one} +let unit_key = Unit_key {size = Type_size.one} -let never_key ~annot = Never_key {annot; size = Type_size.one} +let never_key = Never_key {size = Type_size.one} -let int_key ~annot = Int_key {annot; size = Type_size.one} +let int_key = Int_key {size = Type_size.one} -let nat_key ~annot = Nat_key {annot; size = Type_size.one} +let nat_key = Nat_key {size = Type_size.one} -let signature_key ~annot = Signature_key {annot; size = Type_size.one} +let signature_key = Signature_key {size = Type_size.one} -let string_key ~annot = String_key {annot; size = Type_size.one} +let string_key = String_key {size = Type_size.one} -let bytes_key ~annot = Bytes_key {annot; size = Type_size.one} +let bytes_key = Bytes_key {size = Type_size.one} -let mutez_key ~annot = Mutez_key {annot; size = Type_size.one} +let mutez_key = Mutez_key {size = Type_size.one} -let bool_key ~annot = Bool_key {annot; size = Type_size.one} +let bool_key = Bool_key {size = Type_size.one} -let key_hash_key ~annot = Key_hash_key {annot; size = Type_size.one} +let key_hash_key = Key_hash_key {size = Type_size.one} -let key_key ~annot = Key_key {annot; size = Type_size.one} +let key_key = Key_key {size = Type_size.one} -let timestamp_key ~annot = Timestamp_key {annot; size = Type_size.one} +let timestamp_key = Timestamp_key {size = Type_size.one} -let chain_id_key ~annot = Chain_id_key {annot; size = Type_size.one} +let chain_id_key = Chain_id_key {size = Type_size.one} -let address_key ~annot = Address_key {annot; size = Type_size.one} +let address_key = Address_key {size = Type_size.one} -let pair_key loc (l, fannot_l) (r, fannot_r) ~annot = +let pair_key loc (l, fannot_l) (r, fannot_r) = Type_size.compound2 loc (comparable_ty_size l) (comparable_ty_size r) - >|? fun size -> Pair_key ((l, fannot_l), (r, fannot_r), {annot; size}) + >|? fun size -> Pair_key ((l, fannot_l), (r, fannot_r), {size}) -let pair_3_key loc l m r = - pair_key loc m r ~annot:None >>? fun r -> pair_key loc l (r, None) ~annot:None +let pair_3_key loc l m r = pair_key loc m r >>? fun r -> pair_key loc l (r, None) -let union_key loc (l, fannot_l) (r, fannot_r) ~annot = +let union_key loc (l, fannot_l) (r, fannot_r) = Type_size.compound2 loc (comparable_ty_size l) (comparable_ty_size r) - >|? fun size -> Union_key ((l, fannot_l), (r, fannot_r), {annot; size}) + >|? fun size -> Union_key ((l, fannot_l), (r, fannot_r), {size}) -let option_key loc t ~annot = +let option_key loc t = Type_size.compound1 loc (comparable_ty_size t) >|? fun size -> - Option_key (t, {annot; size}) + Option_key (t, {size}) (* @@ -1812,169 +1811,123 @@ let ty_metadata : type a. a ty -> a ty_metadata = function let ty_size t = (ty_metadata t).size -let unit_t ~annot = Unit_t {annot; size = Type_size.one} +let unit_t = Unit_t {size = Type_size.one} -let int_t ~annot = Int_t {annot; size = Type_size.one} +let int_t = Int_t {size = Type_size.one} -let nat_t ~annot = Nat_t {annot; size = Type_size.one} +let nat_t = Nat_t {size = Type_size.one} -let signature_t ~annot = Signature_t {annot; size = Type_size.one} +let signature_t = Signature_t {size = Type_size.one} -let string_t ~annot = String_t {annot; size = Type_size.one} +let string_t = String_t {size = Type_size.one} -let bytes_t ~annot = Bytes_t {annot; size = Type_size.one} +let bytes_t = Bytes_t {size = Type_size.one} -let mutez_t ~annot = Mutez_t {annot; size = Type_size.one} +let mutez_t = Mutez_t {size = Type_size.one} -let key_hash_t ~annot = Key_hash_t {annot; size = Type_size.one} +let key_hash_t = Key_hash_t {size = Type_size.one} -let key_t ~annot = Key_t {annot; size = Type_size.one} +let key_t = Key_t {size = Type_size.one} -let timestamp_t ~annot = Timestamp_t {annot; size = Type_size.one} +let timestamp_t = Timestamp_t {size = Type_size.one} -let address_t ~annot = Address_t {annot; size = Type_size.one} +let address_t = Address_t {size = Type_size.one} -let bool_t ~annot = Bool_t {annot; size = Type_size.one} +let bool_t = Bool_t {size = Type_size.one} -let pair_t loc (l, fannot_l) (r, fannot_r) ~annot = +let pair_t loc (l, fannot_l) (r, fannot_r) = Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> - Pair_t ((l, fannot_l), (r, fannot_r), {annot; size}) + Pair_t ((l, fannot_l), (r, fannot_r), {size}) -let union_t loc (l, fannot_l) (r, fannot_r) ~annot = +let union_t loc (l, fannot_l) (r, fannot_r) = Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> - Union_t ((l, fannot_l), (r, fannot_r), {annot; size}) + Union_t ((l, fannot_l), (r, fannot_r), {size}) let union_bytes_bool_t = - Union_t - ( (bytes_t ~annot:None, None), - (bool_t ~annot:None, None), - {annot = None; size = Type_size.three} ) + Union_t ((bytes_t, None), (bool_t, None), {size = Type_size.three}) -let lambda_t loc l r ~annot = +let lambda_t loc l r = Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size -> - Lambda_t (l, r, {annot; size}) + Lambda_t (l, r, {size}) -let option_t loc t ~annot = - Type_size.compound1 loc (ty_size t) >|? fun size -> Option_t (t, {annot; size}) +let option_t loc t = + Type_size.compound1 loc (ty_size t) >|? fun size -> Option_t (t, {size}) -let option_mutez'_t meta = - let {annot; size = _} = meta in - Option_t (mutez_t ~annot, {annot = None; size = Type_size.two}) +let option_mutez_t = Option_t (mutez_t, {size = Type_size.two}) -let option_string'_t meta = - let {annot; size = _} = meta in - Option_t (string_t ~annot, {annot = None; size = Type_size.two}) +let option_string_t = Option_t (string_t, {size = Type_size.two}) -let option_bytes'_t meta = - let {annot; size = _} = meta in - Option_t (bytes_t ~annot, {annot = None; size = Type_size.two}) +let option_bytes_t = Option_t (bytes_t, {size = Type_size.two}) -let option_nat_t = - Option_t (nat_t ~annot:None, {annot = None; size = Type_size.two}) +let option_nat_t = Option_t (nat_t, {size = Type_size.two}) let option_pair_nat_nat_t = Option_t - ( Pair_t - ( (nat_t ~annot:None, None), - (nat_t ~annot:None, None), - {annot = None; size = Type_size.three} ), - {annot = None; size = Type_size.four} ) - -let option_pair_nat'_nat'_t meta = - let {annot; size = _} = meta in - Option_t - ( Pair_t - ( (nat_t ~annot, None), - (nat_t ~annot, None), - {annot = None; size = Type_size.three} ), - {annot = None; size = Type_size.four} ) - -let option_pair_nat_mutez'_t meta = - let {annot; size = _} = meta in - Option_t - ( Pair_t - ( (nat_t ~annot:None, None), - (mutez_t ~annot, None), - {annot = None; size = Type_size.three} ), - {annot = None; size = Type_size.four} ) - -let option_pair_mutez'_mutez'_t meta = - let {annot; size = _} = meta in + ( Pair_t ((nat_t, None), (nat_t, None), {size = Type_size.three}), + {size = Type_size.four} ) + +let option_pair_nat_mutez_t = Option_t - ( Pair_t - ( (mutez_t ~annot, None), - (mutez_t ~annot, None), - {annot = None; size = Type_size.three} ), - {annot = None; size = Type_size.four} ) - -let option_pair_int'_nat_t meta = - let {annot; size = _} = meta in + ( Pair_t ((nat_t, None), (mutez_t, None), {size = Type_size.three}), + {size = Type_size.four} ) + +let option_pair_mutez_mutez_t = Option_t - ( Pair_t - ( (int_t ~annot, None), - (nat_t ~annot:None, None), - {annot = None; size = Type_size.three} ), - {annot = None; size = Type_size.four} ) - -let option_pair_int_nat'_t meta = - let {annot; size = _} = meta in + ( Pair_t ((mutez_t, None), (mutez_t, None), {size = Type_size.three}), + {size = Type_size.four} ) + +let option_pair_int_nat_t = Option_t - ( Pair_t - ( (int_t ~annot:None, None), - (nat_t ~annot, None), - {annot = None; size = Type_size.three} ), - {annot = None; size = Type_size.four} ) + ( Pair_t ((int_t, None), (nat_t, None), {size = Type_size.three}), + {size = Type_size.four} ) -let list_t loc t ~annot = - Type_size.compound1 loc (ty_size t) >|? fun size -> List_t (t, {annot; size}) +let list_t loc t = + Type_size.compound1 loc (ty_size t) >|? fun size -> List_t (t, {size}) -let operation_t ~annot = Operation_t {annot; size = Type_size.one} +let operation_t = Operation_t {size = Type_size.one} -let list_operation_t = - List_t (operation_t ~annot:None, {annot = None; size = Type_size.two}) +let list_operation_t = List_t (operation_t, {size = Type_size.two}) -let set_t loc t ~annot = +let set_t loc t = Type_size.compound1 loc (comparable_ty_size t) >|? fun size -> - Set_t (t, {annot; size}) + Set_t (t, {size}) -let map_t loc l r ~annot = +let map_t loc l r = Type_size.compound2 loc (comparable_ty_size l) (ty_size r) >|? fun size -> - Map_t (l, r, {annot; size}) + Map_t (l, r, {size}) -let big_map_t loc l r ~annot = +let big_map_t loc l r = Type_size.compound2 loc (comparable_ty_size l) (ty_size r) >|? fun size -> - Big_map_t (l, r, {annot; size}) + Big_map_t (l, r, {size}) -let contract_t loc t ~annot = - Type_size.compound1 loc (ty_size t) >|? fun size -> - Contract_t (t, {annot; size}) +let contract_t loc t = + Type_size.compound1 loc (ty_size t) >|? fun size -> Contract_t (t, {size}) -let contract_unit_t = - Contract_t (unit_t ~annot:None, {annot = None; size = Type_size.two}) +let contract_unit_t = Contract_t (unit_t, {size = Type_size.two}) -let sapling_transaction_t ~memo_size ~annot = - Sapling_transaction_t (memo_size, {annot; size = Type_size.one}) +let sapling_transaction_t ~memo_size = + Sapling_transaction_t (memo_size, {size = Type_size.one}) -let sapling_state_t ~memo_size ~annot = - Sapling_state_t (memo_size, {annot; size = Type_size.one}) +let sapling_state_t ~memo_size = + Sapling_state_t (memo_size, {size = Type_size.one}) -let chain_id_t ~annot = Chain_id_t {annot; size = Type_size.one} +let chain_id_t = Chain_id_t {size = Type_size.one} -let never_t ~annot = Never_t {annot; size = Type_size.one} +let never_t = Never_t {size = Type_size.one} -let bls12_381_g1_t ~annot = Bls12_381_g1_t {annot; size = Type_size.one} +let bls12_381_g1_t = Bls12_381_g1_t {size = Type_size.one} -let bls12_381_g2_t ~annot = Bls12_381_g2_t {annot; size = Type_size.one} +let bls12_381_g2_t = Bls12_381_g2_t {size = Type_size.one} -let bls12_381_fr_t ~annot = Bls12_381_fr_t {annot; size = Type_size.one} +let bls12_381_fr_t = Bls12_381_fr_t {size = Type_size.one} -let ticket_t loc t ~annot = +let ticket_t loc t = Type_size.compound1 loc (comparable_ty_size t) >|? fun size -> - Ticket_t (t, {annot; size}) + Ticket_t (t, {size}) -let chest_key_t ~annot = Chest_key_t {annot; size = Type_size.one} +let chest_key_t = Chest_key_t {size = Type_size.one} -let chest_t ~annot = Chest_t {annot; size = Type_size.one} +let chest_t = Chest_t {size = Type_size.one} type 'a kinstr_traverse = { apply : 'b 'u 'r 'f. 'a -> ('b, 'u, 'r, 'f) kinstr -> 'a; diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index 0bd3069c0b627c8e7fab5a7ee4b0c15bac4d50d0..4f1225e63d3c86a28a34cd03205f52263cf7d32d 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -188,7 +188,7 @@ module Type_size : sig val to_int : 'a t -> Saturation_repr.mul_safe Saturation_repr.t end -type 'a ty_metadata = {annot : type_annot option; size : 'a Type_size.t} +type 'a ty_metadata = {size : 'a Type_size.t} [@@unboxed] type _ comparable_ty = | Unit_key : unit ty_metadata -> unit comparable_ty @@ -223,39 +223,38 @@ type _ comparable_ty = 'v comparable_ty * 'v option ty_metadata -> 'v option comparable_ty -val unit_key : annot:type_annot option -> unit comparable_ty +val unit_key : unit comparable_ty -val never_key : annot:type_annot option -> never comparable_ty +val never_key : never comparable_ty -val int_key : annot:type_annot option -> z num comparable_ty +val int_key : z num comparable_ty -val nat_key : annot:type_annot option -> n num comparable_ty +val nat_key : n num comparable_ty -val signature_key : annot:type_annot option -> signature comparable_ty +val signature_key : signature comparable_ty -val string_key : annot:type_annot option -> Script_string.t comparable_ty +val string_key : Script_string.t comparable_ty -val bytes_key : annot:type_annot option -> Bytes.t comparable_ty +val bytes_key : Bytes.t comparable_ty -val mutez_key : annot:type_annot option -> Tez.t comparable_ty +val mutez_key : Tez.t comparable_ty -val bool_key : annot:type_annot option -> bool comparable_ty +val bool_key : bool comparable_ty -val key_hash_key : annot:type_annot option -> public_key_hash comparable_ty +val key_hash_key : public_key_hash comparable_ty -val key_key : annot:type_annot option -> public_key comparable_ty +val key_key : public_key comparable_ty -val timestamp_key : annot:type_annot option -> Script_timestamp.t comparable_ty +val timestamp_key : Script_timestamp.t comparable_ty -val chain_id_key : annot:type_annot option -> Script_chain_id.t comparable_ty +val chain_id_key : Script_chain_id.t comparable_ty -val address_key : annot:type_annot option -> address comparable_ty +val address_key : address comparable_ty val pair_key : Script.location -> 'a comparable_ty * field_annot option -> 'b comparable_ty * field_annot option -> - annot:type_annot option -> ('a, 'b) pair comparable_ty tzresult val pair_3_key : @@ -269,14 +268,10 @@ val union_key : Script.location -> 'a comparable_ty * field_annot option -> 'b comparable_ty * field_annot option -> - annot:type_annot option -> ('a, 'b) union comparable_ty tzresult val option_key : - Script.location -> - 'v comparable_ty -> - annot:type_annot option -> - 'v option comparable_ty tzresult + Script.location -> 'v comparable_ty -> 'v option comparable_ty tzresult module type Boxed_set_OPS = sig type t @@ -1541,143 +1536,103 @@ val ty_size : 'a ty -> 'a Type_size.t val comparable_ty_size : 'a comparable_ty -> 'a Type_size.t -val unit_t : annot:type_annot option -> unit ty +val unit_t : unit ty -val int_t : annot:type_annot option -> z num ty +val int_t : z num ty -val nat_t : annot:type_annot option -> n num ty +val nat_t : n num ty -val signature_t : annot:type_annot option -> signature ty +val signature_t : signature ty -val string_t : annot:type_annot option -> Script_string.t ty +val string_t : Script_string.t ty -val bytes_t : annot:type_annot option -> Bytes.t ty +val bytes_t : Bytes.t ty -val mutez_t : annot:type_annot option -> Tez.t ty +val mutez_t : Tez.t ty -val key_hash_t : annot:type_annot option -> public_key_hash ty +val key_hash_t : public_key_hash ty -val key_t : annot:type_annot option -> public_key ty +val key_t : public_key ty -val timestamp_t : annot:type_annot option -> Script_timestamp.t ty +val timestamp_t : Script_timestamp.t ty -val address_t : annot:type_annot option -> address ty +val address_t : address ty -val bool_t : annot:type_annot option -> bool ty +val bool_t : bool ty val pair_t : Script.location -> 'a ty * field_annot option -> 'b ty * field_annot option -> - annot:type_annot option -> ('a, 'b) pair ty tzresult val union_t : Script.location -> 'a ty * field_annot option -> 'b ty * field_annot option -> - annot:type_annot option -> ('a, 'b) union ty tzresult val union_bytes_bool_t : (Bytes.t, bool) union ty val lambda_t : - Script.location -> - 'arg ty -> - 'ret ty -> - annot:type_annot option -> - ('arg, 'ret) lambda ty tzresult - -val option_t : - Script.location -> 'v ty -> annot:type_annot option -> 'v option ty tzresult + Script.location -> 'arg ty -> 'ret ty -> ('arg, 'ret) lambda ty tzresult -(* the quote is used to indicate where the annotation will go *) +val option_t : Script.location -> 'v ty -> 'v option ty tzresult -val option_mutez'_t : _ ty_metadata -> Tez.t option ty +val option_mutez_t : Tez.t option ty -val option_string'_t : _ ty_metadata -> Script_string.t option ty +val option_string_t : Script_string.t option ty -val option_bytes'_t : _ ty_metadata -> Bytes.t option ty +val option_bytes_t : Bytes.t option ty val option_nat_t : n num option ty val option_pair_nat_nat_t : (n num, n num) pair option ty -val option_pair_nat'_nat'_t : _ ty_metadata -> (n num, n num) pair option ty +val option_pair_nat_mutez_t : (n num, Tez.t) pair option ty -val option_pair_nat_mutez'_t : _ ty_metadata -> (n num, Tez.t) pair option ty +val option_pair_mutez_mutez_t : (Tez.t, Tez.t) pair option ty -val option_pair_mutez'_mutez'_t : _ ty_metadata -> (Tez.t, Tez.t) pair option ty +val option_pair_int_nat_t : (z num, n num) pair option ty -val option_pair_int'_nat_t : _ ty_metadata -> (z num, n num) pair option ty - -val option_pair_int_nat'_t : _ ty_metadata -> (z num, n num) pair option ty - -val list_t : - Script.location -> - 'v ty -> - annot:type_annot option -> - 'v boxed_list ty tzresult +val list_t : Script.location -> 'v ty -> 'v boxed_list ty tzresult val list_operation_t : operation boxed_list ty -val set_t : - Script.location -> - 'v comparable_ty -> - annot:type_annot option -> - 'v set ty tzresult +val set_t : Script.location -> 'v comparable_ty -> 'v set ty tzresult val map_t : - Script.location -> - 'k comparable_ty -> - 'v ty -> - annot:type_annot option -> - ('k, 'v) map ty tzresult + Script.location -> 'k comparable_ty -> 'v ty -> ('k, 'v) map ty tzresult val big_map_t : - Script.location -> - 'k comparable_ty -> - 'v ty -> - annot:type_annot option -> - ('k, 'v) big_map ty tzresult + Script.location -> 'k comparable_ty -> 'v ty -> ('k, 'v) big_map ty tzresult -val contract_t : - Script.location -> - 'arg ty -> - annot:type_annot option -> - 'arg typed_contract ty tzresult +val contract_t : Script.location -> 'arg ty -> 'arg typed_contract ty tzresult val contract_unit_t : unit typed_contract ty val sapling_transaction_t : - memo_size:Sapling.Memo_size.t -> - annot:type_annot option -> - Sapling.transaction ty + memo_size:Sapling.Memo_size.t -> Sapling.transaction ty -val sapling_state_t : - memo_size:Sapling.Memo_size.t -> annot:type_annot option -> Sapling.state ty +val sapling_state_t : memo_size:Sapling.Memo_size.t -> Sapling.state ty -val operation_t : annot:type_annot option -> operation ty +val operation_t : operation ty -val chain_id_t : annot:type_annot option -> Script_chain_id.t ty +val chain_id_t : Script_chain_id.t ty -val never_t : annot:type_annot option -> never ty +val never_t : never ty -val bls12_381_g1_t : annot:type_annot option -> Script_bls.G1.t ty +val bls12_381_g1_t : Script_bls.G1.t ty -val bls12_381_g2_t : annot:type_annot option -> Script_bls.G2.t ty +val bls12_381_g2_t : Script_bls.G2.t ty -val bls12_381_fr_t : annot:type_annot option -> Script_bls.Fr.t ty +val bls12_381_fr_t : Script_bls.Fr.t ty -val ticket_t : - Script.location -> - 'a comparable_ty -> - annot:type_annot option -> - 'a ticket ty tzresult +val ticket_t : Script.location -> 'a comparable_ty -> 'a ticket ty tzresult -val chest_key_t : annot:type_annot option -> Script_timelock.chest_key ty +val chest_key_t : Script_timelock.chest_key ty -val chest_t : annot:type_annot option -> Script_timelock.chest ty +val chest_t : Script_timelock.chest ty (** diff --git a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml index 2950658c7c9dca3b168fbbb1452796a1bea0a0c7..bd50d9f0cbb468f5b3b5862b0267c36cd5f2294b 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml @@ -33,72 +33,83 @@ let script_string_size s = Script_string.to_string s |> string_size let sapling_memo_size_size = !!0 let (comparable_ty_size, ty_size) = - let base {annot = _; size = _} = hh3w in + let base_basic _meta = + !!0 + (* Basic types count for 0 because they are all static values, hence shared + and not counted by `reachable_words`. + On the other hand compound types are functions, hence not shared. *) + in + let base_compound _meta = h1w in let apply_comparable : type a. nodes_and_size -> a comparable_ty -> nodes_and_size = fun accu cty -> match cty with - | Unit_key a -> ret_succ_adding accu (base a) - | Int_key a -> ret_succ_adding accu (base a) - | Nat_key a -> ret_succ_adding accu (base a) - | Signature_key a -> ret_succ_adding accu (base a) - | String_key a -> ret_succ_adding accu (base a) - | Bytes_key a -> ret_succ_adding accu (base a) - | Mutez_key a -> ret_succ_adding accu (base a) - | Key_hash_key a -> ret_succ_adding accu (base a) - | Key_key a -> ret_succ_adding accu (base a) - | Timestamp_key a -> ret_succ_adding accu (base a) - | Address_key a -> ret_succ_adding accu (base a) - | Bool_key a -> ret_succ_adding accu (base a) - | Chain_id_key a -> ret_succ_adding accu (base a) - | Never_key a -> ret_succ_adding accu (base a) + | Unit_key a -> ret_succ_adding accu (base_basic a) + | Int_key a -> ret_succ_adding accu (base_basic a) + | Nat_key a -> ret_succ_adding accu (base_basic a) + | Signature_key a -> ret_succ_adding accu (base_basic a) + | String_key a -> ret_succ_adding accu (base_basic a) + | Bytes_key a -> ret_succ_adding accu (base_basic a) + | Mutez_key a -> ret_succ_adding accu (base_basic a) + | Key_hash_key a -> ret_succ_adding accu (base_basic a) + | Key_key a -> ret_succ_adding accu (base_basic a) + | Timestamp_key a -> ret_succ_adding accu (base_basic a) + | Address_key a -> ret_succ_adding accu (base_basic a) + | Bool_key a -> ret_succ_adding accu (base_basic a) + | Chain_id_key a -> ret_succ_adding accu (base_basic a) + | Never_key a -> ret_succ_adding accu (base_basic a) | Pair_key ((_ty1, _fa1), (_ty2, _fa2), a) -> - ret_succ_adding accu @@ (base a +! hh6w) + ret_succ_adding accu @@ (base_compound a +! hh6w) | Union_key ((_ty1, _fa1), (_ty2, _fa2), a) -> - ret_succ_adding accu @@ (base a +! hh6w) - | Option_key (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size) + ret_succ_adding accu @@ (base_compound a +! hh6w) + | Option_key (_ty, a) -> + ret_succ_adding accu @@ (base_compound a +! word_size) and apply : type a. nodes_and_size -> a ty -> nodes_and_size = fun accu ty -> match ty with - | Unit_t a -> ret_succ_adding accu @@ base a - | Int_t a -> ret_succ_adding accu @@ base a - | Nat_t a -> ret_succ_adding accu @@ base a - | Signature_t a -> ret_succ_adding accu @@ base a - | String_t a -> ret_succ_adding accu @@ base a - | Bytes_t a -> ret_succ_adding accu @@ base a - | Mutez_t a -> ret_succ_adding accu @@ base a - | Key_hash_t a -> ret_succ_adding accu @@ base a - | Key_t a -> ret_succ_adding accu @@ base a - | Timestamp_t a -> ret_succ_adding accu @@ base a - | Address_t a -> ret_succ_adding accu @@ base a - | Bool_t a -> ret_succ_adding accu @@ base a - | Operation_t a -> ret_succ_adding accu @@ base a - | Chain_id_t a -> ret_succ_adding accu @@ base a - | Never_t a -> ret_succ_adding accu @@ base a - | Bls12_381_g1_t a -> ret_succ_adding accu @@ base a - | Bls12_381_g2_t a -> ret_succ_adding accu @@ base a - | Bls12_381_fr_t a -> ret_succ_adding accu @@ base a - | Chest_key_t a -> ret_succ_adding accu @@ base a - | Chest_t a -> ret_succ_adding accu @@ base a + | Unit_t a -> ret_succ_adding accu @@ base_basic a + | Int_t a -> ret_succ_adding accu @@ base_basic a + | Nat_t a -> ret_succ_adding accu @@ base_basic a + | Signature_t a -> ret_succ_adding accu @@ base_basic a + | String_t a -> ret_succ_adding accu @@ base_basic a + | Bytes_t a -> ret_succ_adding accu @@ base_basic a + | Mutez_t a -> ret_succ_adding accu @@ base_basic a + | Key_hash_t a -> ret_succ_adding accu @@ base_basic a + | Key_t a -> ret_succ_adding accu @@ base_basic a + | Timestamp_t a -> ret_succ_adding accu @@ base_basic a + | Address_t a -> ret_succ_adding accu @@ base_basic a + | Bool_t a -> ret_succ_adding accu @@ base_basic a + | Operation_t a -> ret_succ_adding accu @@ base_basic a + | Chain_id_t a -> ret_succ_adding accu @@ base_basic a + | Never_t a -> ret_succ_adding accu @@ base_basic a + | Bls12_381_g1_t a -> ret_succ_adding accu @@ base_basic a + | Bls12_381_g2_t a -> ret_succ_adding accu @@ base_basic a + | Bls12_381_fr_t a -> ret_succ_adding accu @@ base_basic a + | Chest_key_t a -> ret_succ_adding accu @@ base_basic a + | Chest_t a -> ret_succ_adding accu @@ base_basic a | Pair_t ((_ty1, _fa1), (_ty2, _fa2), a) -> - ret_succ_adding accu @@ (base a +! hh6w) + ret_succ_adding accu @@ (base_compound a +! hh6w) | Union_t ((_ty1, _fa1), (_ty2, _fa2), a) -> - ret_succ_adding accu @@ (base a +! hh6w) + ret_succ_adding accu @@ (base_compound a +! hh6w) | Lambda_t (_ty1, _ty2, a) -> - ret_succ_adding accu @@ (base a +! (word_size *? 2)) - | Option_t (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size) - | List_t (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size) - | Set_t (_cty, a) -> ret_succ_adding accu @@ (base a +! word_size) + ret_succ_adding accu @@ (base_compound a +! (word_size *? 2)) + | Option_t (_ty, a) -> ret_succ_adding accu @@ (base_compound a +! word_size) + | List_t (_ty, a) -> ret_succ_adding accu @@ (base_compound a +! word_size) + | Set_t (_cty, a) -> ret_succ_adding accu @@ (base_compound a +! word_size) | Map_t (_cty, _ty, a) -> - ret_succ_adding accu @@ (base a +! (word_size *? 2)) + ret_succ_adding accu @@ (base_compound a +! (word_size *? 2)) | Big_map_t (_cty, _ty, a) -> - ret_succ_adding accu @@ (base a +! (word_size *? 2)) - | Contract_t (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size) + ret_succ_adding accu @@ (base_compound a +! (word_size *? 2)) + | Contract_t (_ty, a) -> + ret_succ_adding accu @@ (base_compound a +! word_size) | Sapling_transaction_t (_m, a) -> - ret_succ_adding accu @@ (base a +! sapling_memo_size_size +! word_size) + ret_succ_adding accu + @@ (base_compound a +! sapling_memo_size_size +! word_size) | Sapling_state_t (_m, a) -> - ret_succ_adding accu @@ (base a +! sapling_memo_size_size +! word_size) - | Ticket_t (_cty, a) -> ret_succ_adding accu @@ (base a +! word_size) + ret_succ_adding accu + @@ (base_compound a +! sapling_memo_size_size +! word_size) + | Ticket_t (_cty, a) -> + ret_succ_adding accu @@ (base_compound a +! word_size) in let f = ({apply; apply_comparable} : nodes_and_size ty_traverse) in ( (fun cty -> comparable_ty_traverse cty zero f), diff --git a/src/proto_alpha/lib_protocol/test/helpers/lqt_fa12_repr.ml b/src/proto_alpha/lib_protocol/test/helpers/lqt_fa12_repr.ml index 43c9dab4a1c515c903be02483a10f44097dfbb18..8cdfa341d05ca163675144b7c638a7971e79b6f8 100644 --- a/src/proto_alpha/lib_protocol/test/helpers/lqt_fa12_repr.ml +++ b/src/proto_alpha/lib_protocol/test/helpers/lqt_fa12_repr.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2021 Nomadic Labs *) +(* Copyright (c) 2021-2022 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -216,10 +216,7 @@ module Storage = struct get ctxt ~contract >>=? fun storage -> let tokens = storage.tokens in get_alpha_context ctxt >>=? fun ctxt -> - Script_ir_translator.hash_data - ctxt - Script_typed_ir.(address_t ~annot:None) - owner + Script_ir_translator.hash_data ctxt Script_typed_ir.address_t owner >|= Environment.wrap_tzresult >>=? fun (address_hash, ctxt) -> Big_map.get_opt ctxt tokens address_hash >|= Environment.wrap_tzresult diff --git a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml index e4a3baf1bb8d03a0f3d7f1c0a10f2a46218f99e5..ec6da065c02ce26cb93897987ce0a273f6204f7b 100644 --- a/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml +++ b/src/proto_alpha/lib_protocol/test/integration/gas/test_gas_costs.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs, *) +(* Copyright (c) 2020-2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -45,14 +45,11 @@ let forty_two_n = Alpha_context.Script_int.abs forty_two let dummy_set = let open Script_set in - update forty_two true (empty Script_typed_ir.(int_key ~annot:None)) + update forty_two true (empty Script_typed_ir.int_key) let dummy_map = let open Script_map in - update - forty_two - (Some forty_two) - (empty Script_typed_ir.(int_key ~annot:None)) + update forty_two (Some forty_two) (empty Script_typed_ir.int_key) let dummy_timestamp = Alpha_context.Script_timestamp.of_zint (Z.of_int 42) @@ -67,7 +64,7 @@ let dummy_string = | Ok s -> s | Error _ -> assert false -let dummy_ty = Script_typed_ir.never_t ~annot:None +let dummy_ty = Script_typed_ir.never_t let free = ["balance"; "bool"; "parsing_unit"; "unparsing_unit"] @@ -151,8 +148,7 @@ let all_interpreter_costs = ("dipn", dipn 42); ("dropn", dropn 42); ("neq", neq); - ( "compare", - compare Script_typed_ir.(int_key ~annot:None) forty_two forty_two ); + ("compare", compare Script_typed_ir.int_key forty_two forty_two); ( "concat_string_precheck", concat_string_precheck Script_list.(cons "42" empty) ); ("concat_string", concat_string (S.safe_int 42)); diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml index 2c48604f14c21b52b2533b9b54d000f6dfe4c6b1..1ed116ede4a0d8958c63083f72576ae7429ddd30 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_interpretation.ml @@ -1,3 +1,28 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2020-2022 Nomadic Labs, *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + (** Testing ------- Component: Protocol (interpretation) @@ -104,7 +129,7 @@ let test_stack_overflow () = let stack = Bot_t in let descr kinstr = {kloc = 0; kbef = stack; kaft = stack; kinstr} in let kinfo = {iloc = -1; kstack_ty = stack} in - let kinfo' = {iloc = -1; kstack_ty = Item_t (bool_t ~annot:None, stack)} in + let kinfo' = {iloc = -1; kstack_ty = Item_t (bool_t, stack)} in let enorme_et_seq n = let rec aux n acc = if n = 0 then acc @@ -133,10 +158,10 @@ let test_stack_overflow_in_lwt () = in let stack = Bot_t in let item ty s = Item_t (ty, s) in - let unit_t = unit_t ~annot:None in - let unit_k = unit_key ~annot:None in - let bool_t = bool_t ~annot:None in - big_map_t (-1) unit_k unit_t ~annot:None >>??= fun big_map_t -> + let unit_t = unit_t in + let unit_k = unit_key in + let bool_t = bool_t in + big_map_t (-1) unit_k unit_t >>??= fun big_map_t -> let descr kinstr = {kloc = 0; kbef = stack; kaft = stack; kinstr} in let kinfo s = {iloc = -1; kstack_ty = s} in let stack1 = item big_map_t Bot_t in diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml index 4f0d28016c8ed8b07a8d51631d31f5d973fae522..ca327f466ec13040b29924d0279471b6c7c38db8 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2020 Nomadic Labs *) +(* Copyright (c) 2020-2022 Nomadic Labs *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -1003,8 +1003,8 @@ module Interpreter_tests = struct (let memo_size = memo_size_of_int memo_size in let open Script_typed_ir in - let state_ty = sapling_state_t ~memo_size ~annot:None in - pair_t (-1) (state_ty, None) (state_ty, None) ~annot:None) + let state_ty = sapling_state_t ~memo_size in + pair_t (-1) (state_ty, None) (state_ty, None)) >>??= fun tytype -> Script_ir_translator.parse_storage ctx_without_gas diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml index 1ab7e06a7c2ce0d3ded9846187021922e0ee19f1..d080cb9daac807c6882805b04bcd3ee7cc0369b3 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml @@ -46,7 +46,7 @@ let err x = Exn (Script_cache_test_error x) model. It has been computed by a manual run of the test. *) -let liquidity_baking_contract_size = 289783 +let liquidity_baking_contract_size = 275006 let liquidity_baking_contract = Contract.of_b58check "KT1TxqZ8QtKvLu3V3JH7Gx58n7Co8pgtpQU5" |> function @@ -120,7 +120,7 @@ let add_some_contracts k src block baker = model. It has been computed by a manual run of the test. *) -let int_store_contract_size = 1406 +let int_store_contract_size = 1042 (* diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml index 634f69c766ffb9689e3f20362fc317bba0812f29..18407d30e6565f91fde0ad1a20ac8e7d5c1453fa 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_typed_ir_size.ml @@ -357,7 +357,7 @@ module Tests = struct let check_lambda_size_stats () = check_stats "lambda_size" - ~expected_mean:(1., 0.2) + ~expected_mean:(1., 0.25) ~expected_stddev:(0., 0.1) ~expected_ratios:(1., 0.4) end diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml index 836fc71e4e09e2edfa8a02d7a1d253ff9af921b2..a421ad34a8a5803bdd0c3356abe34c3fa406f54c 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_lazy_storage_diff.ml @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2021 Trili Tech, *) +(* Copyright (c) 2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -111,7 +112,7 @@ let updates_of_key_values ctxt key_values = wrap (Script_ir_translator.hash_comparable_data ctxt - (Script_typed_ir.int_key ~annot:None) + Script_typed_ir.int_key (Script_int_repr.of_int key)) in return diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml index 9b7e38a2235ab86705fccb6f08117e5640e27c52..de826ae3b328f0f6ef618ff28b7b0366c59f2e61 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_scanner.ml @@ -2,6 +2,7 @@ (* *) (* Open Source License *) (* Copyright (c) 2021 Trili Tech, *) +(* Copyright (c) 2022 Nomadic Labs, *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) @@ -183,7 +184,7 @@ let tickets_from_big_map_ref ~pre_populated value_exp = wrap @@ Script_ir_translator.hash_comparable_data ctxt - (Script_typed_ir.int_key ~annot:None) + Script_typed_ir.int_key (Script_int_repr.of_int key) in return diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml index ad265b4a7600bc0ee8568ff4fe56a659430f984f..a06e3c575691aae9822dd909effb88deb107cd9a 100644 --- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml +++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml @@ -78,7 +78,7 @@ let test_context_with_nat_nat_big_map () = Incremental.begin_construction b >>=? fun v -> let ctxt = Incremental.alpha_ctxt v in wrap_error_lwt @@ Big_map.fresh ~temporary:false ctxt >>=? fun (ctxt, id) -> - let nat_ty = Script_typed_ir.nat_t ~annot:None in + let nat_ty = Script_typed_ir.nat_t in wrap_error_lwt @@ Lwt.return @@ Script_ir_translator.unparse_ty ~loc:() ctxt nat_ty >>=? fun (nat_ty_node, ctxt) -> @@ -179,8 +179,6 @@ let test_parse_ty ctxt node expected = Script_ir_translator.ty_eq ctxt (location node) actual expected >|? fun (_, ctxt) -> ctxt ) -let type_annot = Script_ir_annot.FOR_TESTS.unsafe_type_annot_of_string - let field_annot = Script_ir_annot.FOR_TESTS.unsafe_field_annot_of_string let test_parse_comb_type () = @@ -190,9 +188,9 @@ let test_parse_comb_type () = let nat_prim_a = Prim (-1, T_nat, [], ["%a"]) in let nat_prim_b = Prim (-1, T_nat, [], ["%b"]) in let nat_prim_c = Prim (-1, T_nat, [], ["%c"]) in - let nat_ty = nat_t ~annot:None in + let nat_ty = nat_t in let pair_prim l = Prim (-1, T_pair, l, []) in - let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) ~annot:None in + let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) in let pair_prim2 a b = pair_prim [a; b] in let pair_nat_nat_prim = pair_prim2 nat_prim nat_prim in pair_ty nat_ty nat_ty >>??= fun pair_nat_nat_ty -> @@ -221,36 +219,24 @@ let test_parse_comb_type () = pair_nat_nat_nat_ty >>?= fun ctxt -> (* pair (nat %a) nat *) - pair_t (-1) (nat_ty, Some (field_annot "a")) (nat_ty, None) ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "a")) (nat_ty, None) >>??= fun pair_nat_a_nat_ty -> test_parse_ty ctxt (pair_prim2 nat_prim_a nat_prim) pair_nat_a_nat_ty >>?= fun ctxt -> (* pair nat (nat %b) *) - pair_t (-1) (nat_ty, None) (nat_ty, Some (field_annot "b")) ~annot:None + pair_t (-1) (nat_ty, None) (nat_ty, Some (field_annot "b")) >>??= fun pair_nat_nat_b_ty -> test_parse_ty ctxt (pair_prim2 nat_prim nat_prim_b) pair_nat_nat_b_ty >>?= fun ctxt -> (* pair (nat %a) (nat %b) *) - pair_t - (-1) - (nat_ty, Some (field_annot "a")) - (nat_ty, Some (field_annot "b")) - ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "a")) (nat_ty, Some (field_annot "b")) >>??= fun pair_nat_a_nat_b_ty -> test_parse_ty ctxt (pair_prim2 nat_prim_a nat_prim_b) pair_nat_a_nat_b_ty >>?= fun ctxt -> (* pair (nat %a) (nat %b) (nat %c) *) - pair_t - (-1) - (nat_ty, Some (field_annot "b")) - (nat_ty, Some (field_annot "c")) - ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "b")) (nat_ty, Some (field_annot "c")) >>??= fun pair_nat_b_nat_c_ty -> - pair_t - (-1) - (nat_ty, Some (field_annot "a")) - (pair_nat_b_nat_c_ty, None) - ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "a")) (pair_nat_b_nat_c_ty, None) >>??= fun pair_nat_a_nat_b_nat_c_ty -> test_parse_ty ctxt @@ -258,13 +244,11 @@ let test_parse_comb_type () = pair_nat_a_nat_b_nat_c_ty >>?= fun ctxt -> (* pair (nat %a) (pair %b nat nat) *) - pair_t (-1) (nat_ty, None) (nat_ty, None) ~annot:None - >>??= fun pair_b_nat_nat_ty -> + pair_t (-1) (nat_ty, None) (nat_ty, None) >>??= fun pair_b_nat_nat_ty -> pair_t (-1) (nat_ty, Some (field_annot "a")) (pair_b_nat_nat_ty, Some (field_annot "b")) - ~annot:None >>??= fun pair_nat_a_pair_b_nat_nat_ty -> test_parse_ty ctxt @@ -285,9 +269,9 @@ let test_unparse_comb_type () = let nat_prim_a = Prim ((), T_nat, [], ["%a"]) in let nat_prim_b = Prim ((), T_nat, [], ["%b"]) in let nat_prim_c = Prim ((), T_nat, [], ["%c"]) in - let nat_ty = nat_t ~annot:None in + let nat_ty = nat_t in let pair_prim l = Prim ((), T_pair, l, []) in - let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) ~annot:None in + let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) in let pair_prim2 a b = pair_prim [a; b] in let pair_nat_nat_prim = pair_prim2 nat_prim nat_prim in pair_ty nat_ty nat_ty >>??= fun pair_nat_nat_ty -> @@ -312,7 +296,7 @@ let test_unparse_comb_type () = pair_nat_nat_nat_ty >>?= fun ctxt -> (* pair (nat %a) nat *) - pair_t (-1) (nat_ty, Some (field_annot "a")) (nat_ty, None) ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "a")) (nat_ty, None) >>??= fun pair_nat_a_nat_ty -> test_unparse_ty __LOC__ @@ -321,7 +305,7 @@ let test_unparse_comb_type () = pair_nat_a_nat_ty >>?= fun ctxt -> (* pair nat (nat %b) *) - pair_t (-1) (nat_ty, None) (nat_ty, Some (field_annot "b")) ~annot:None + pair_t (-1) (nat_ty, None) (nat_ty, Some (field_annot "b")) >>??= fun pair_nat_nat_b_ty -> test_unparse_ty __LOC__ @@ -330,11 +314,7 @@ let test_unparse_comb_type () = pair_nat_nat_b_ty >>?= fun ctxt -> (* pair (nat %a) (nat %b) *) - pair_t - (-1) - (nat_ty, Some (field_annot "a")) - (nat_ty, Some (field_annot "b")) - ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "a")) (nat_ty, Some (field_annot "b")) >>??= fun pair_nat_a_nat_b_ty -> test_unparse_ty __LOC__ @@ -343,17 +323,9 @@ let test_unparse_comb_type () = pair_nat_a_nat_b_ty >>?= fun ctxt -> (* pair (nat %a) (nat %b) (nat %c) *) - pair_t - (-1) - (nat_ty, Some (field_annot "b")) - (nat_ty, Some (field_annot "c")) - ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "b")) (nat_ty, Some (field_annot "c")) >>??= fun pair_nat_b_nat_c_ty -> - pair_t - (-1) - (nat_ty, Some (field_annot "a")) - (pair_nat_b_nat_c_ty, None) - ~annot:None + pair_t (-1) (nat_ty, Some (field_annot "a")) (pair_nat_b_nat_c_ty, None) >>??= fun pair_nat_a_nat_b_nat_c_ty -> test_unparse_ty __LOC__ @@ -362,30 +334,17 @@ let test_unparse_comb_type () = pair_nat_a_nat_b_nat_c_ty >>?= fun ctxt -> (* pair (nat %a) (pair %b nat nat) *) - pair_t (-1) (nat_ty, None) (nat_ty, None) ~annot:None - >>??= fun pair_nat_nat_ty -> + pair_t (-1) (nat_ty, None) (nat_ty, None) >>??= fun pair_nat_nat_ty -> pair_t (-1) (nat_ty, Some (field_annot "a")) (pair_nat_nat_ty, Some (field_annot "b")) - ~annot:None >>??= fun pair_nat_a_pair_b_nat_nat_ty -> test_unparse_ty __LOC__ ctxt (pair_prim2 nat_prim_a (Prim ((), T_pair, [nat_prim; nat_prim], ["%b"]))) pair_nat_a_pair_b_nat_nat_ty - >>?= fun ctxt -> - (* pair nat (pair :b nat nat) *) - pair_t (-1) (nat_ty, None) (nat_ty, None) ~annot:(Some (type_annot "b")) - >>??= fun pair_b_nat_nat_ty -> - pair_t (-1) (nat_ty, None) (pair_b_nat_nat_ty, None) ~annot:None - >>??= fun pair_nat_pair_b_nat_nat_ty -> - test_unparse_ty - __LOC__ - ctxt - (pair_prim2 nat_prim (Prim ((), T_pair, [nat_prim; nat_prim], [":b"]))) - pair_nat_pair_b_nat_nat_ty >>?= fun _ -> return_unit let test_unparse_comparable_ty loc ctxt expected ty = @@ -393,7 +352,7 @@ let test_unparse_comparable_ty loc ctxt expected ty = call parse_ty on a set type *) let open Script_typed_ir in Environment.wrap_tzresult - ( set_t (-1) ty ~annot:None >>? fun set_ty_ty -> + ( set_t (-1) ty >>? fun set_ty_ty -> Script_ir_translator.unparse_ty ~loc:() ctxt set_ty_ty >>? fun (actual, ctxt) -> if actual = Prim ((), T_set, [expected], []) then ok ctxt @@ -406,9 +365,9 @@ let test_unparse_comb_comparable_type () = let nat_prim_a = Prim ((), T_nat, [], ["%a"]) in let nat_prim_b = Prim ((), T_nat, [], ["%b"]) in let nat_prim_c = Prim ((), T_nat, [], ["%c"]) in - let nat_ty = nat_key ~annot:None in + let nat_ty = nat_key in let pair_prim l = Prim ((), T_pair, l, []) in - let pair_ty ty1 ty2 = pair_key (-1) (ty1, None) (ty2, None) ~annot:None in + let pair_ty ty1 ty2 = pair_key (-1) (ty1, None) (ty2, None) in let pair_prim2 a b = pair_prim [a; b] in let pair_nat_nat_prim = pair_prim2 nat_prim nat_prim in pair_ty nat_ty nat_ty >>??= fun pair_nat_nat_ty -> @@ -433,7 +392,7 @@ let test_unparse_comb_comparable_type () = pair_nat_nat_nat_ty >>?= fun ctxt -> (* pair (nat %a) nat *) - pair_key (-1) (nat_ty, Some (field_annot "a")) (nat_ty, None) ~annot:None + pair_key (-1) (nat_ty, Some (field_annot "a")) (nat_ty, None) >>??= fun pair_nat_a_nat_ty -> test_unparse_comparable_ty __LOC__ @@ -442,7 +401,7 @@ let test_unparse_comb_comparable_type () = pair_nat_a_nat_ty >>?= fun ctxt -> (* pair nat (nat %b) *) - pair_key (-1) (nat_ty, None) (nat_ty, Some (field_annot "b")) ~annot:None + pair_key (-1) (nat_ty, None) (nat_ty, Some (field_annot "b")) >>??= fun pair_nat_nat_b_ty -> test_unparse_comparable_ty __LOC__ @@ -451,11 +410,7 @@ let test_unparse_comb_comparable_type () = pair_nat_nat_b_ty >>?= fun ctxt -> (* pair (nat %a) (nat %b) *) - pair_key - (-1) - (nat_ty, Some (field_annot "a")) - (nat_ty, Some (field_annot "b")) - ~annot:None + pair_key (-1) (nat_ty, Some (field_annot "a")) (nat_ty, Some (field_annot "b")) >>??= fun pair_nat_a_nat_b_ty -> test_unparse_comparable_ty __LOC__ @@ -464,17 +419,9 @@ let test_unparse_comb_comparable_type () = pair_nat_a_nat_b_ty >>?= fun ctxt -> (* pair (nat %a) (nat %b) (nat %c) *) - pair_key - (-1) - (nat_ty, Some (field_annot "b")) - (nat_ty, Some (field_annot "c")) - ~annot:None + pair_key (-1) (nat_ty, Some (field_annot "b")) (nat_ty, Some (field_annot "c")) >>??= fun pair_nat_b_nat_c_ty -> - pair_key - (-1) - (nat_ty, Some (field_annot "a")) - (pair_nat_b_nat_c_ty, None) - ~annot:None + pair_key (-1) (nat_ty, Some (field_annot "a")) (pair_nat_b_nat_c_ty, None) >>??= fun pair_nat_a_nat_b_nat_c_ty -> test_unparse_comparable_ty __LOC__ @@ -487,24 +434,12 @@ let test_unparse_comb_comparable_type () = (-1) (nat_ty, Some (field_annot "a")) (pair_nat_nat_ty, Some (field_annot "b")) - ~annot:None >>??= fun pair_nat_a_pair_b_nat_nat_ty -> test_unparse_comparable_ty __LOC__ ctxt (pair_prim2 nat_prim_a (Prim ((), T_pair, [nat_prim; nat_prim], ["%b"]))) pair_nat_a_pair_b_nat_nat_ty - >>?= fun ctxt -> - (* pair nat (pair :b nat nat) *) - pair_key (-1) (nat_ty, None) (nat_ty, None) ~annot:(Some (type_annot "b")) - >>??= fun pair_b_nat_nat_ty -> - pair_key (-1) (nat_ty, None) (pair_b_nat_nat_ty, None) ~annot:None - >>??= fun pair_nat_pair_b_nat_nat_ty -> - test_unparse_comparable_ty - __LOC__ - ctxt - (pair_prim2 nat_prim (Prim ((), T_pair, [nat_prim; nat_prim], [":b"]))) - pair_nat_pair_b_nat_nat_ty >>?= fun _ -> return_unit let test_parse_data ?(equal = Stdlib.( = )) loc ctxt ty node expected = @@ -547,15 +482,14 @@ let test_parse_comb_data () = let open Script_typed_ir in let z = Script_int.zero_n in let z_prim = Micheline.Int (-1, Z.zero) in - let nat_ty = nat_t ~annot:None in + let nat_ty = nat_t in let pair_prim l = Prim (-1, D_Pair, l, []) in - let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) ~annot:None in + let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) in pair_ty nat_ty nat_ty >>??= fun pair_nat_nat_ty -> let pair_prim2 a b = pair_prim [a; b] in let pair_z_z_prim = pair_prim2 z_prim z_prim in - list_t (-1) nat_ty ~annot:None >>??= fun list_nat_ty -> - big_map_t (-1) (nat_key ~annot:None) nat_ty ~annot:None - >>??= fun big_map_nat_nat_ty -> + list_t (-1) nat_ty >>??= fun list_nat_ty -> + big_map_t (-1) nat_key nat_ty >>??= fun big_map_nat_nat_ty -> test_context_with_nat_nat_big_map () >>=? fun (ctxt, big_map_id) -> (* Pair 0 0 *) test_parse_data __LOC__ ctxt pair_nat_nat_ty pair_z_z_prim (z, z) @@ -626,7 +560,7 @@ let test_parse_comb_data () = let expected_big_map = let open Script_typed_ir in let diff = {map = Big_map_overlay.empty; size = 0} in - let nat_key_ty = nat_key ~annot:None in + let nat_key_ty = nat_key in {id = Some big_map_id; diff; key_type = nat_key_ty; value_type = nat_ty} in let equal (nat1, big_map1) (nat2, big_map2) = @@ -664,7 +598,7 @@ let test_parse_address () = test_parse_data __LOC__ ctxt - (address_t ~annot:None) + address_t (String (-1, "KT1FAKEFAKEFAKEFAKEFAKEFAKEFAKGGSE2x%")) {contract = kt1fake; entrypoint = Entrypoint.default} >>=? fun ctxt -> @@ -675,7 +609,7 @@ let test_parse_address () = test_parse_data __LOC__ ctxt - (address_t ~annot:None) + address_t (String (-1, "tz1fakefakefakefakefakefakefakcphLA5%")) {contract = tz1fake; entrypoint = Entrypoint.default} >|=? fun _ctxt -> () @@ -697,9 +631,9 @@ let test_unparse_comb_data () = let open Script_typed_ir in let z = Script_int.zero_n in let z_prim = Micheline.Int (-1, Z.zero) in - let nat_ty = nat_t ~annot:None in + let nat_ty = nat_t in let pair_prim l = Prim (-1, D_Pair, l, []) in - let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) ~annot:None in + let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) in pair_ty nat_ty nat_ty >>??= fun pair_nat_nat_ty -> let pair_prim2 a b = pair_prim [a; b] in let pair_z_z_prim = pair_prim2 z_prim z_prim in @@ -767,7 +701,7 @@ let rec gen_combs leaf arity = (* Checks the optimality of the Optimized Micheline representation for combs *) let test_optimal_comb () = let open Script_typed_ir in - let leaf_ty = nat_t ~annot:None in + let leaf_ty = nat_t in let leaf_mich = Int ((), Z.zero) in let leaf_v = Script_int.zero_n in let size_of_micheline mich = @@ -806,7 +740,7 @@ let test_optimal_comb () = @@ gen_combs leaf_mich arity >>=? fun () -> return ctxt ) in - let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) ~annot:None in + let pair_ty ty1 ty2 = pair_t (-1) (ty1, None) (ty2, None) in test_context () >>=? fun ctxt -> pair_ty leaf_ty leaf_ty >>??= fun comb2_ty -> let comb2_v = (leaf_v, leaf_v) in @@ -852,7 +786,7 @@ let test_contract_not_packable () = ctxt ~legacy:false (Prim (0, I_UNPACK, [Prim (0, T_unit, [], [])], [])) - (Item_t (Script_typed_ir.bytes_t ~annot:None, Bot_t)) + (Item_t (Script_typed_ir.bytes_t, Bot_t)) >>= function | Ok _ -> return_unit | Error _ -> Alcotest.failf "Could not parse UNPACK unit") @@ -863,7 +797,7 @@ let test_contract_not_packable () = ctxt ~legacy:false (Prim (0, I_UNPACK, [contract_unit], [])) - (Item_t (Script_typed_ir.bytes_t ~annot:None, Bot_t)) + (Item_t (Script_typed_ir.bytes_t, Bot_t)) >>= function | Ok _ -> Alcotest.failf diff --git a/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml b/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml index c61f17a2146b2e5d63d7d7bfe51a591c76f1e901..187af4ad03c1a0d6d79a350848a8e1c6883d2745 100644 --- a/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml +++ b/src/proto_alpha/lib_protocol/test/pbt/test_script_comparison.ml @@ -347,9 +347,7 @@ let test_pack_unpack = comparable_data_arbitrary (fun (Ex_comparable_data (ty, x)) -> let oty = - match option_key (-1) ty ~annot:None with - | Ok ty -> ty - | Error _ -> assert false + match option_key (-1) ty with Ok ty -> ty | Error _ -> assert false in qcheck_eq ~cmp:(Script_comparable.compare_comparable oty) diff --git a/src/proto_alpha/lib_protocol/ticket_balance_key.ml b/src/proto_alpha/lib_protocol/ticket_balance_key.ml index 27361b8bd3cb619eb979e0a843f89a1ece0f7691..f31909155e272f19101cbcbae7d4d28a52b28a85 100644 --- a/src/proto_alpha/lib_protocol/ticket_balance_key.ml +++ b/src/proto_alpha/lib_protocol/ticket_balance_key.ml @@ -50,11 +50,10 @@ let ticket_balance_key ctxt ~owner let owner_address = Script_typed_ir.{contract = owner; entrypoint = Entrypoint.default} in - let address_t = Script_typed_ir.address_t ~annot:None in Script_ir_translator.unparse_data ctxt Script_ir_translator.Optimized_legacy - address_t + Script_typed_ir.address_t ticketer_address >>=? fun (ticketer, ctxt) -> Script_ir_translator.unparse_comparable_data @@ -67,7 +66,7 @@ let ticket_balance_key ctxt ~owner Script_ir_translator.unparse_data ctxt Script_ir_translator.Optimized_legacy - address_t + Script_typed_ir.address_t owner_address >>=? fun (owner, ctxt) -> Lwt.return (Ticket_hash.make ctxt ~ticketer ~typ ~contents ~owner) diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[attic--accounts.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[attic--accounts.tz].out index 2d6e91f2af71fc413758b2d7b390a0d188ca01b1..9044ed78bb7e08c73e79a3f663f042a98d41f0d0 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[attic--accounts.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[attic--accounts.tz].out @@ -9,76 +9,72 @@ Gas remaining: 1039925.145 units remaining code { DUP /* [ pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) + (map key_hash mutez) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; CAR /* [ or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig)) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; IF_LEFT { DUP /* [ key_hash : key_hash : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; DIIP { CDR %stored_balance - /* [ map :stored_balance key_hash mutez ] */ ; + /* [ map key_hash mutez ] */ ; DUP - /* [ map :stored_balance key_hash mutez : map :stored_balance key_hash mutez ] */ } - /* [ key_hash : key_hash : map :stored_balance key_hash mutez - : map :stored_balance key_hash mutez ] */ ; - DIP { SWAP - /* [ map :stored_balance key_hash mutez : key_hash - : map :stored_balance key_hash mutez ] */ } - /* [ key_hash : map :stored_balance key_hash mutez : key_hash - : map :stored_balance key_hash mutez ] */ ; + /* [ map key_hash mutez : map key_hash mutez ] */ } + /* [ key_hash : key_hash : map key_hash mutez : map key_hash mutez ] */ ; + DIP { SWAP /* [ map key_hash mutez : key_hash : map key_hash mutez ] */ } + /* [ key_hash : map key_hash mutez : key_hash : map key_hash mutez ] */ ; GET @opt_prev_balance - /* [ option mutez : key_hash : map :stored_balance key_hash mutez ] */ ; + /* [ option mutez : key_hash : map key_hash mutez ] */ ; IF_SOME { RENAME @previous_balance - /* [ mutez : key_hash : map :stored_balance key_hash mutez ] */ ; + /* [ mutez : key_hash : map key_hash mutez ] */ ; AMOUNT - /* [ mutez : mutez : key_hash : map :stored_balance key_hash mutez ] */ ; + /* [ mutez : mutez : key_hash : map key_hash mutez ] */ ; ADD - /* [ mutez : key_hash : map :stored_balance key_hash mutez ] */ ; + /* [ mutez : key_hash : map key_hash mutez ] */ ; SOME - /* [ option mutez : key_hash : map :stored_balance key_hash mutez ] */ ; + /* [ option mutez : key_hash : map key_hash mutez ] */ ; SWAP - /* [ key_hash : option mutez : map :stored_balance key_hash mutez ] */ ; + /* [ key_hash : option mutez : map key_hash mutez ] */ ; UPDATE - /* [ map :stored_balance key_hash mutez ] */ ; + /* [ map key_hash mutez ] */ ; NIL operation - /* [ list operation : map :stored_balance key_hash mutez ] */ ; + /* [ list operation : map key_hash mutez ] */ ; PAIR - /* [ pair (list operation) (map :stored_balance key_hash mutez) ] */ } + /* [ pair (list operation) (map key_hash mutez) ] */ } { DIP { AMOUNT - /* [ mutez : map :stored_balance key_hash mutez ] */ ; + /* [ mutez : map key_hash mutez ] */ ; SOME - /* [ option mutez : map :stored_balance key_hash mutez ] */ } - /* [ key_hash : option mutez : map :stored_balance key_hash mutez ] */ ; + /* [ option mutez : map key_hash mutez ] */ } + /* [ key_hash : option mutez : map key_hash mutez ] */ ; UPDATE - /* [ map :stored_balance key_hash mutez ] */ ; + /* [ map key_hash mutez ] */ ; NIL operation - /* [ list operation : map :stored_balance key_hash mutez ] */ ; + /* [ list operation : map key_hash mutez ] */ ; PAIR - /* [ pair (list operation) (map :stored_balance key_hash mutez) ] */ } } + /* [ pair (list operation) (map key_hash mutez) ] */ } } { DUP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; DUP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; DUP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) @@ -86,7 +82,7 @@ Gas remaining: 1039925.145 units remaining : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; DUP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) @@ -95,7 +91,7 @@ Gas remaining: 1039925.145 units remaining : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; CAR %from /* [ key : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) @@ -103,217 +99,217 @@ Gas remaining: 1039925.145 units remaining : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; DIIP { CDAR %withdraw_amount ; PACK /* [ bytes : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; BLAKE2B @signed_amount /* [ bytes : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ } + (map key_hash mutez) ] */ } /* [ key : pair (key %from) (mutez %withdraw_amount) (signature %sig) : bytes : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; DIP { CDDR %sig } /* [ key : signature : bytes : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; CHECK_SIGNATURE /* [ bool : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; IF { /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ } + (map key_hash mutez) ] */ } { PUSH string "Bad signature" /* [ string : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (or (key_hash %Initialize) (pair %Withdraw (key %from) (mutez %withdraw_amount) (signature %sig))) - (map :stored_balance key_hash mutez) ] */ ; + (map key_hash mutez) ] */ ; FAILWITH /* [] */ } ; DIIP { CDR %stored_balance - /* [ map :stored_balance key_hash mutez ] */ ; + /* [ map key_hash mutez ] */ ; DUP - /* [ map :stored_balance key_hash mutez : map :stored_balance key_hash mutez ] */ } + /* [ map key_hash mutez : map key_hash mutez ] */ } /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez : map key_hash mutez ] */ ; CAR %from /* [ key : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez : map key_hash mutez ] */ ; HASH_KEY @from_hash /* [ key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez : map key_hash mutez ] */ ; DUP /* [ key_hash : key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez : map key_hash mutez ] */ ; DIP { DIP { SWAP - /* [ map :stored_balance key_hash mutez + /* [ map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ } - /* [ key_hash : map :stored_balance key_hash mutez + : map key_hash mutez ] */ } + /* [ key_hash : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; SWAP - /* [ map :stored_balance key_hash mutez : key_hash + /* [ map key_hash mutez : key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ } - /* [ key_hash : map :stored_balance key_hash mutez : key_hash + : map key_hash mutez ] */ } + /* [ key_hash : map key_hash mutez : key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; GET /* [ option mutez : key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; IF_NONE { PUSH string "Account does not exist" /* [ string : key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; PAIR /* [ pair string key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; FAILWITH /* [] */ } { RENAME @previous_balance /* [ mutez : key_hash : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; DIP { DROP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ } + : map key_hash mutez ] */ } /* [ mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; DUP /* [ mutez : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; DIIP { DUP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; CDAR %withdraw_amount ; DUP /* [ mutez : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ } + : map key_hash mutez ] */ } /* [ mutez : mutez : mutez : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; DIP { CMPLT @not_enough } /* [ mutez : bool : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; SWAP /* [ bool : mutez : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; IF { PUSH string "Not enough funds" /* [ string : mutez : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; FAILWITH /* [] */ } { SUB_MUTEZ @new_balance /* [ option mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; ASSERT_SOME ; DIP { DUP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; DIP { SWAP - /* [ map :stored_balance key_hash mutez + /* [ map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ } /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ } /* [ mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; DUP /* [ mutez : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; PUSH @zero mutez 0 /* [ mutez : mutez : mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; CMPEQ @null_balance ; IF { DROP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; NONE @new_balance mutez /* [ option mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ } { SOME @new_balance /* [ option mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ } ; SWAP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : option mutez - : map :stored_balance key_hash mutez + : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; CAR %from - /* [ key : option mutez : map :stored_balance key_hash mutez + /* [ key : option mutez : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; HASH_KEY @from_hash - /* [ key_hash : option mutez : map :stored_balance key_hash mutez + /* [ key_hash : option mutez : map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; UPDATE - /* [ map :stored_balance key_hash mutez + /* [ map key_hash mutez : pair (key %from) (mutez %withdraw_amount) (signature %sig) ] */ ; SWAP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; DUP /* [ pair (key %from) (mutez %withdraw_amount) (signature %sig) : pair (key %from) (mutez %withdraw_amount) (signature %sig) - : map :stored_balance key_hash mutez ] */ ; + : map key_hash mutez ] */ ; CDAR %withdraw_amount ; DIP { CAR %from - /* [ key : map :stored_balance key_hash mutez ] */ ; + /* [ key : map key_hash mutez ] */ ; HASH_KEY @from_hash - /* [ key_hash : map :stored_balance key_hash mutez ] */ ; + /* [ key_hash : map key_hash mutez ] */ ; IMPLICIT_ACCOUNT @from_account - /* [ contract unit : map :stored_balance key_hash mutez ] */ } - /* [ mutez : contract unit : map :stored_balance key_hash mutez ] */ ; + /* [ contract unit : map key_hash mutez ] */ } + /* [ mutez : contract unit : map key_hash mutez ] */ ; UNIT - /* [ unit : mutez : contract unit : map :stored_balance key_hash mutez ] */ ; + /* [ unit : mutez : contract unit : map key_hash mutez ] */ ; TRANSFER_TOKENS @withdraw_transfer_op - /* [ operation : map :stored_balance key_hash mutez ] */ ; + /* [ operation : map key_hash mutez ] */ ; NIL operation - /* [ list operation : operation : map :stored_balance key_hash mutez ] */ ; + /* [ list operation : operation : map key_hash mutez ] */ ; SWAP - /* [ operation : list operation : map :stored_balance key_hash mutez ] */ ; + /* [ operation : list operation : map key_hash mutez ] */ ; CONS - /* [ list operation : map :stored_balance key_hash mutez ] */ ; + /* [ list operation : map key_hash mutez ] */ ; PAIR - /* [ pair (list operation) (map :stored_balance key_hash mutez) ] */ } } } } } + /* [ pair (list operation) (map key_hash mutez) ] */ } } } } } diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[macros--unpair_macro.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[macros--unpair_macro.tz].out index 2daa0cca804a2dfa0cfdbc7ffcf1f0f38be519a3..1d2fe26c5b2439369b027c0b57d3d5e6d9914437 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[macros--unpair_macro.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[macros--unpair_macro.tz].out @@ -7,26 +7,26 @@ Gas remaining: 1039976.490 units remaining code { DROP /* [] */ ; UNIT :u4 @a4 - /* [ unit :u4 ] */ ; + /* [ unit ] */ ; UNIT :u3 @a3 - /* [ unit :u3 : unit :u4 ] */ ; + /* [ unit : unit ] */ ; UNIT :u2 @a2 - /* [ unit :u2 : unit :u3 : unit :u4 ] */ ; + /* [ unit : unit : unit ] */ ; UNIT :u1 @a1 - /* [ unit :u1 : unit :u2 : unit :u3 : unit :u4 ] */ ; + /* [ unit : unit : unit : unit ] */ ; PAIR - /* [ pair (unit :u1) (unit :u2) : unit :u3 : unit :u4 ] */ ; + /* [ pair unit unit : unit : unit ] */ ; UNPAIR @x1 @x2 - /* [ unit :u1 : unit :u2 : unit :u3 : unit :u4 ] */ ; + /* [ unit : unit : unit : unit ] */ ; PPAIPAIR @p1 %x1 %x2 %x3 %x4 ; UNPPAIPAIR %x1 % %x3 %x4 @uno @due @tre @quattro ; PAPAPAIR @p2 %x1 %x2 %x3 %x4 ; UNPAPAPAIR @un @deux @trois @quatre ; PAPPAIIR @p3 %x1 %x2 %x3 %x4 ; UNPAPPAIIR @one @two @three @four ; - DIP { DROP /* [ unit :u3 : unit :u4 ] */ ; DROP /* [ unit :u4 ] */ ; DROP /* [] */ } - /* [ unit :u1 ] */ ; + DIP { DROP /* [ unit : unit ] */ ; DROP /* [ unit ] */ ; DROP /* [] */ } + /* [ unit ] */ ; NIL operation - /* [ list operation : unit :u1 ] */ ; + /* [ list operation : unit ] */ ; PAIR - /* [ pair (list operation) (unit :u1) ] */ } } + /* [ pair (list operation) unit ] */ } } diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--generic_multisig.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--generic_multisig.tz].out index d04a4b6064a46de86cfff4d9abe3678bd1168d49..ad864de134b2f24f3a54652fa9a594dff2008c2e 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--generic_multisig.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--generic_multisig.tz].out @@ -15,11 +15,9 @@ Gas remaining: 1039928.421 units remaining code { UNPAIR /* [ or (unit %default) (pair %main - (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) + (pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)))) (list %sigs (option signature))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; IF_LEFT @@ -33,374 +31,298 @@ Gas remaining: 1039928.421 units remaining { PUSH mutez 0 /* [ mutez - : pair (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)))) (list %sigs (option signature)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; AMOUNT /* [ mutez : mutez - : pair (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)))) (list %sigs (option signature)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ASSERT_CMPEQ ; SWAP /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) - : pair (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)))) (list %sigs (option signature)) ] */ ; DUP /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) : pair (nat %stored_counter) (nat %threshold) (list %keys key) - : pair (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)))) (list %sigs (option signature)) ] */ ; DIP { SWAP - /* [ pair (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) + /* [ pair (pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)))) (list %sigs (option signature)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) - : pair (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)))) (list %sigs (option signature)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { UNPAIR - /* [ pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + /* [ pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DUP - /* [ pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + /* [ pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SELF /* [ contract unit - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ADDRESS /* [ address - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; CHAIN_ID /* [ chain_id : address - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; PAIR /* [ pair chain_id address - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; PAIR /* [ pair (pair chain_id address) - (pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)))) - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; PACK /* [ bytes - : pair :payload - (nat %counter) - (or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key))) + : pair (nat %counter) + (or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { UNPAIR @counter /* [ nat - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { SWAP /* [ list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ bytes : nat : list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ nat : bytes : list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) : nat : bytes : list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; UNPAIR @stored_counter /* [ nat : pair (nat %threshold) (list %keys key) : nat : bytes : list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { SWAP /* [ nat : pair (nat %threshold) (list %keys key) : bytes : list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : nat : pair (nat %threshold) (list %keys key) : bytes : list (option signature) - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ASSERT_CMPEQ ; DIP { SWAP /* [ list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ pair (nat %threshold) (list %keys key) : list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; UNPAIR @threshold @keys /* [ nat : list key : list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { PUSH @valid nat 0 /* [ nat : list key : list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ list key : nat : list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ITER { DIP { SWAP /* [ list (option signature) : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ key : list (option signature) : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ list (option signature) : key : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; IF_CONS { IF_SOME { SWAP /* [ list (option signature) : signature : key : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { SWAP /* [ key : signature : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIIP { DUUP /* [ bytes : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ key : signature : bytes : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; { DUUUP /* [ bytes : key : signature : bytes : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { CHECK_SIGNATURE /* [ bool : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ bytes : bool : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ bool : bytes : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; IF { DROP /* [ nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } { FAILWITH /* [] */ } } ; PUSH nat 1 /* [ nat : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ADD @valid /* [ nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ list (option signature) : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } { SWAP /* [ key : list (option signature) : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DROP /* [ list (option signature) : nat : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } } { FAIL } ; SWAP /* [ nat : list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : nat : list (option signature) : bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ASSERT_CMPLE ; IF_CONS { FAIL } { /* [ bytes - : or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + : or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } ; DROP - /* [ or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + /* [ or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { UNPAIR /* [ nat : pair (nat %threshold) (list %keys key) ] */ ; @@ -410,9 +332,8 @@ Gas remaining: 1039928.421 units remaining /* [ nat : pair (nat %threshold) (list %keys key) ] */ ; PAIR /* [ pair nat (nat %threshold) (list %keys key) ] */ } - /* [ or :action - (lambda %operation unit (list operation)) - (pair %change_keys (nat %threshold) (list %keys key)) + /* [ or (lambda %operation unit (list operation)) + (pair %change_keys (nat %threshold) (list %keys key)) : pair nat (nat %threshold) (list %keys key) ] */ ; IF_LEFT { UNIT diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--legacy_multisig.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--legacy_multisig.tz].out index 45564ca3bf242bac2bc637044c00a89c3d4f017e..35be1213a3847fab61467bf41efb42b18bd2dada 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--legacy_multisig.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--legacy_multisig.tz].out @@ -12,425 +12,349 @@ Gas remaining: 1039931.026 units remaining (list %sigs (option signature))) ; storage (pair (nat %stored_counter) (pair (nat %threshold) (list %keys key))) ; code { UNPAIR - /* [ pair (pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))))) + /* [ pair (pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))))) (list %sigs (option signature)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) - : pair (pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))))) + : pair (pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))))) (list %sigs (option signature)) ] */ ; DUP /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) : pair (nat %stored_counter) (nat %threshold) (list %keys key) - : pair (pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))))) + : pair (pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))))) (list %sigs (option signature)) ] */ ; DIP { SWAP - /* [ pair (pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))))) + /* [ pair (pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))))) (list %sigs (option signature)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) - : pair (pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))))) + : pair (pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))))) (list %sigs (option signature)) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { UNPAIR - /* [ pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + /* [ pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DUP - /* [ pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + /* [ pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SELF /* [ contract - (pair (pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))))) + (pair (pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))))) (list %sigs (option signature))) - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ADDRESS /* [ address - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; CHAIN_ID /* [ chain_id : address - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; PAIR /* [ pair chain_id address - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; PAIR /* [ pair (pair chain_id address) - (pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))))) - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; PACK /* [ bytes - : pair :payload - (nat %counter) - (or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key)))) + : pair (nat %counter) + (or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key)))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { UNPAIR @counter /* [ nat - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : list (option signature) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { SWAP /* [ list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ bytes : nat : list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ nat : bytes : list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ pair (nat %stored_counter) (nat %threshold) (list %keys key) : nat : bytes : list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; UNPAIR @stored_counter /* [ nat : pair (nat %threshold) (list %keys key) : nat : bytes : list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { SWAP /* [ nat : pair (nat %threshold) (list %keys key) : bytes : list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : nat : pair (nat %threshold) (list %keys key) : bytes : list (option signature) - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ASSERT_CMPEQ ; DIP { SWAP /* [ list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ pair (nat %threshold) (list %keys key) : list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; UNPAIR @threshold @keys /* [ nat : list key : list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { PUSH @valid nat 0 /* [ nat : list key : list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ list key : nat : list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ITER { DIP { SWAP /* [ list (option signature) : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ key : list (option signature) : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ list (option signature) : key : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; IF_CONS { IF_SOME { SWAP /* [ list (option signature) : signature : key : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { SWAP /* [ key : signature : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIIP { DUUP /* [ bytes : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ key : signature : bytes : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; { DUUUP /* [ bytes : key : signature : bytes : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { CHECK_SIGNATURE /* [ bool : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ bytes : bool : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; SWAP /* [ bool : bytes : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; IF { DROP /* [ nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } { FAILWITH /* [] */ } } ; PUSH nat 1 /* [ nat : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ADD @valid /* [ nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ list (option signature) : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } { SWAP /* [ key : list (option signature) : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DROP /* [ list (option signature) : nat : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } } { FAIL } ; SWAP /* [ nat : list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ } /* [ nat : nat : list (option signature) : bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; ASSERT_CMPLE ; DROP /* [ bytes - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DROP - /* [ or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + /* [ or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair (nat %stored_counter) (nat %threshold) (list %keys key) ] */ ; DIP { UNPAIR /* [ nat : pair (nat %threshold) (list %keys key) ] */ ; @@ -440,24 +364,21 @@ Gas remaining: 1039931.026 units remaining /* [ nat : pair (nat %threshold) (list %keys key) ] */ ; PAIR /* [ pair nat (nat %threshold) (list %keys key) ] */ } - /* [ or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + /* [ or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair nat (nat %threshold) (list %keys key) ] */ ; NIL operation /* [ list operation - : or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) + : or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) : pair nat (nat %threshold) (list %keys key) ] */ ; SWAP - /* [ or :action - (pair :transfer (mutez %amount) (contract %dest unit)) - (or (option %delegate key_hash) - (pair %change_keys (nat %threshold) (list %keys key))) : list operation - : pair nat (nat %threshold) (list %keys key) ] */ ; + /* [ or (pair (mutez %amount) (contract %dest unit)) + (or (option %delegate key_hash) + (pair %change_keys (nat %threshold) (list %keys key))) + : list operation : pair nat (nat %threshold) (list %keys key) ] */ ; IF_LEFT { UNPAIR /* [ mutez : contract unit : list operation diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--weather_insurance.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--weather_insurance.tz].out index 4fc3d59179bad125787e0939079d5a56711ea878..8532e62834e8b105325e1f34cb3e524d73e47ee5 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--weather_insurance.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[mini_scenarios--weather_insurance.tz].out @@ -7,218 +7,218 @@ Gas remaining: 1039960.200 units remaining (pair (pair (address %under_key) (address %over_key)) (pair (nat :rain %rain_level) (key %weather_service_key))) ; code { DUP - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; DUP - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; CAR - /* [ pair (signature %signed_weather_data) (nat :rain %actual_level) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (signature %signed_weather_data) (nat %actual_level) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; MAP_CDR { PACK - /* [ bytes : pair (signature %signed_weather_data) (nat :rain %actual_level) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ bytes : pair (signature %signed_weather_data) (nat %actual_level) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; BLAKE2B - /* [ bytes : pair (signature %signed_weather_data) (nat :rain %actual_level) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ bytes : pair (signature %signed_weather_data) (nat %actual_level) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ } ; SWAP - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) : pair signature bytes - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; CDDDR %weather_service_key ; DIP { UNPAIR /* [ signature : bytes - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ } /* [ key : signature : bytes - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; CHECK_SIGNATURE @sigok /* [ bool - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; ASSERT ; DUP - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; DUP - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; DUP - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; DIIIP { CDR %storage /* [ pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ } - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; DIIP { CDAR } - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) - : pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + : pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) : pair (address %under_key) (address %over_key) : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; DIP { CADR %actual_level } - /* [ pair (pair (signature %signed_weather_data) (nat :rain %actual_level)) + /* [ pair (pair (signature %signed_weather_data) (nat %actual_level)) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) - (key %weather_service_key) : nat :rain + (nat %rain_level) + (key %weather_service_key) : nat : pair (address %under_key) (address %over_key) : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; CDDAR %rain_level ; CMPLT ; IF { CAR %under_key /* [ address : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ } { CDR %over_key /* [ address : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ } ; CONTRACT unit /* [ option (contract unit) : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; ASSERT_SOME ; BALANCE /* [ mutez : contract unit : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; UNIT /* [ unit : mutez : contract unit : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; TRANSFER_TOKENS @trans.op /* [ operation : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; NIL operation /* [ list operation : operation : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; SWAP /* [ operation : list operation : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; CONS /* [ list operation : pair (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ ; PAIR /* [ pair (list operation) (pair (address %under_key) (address %over_key)) - (nat :rain %rain_level) + (nat %rain_level) (key %weather_service_key) ] */ } } diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--and.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--and.tz].out index c248d20f7b2801b2f27ff25cf6c62a5cdc446f8e..068b109a080cfb6809f3646deecf570d29f668fa 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--and.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--and.tz].out @@ -5,7 +5,7 @@ Gas remaining: 1039994.393 units remaining { parameter (pair :param (bool %first) (bool %second)) ; storage (option bool) ; code { CAR - /* [ pair :param (bool %first) (bool %second) ] */ ; + /* [ pair (bool %first) (bool %second) ] */ ; UNPAIR /* [ bool : bool ] */ ; AND @and diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--car.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--car.tz].out index 1ff040e5227625c8a56f6dc0c7cc12511ffd9ead..320069d54a279341d4bd68d9976eae9e413a44d6 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--car.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--car.tz].out @@ -5,10 +5,10 @@ Gas remaining: 1039996.637 units remaining { parameter (pair (nat :l) (nat :r)) ; storage nat ; code { CAR - /* [ pair (nat :l) (nat :r) ] */ ; + /* [ pair nat nat ] */ ; CAR - /* [ nat :l ] */ ; + /* [ nat ] */ ; NIL operation - /* [ list operation : nat :l ] */ ; + /* [ list operation : nat ] */ ; PAIR - /* [ pair (list operation) (nat :l) ] */ } } + /* [ pair (list operation) nat ] */ } } diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--cdr.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--cdr.tz].out index fed4de220bc2f029eb9e2d027d737d2622f26bc9..410cd3fc86992c9f2a31ec90845ac60f3ed4644b 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--cdr.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--cdr.tz].out @@ -5,10 +5,10 @@ Gas remaining: 1039996.637 units remaining { parameter (pair (nat :l) (nat :r)) ; storage nat ; code { CAR - /* [ pair (nat :l) (nat :r) ] */ ; + /* [ pair nat nat ] */ ; CDR - /* [ nat :r ] */ ; + /* [ nat ] */ ; NIL operation - /* [ list operation : nat :r ] */ ; + /* [ list operation : nat ] */ ; PAIR - /* [ pair (list operation) (nat :r) ] */ } } + /* [ pair (list operation) nat ] */ } } diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--map_iter.tz].out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--map_iter.tz].out index 4aae424dee4f114894fdb3a0e0e208399f09880b..f7f86bc73581c4ca9032d1e9ac900b02406d3e5d 100644 --- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--map_iter.tz].out +++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestTypecheck::test_typecheck[opcodes--map_iter.tz].out @@ -5,34 +5,34 @@ Gas remaining: 1039985.509 units remaining { parameter (map (int :k) (int :e)) ; storage (pair (int :k) (int :e)) ; code { CAR - /* [ map (int :k) (int :e) ] */ ; + /* [ map int int ] */ ; PUSH @acc_e (int :e) 0 - /* [ int :e : map (int :k) (int :e) ] */ ; + /* [ int : map int int ] */ ; PUSH @acc_k (int :k) 0 - /* [ int :k : int :e : map (int :k) (int :e) ] */ ; + /* [ int : int : map int int ] */ ; PAIR % %r - /* [ pair (int :k) (int :e %r) : map (int :k) (int :e) ] */ ; + /* [ pair int (int %r) : map int int ] */ ; SWAP - /* [ map (int :k) (int :e) : pair (int :k) (int :e %r) ] */ ; + /* [ map int int : pair int (int %r) ] */ ; ITER { DIP { DUP - /* [ pair (int :k) (int :e %r) : pair (int :k) (int :e %r) ] */ ; + /* [ pair int (int %r) : pair int (int %r) ] */ ; CAR - /* [ int :k : pair (int :k) (int :e %r) ] */ ; - DIP { CDR /* [ int :e ] */ } - /* [ int :k : int :e ] */ } - /* [ pair (int :k) (int :e) : int :k : int :e ] */ ; + /* [ int : pair int (int %r) ] */ ; + DIP { CDR /* [ int ] */ } + /* [ int : int ] */ } + /* [ pair int int : int : int ] */ ; DUP - /* [ pair (int :k) (int :e) : pair (int :k) (int :e) : int :k : int :e ] */ ; - DIP { CAR /* [ int :k : int :k : int :e ] */ ; ADD /* [ int :k : int :e ] */ } - /* [ pair (int :k) (int :e) : int :k : int :e ] */ ; + /* [ pair int int : pair int int : int : int ] */ ; + DIP { CAR /* [ int : int : int ] */ ; ADD /* [ int : int ] */ } + /* [ pair int int : int : int ] */ ; SWAP - /* [ int :k : pair (int :k) (int :e) : int :e ] */ ; - DIP { CDR /* [ int :e : int :e ] */ ; ADD /* [ int :e ] */ } - /* [ int :k : int :e ] */ ; + /* [ int : pair int int : int ] */ ; + DIP { CDR /* [ int : int ] */ ; ADD /* [ int ] */ } + /* [ int : int ] */ ; PAIR % %r - /* [ pair (int :k) (int :e %r) ] */ } - /* [ pair (int :k) (int :e %r) ] */ ; + /* [ pair int (int %r) ] */ } + /* [ pair int (int %r) ] */ ; NIL operation - /* [ list operation : pair (int :k) (int :e %r) ] */ ; + /* [ list operation : pair int (int %r) ] */ ; PAIR - /* [ pair (list operation) (int :k) (int :e %r) ] */ } } + /* [ pair (list operation) int (int %r) ] */ } }