From 2c049640da473fe3e63a98ae463f41cc3000a39a Mon Sep 17 00:00:00 2001 From: Shubham Date: Tue, 28 Jun 2022 20:02:53 +0530 Subject: [PATCH 1/5] remove coq attributes --- src/proto_010_PtGRANAD/lib_plugin/plugin.ml | 2 +- .../lib_protocol/apply_results.ml | 34 +++--- src/proto_010_PtGRANAD/lib_protocol/baking.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/michelson_v1_gas.ml | 2 +- .../lib_protocol/operation_repr.ml | 26 ++--- src/proto_011_PtHangz2/lib_plugin/plugin.ml | 2 +- src/proto_011_PtHangz2/lib_protocol/apply.ml | 16 +-- .../lib_protocol/apply_results.ml | 40 +++---- src/proto_011_PtHangz2/lib_protocol/baking.ml | 4 +- .../lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/level_storage.ml | 4 +- src/proto_011_PtHangz2/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_011_PtHangz2/lib_protocol/misc.ml | 4 +- .../lib_protocol/operation_repr.ml | 34 +++--- .../lib_protocol/roll_storage.ml | 12 +- .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 52 ++++----- .../lib_protocol/script_repr.ml | 6 +- .../lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- .../lib_protocol/tez_repr.ml | 2 +- src/proto_012_Psithaca/lib_plugin/plugin.ml | 2 +- src/proto_012_Psithaca/lib_protocol/apply.ml | 16 +-- .../lib_protocol/apply_results.ml | 44 ++++---- .../lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/level_storage.ml | 4 +- src/proto_012_Psithaca/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_012_Psithaca/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 36 +++--- .../lib_protocol/roll_storage_legacy.ml | 10 +- .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 50 ++++----- .../lib_protocol/script_repr.ml | 6 +- .../lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- .../lib_protocol/tez_repr.ml | 2 +- src/proto_013_PtJakart/lib_plugin/plugin.ml | 2 +- src/proto_013_PtJakart/lib_protocol/apply.ml | 16 +-- .../lib_protocol/apply_results.ml | 98 ++++++++-------- .../lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/level_storage.ml | 4 +- src/proto_013_PtJakart/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_013_PtJakart/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 62 +++++----- .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 44 ++++---- .../lib_protocol/script_repr.ml | 6 +- .../lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- .../lib_protocol/tez_repr.ml | 2 +- src/proto_alpha/lib_plugin/RPC.ml | 2 +- src/proto_alpha/lib_protocol/apply.ml | 6 +- src/proto_alpha/lib_protocol/apply_results.ml | 106 +++++++++--------- src/proto_alpha/lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- src/proto_alpha/lib_protocol/level_storage.ml | 4 +- src/proto_alpha/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_alpha/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 72 ++++++------ .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 44 ++++---- src/proto_alpha/lib_protocol/script_repr.ml | 6 +- src/proto_alpha/lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- src/proto_alpha/lib_protocol/tez_repr.ml | 2 +- 73 files changed, 498 insertions(+), 498 deletions(-) diff --git a/src/proto_010_PtGRANAD/lib_plugin/plugin.ml b/src/proto_010_PtGRANAD/lib_plugin/plugin.ml index 549d3e3c74005..46a6e0ee19149 100644 --- a/src/proto_010_PtGRANAD/lib_plugin/plugin.ml +++ b/src/proto_010_PtGRANAD/lib_plugin/plugin.ml @@ -1495,7 +1495,7 @@ module RPC = struct })) module Manager = struct - let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml b/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml index da0867bd95e9c..666bcfcf77e2c 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml @@ -191,7 +191,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; iselect; select; proj; inj; t} - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -217,7 +217,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding: @@ -296,7 +296,7 @@ module Manager_result = struct allocated_destination_contract; }) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -537,7 +537,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let[@coq_axiom_with_reason "gadt"] endorsement_case = + let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -564,7 +564,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; slots}); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -586,7 +586,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case = + let endorsement_with_slot_case = Case { op_case = Operation.Encoding.endorsement_with_slot_case; @@ -618,7 +618,7 @@ module Encoding = struct (Endorsement_result {balance_updates; delegate; slots})); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = + let double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -640,7 +640,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -662,7 +662,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -684,7 +684,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -702,7 +702,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -720,7 +720,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) + let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -810,7 +810,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -821,7 +821,7 @@ module Encoding = struct | _ -> None) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -832,7 +832,7 @@ module Encoding = struct | _ -> None) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -843,7 +843,7 @@ module Encoding = struct | _ -> None) - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1169,7 +1169,7 @@ let rec kind_equal_list : | _ -> None -let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : +let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_010_PtGRANAD/lib_protocol/baking.ml b/src/proto_010_PtGRANAD/lib_protocol/baking.ml index 436a8e8a81e79..6f984c91cb9ee 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/baking.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/baking.ml @@ -335,7 +335,7 @@ let endorsement_rights ctxt level = (0 --> (Constants.endorsers_per_block ctxt - 1)) Signature.Public_key_hash.Map.empty -let[@coq_axiom_with_reason "gadt"] check_endorsement_rights ctxt chain_id ~slot +let check_endorsement_rights ctxt chain_id ~slot (op : Kind.endorsement Operation.t) = if Compare.Int.(slot < 0 (* should not happen because of binary format *)) diff --git a/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml b/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml index ccc3c887987e1..e9898cbf85865 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml @@ -256,7 +256,7 @@ module S = struct end end -let[@coq_axiom_with_reason "gadt"] register () = +let register () = let open Services_registration in register0 S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field s f = diff --git a/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml b/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml index 8c5d185d9f933..17749e3a26a3b 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml @@ -1346,7 +1346,7 @@ module Cost_of = struct let compare : type a. a Script_typed_ir.comparable_ty -> a -> a -> cost = fun ty x y -> - let[@coq_axiom_with_reason "gadt"] rec compare : + let rec compare : type a. a Script_typed_ir.comparable_ty -> a -> a -> cost -> cont -> cost = fun ty x y acc k -> diff --git a/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml b/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml index 5666100d52f22..d6fe107639676 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml @@ -239,7 +239,7 @@ module Encoding = struct } -> 'kind case - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = MCase { tag = 0; @@ -277,7 +277,7 @@ module Encoding = struct (fun s -> Some s) (fun s -> s) ] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { tag = 1; @@ -316,7 +316,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { tag = 2; @@ -346,7 +346,7 @@ module Encoding = struct Origination {credit; delegate; script; preorigination = None}); } - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { tag = 3; @@ -401,7 +401,7 @@ module Encoding = struct inj = (fun level -> Endorsement {level}); } - let[@coq_axiom_with_reason "gadt"] endorsement_encoding = + let endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -426,7 +426,7 @@ module Encoding = struct @@ union [make endorsement_case] )) (varopt "signature" Signature.encoding))) - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { tag = 1; @@ -442,7 +442,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case : + let endorsement_with_slot_case : Kind.endorsement_with_slot case = Case { @@ -463,7 +463,7 @@ module Encoding = struct Endorsement_with_slot {endorsement; slot}); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -488,7 +488,7 @@ module Encoding = struct Double_endorsement_evidence {op1; op2; slot}); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { tag = 3; @@ -504,7 +504,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { tag = 4; @@ -523,7 +523,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { tag = 5; @@ -543,7 +543,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { tag = 6; @@ -594,7 +594,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) + let make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_011_PtHangz2/lib_plugin/plugin.ml b/src/proto_011_PtHangz2/lib_plugin/plugin.ml index faa3009e42cf6..027e8556de352 100644 --- a/src/proto_011_PtHangz2/lib_plugin/plugin.ml +++ b/src/proto_011_PtHangz2/lib_plugin/plugin.ml @@ -1645,7 +1645,7 @@ module RPC = struct })) module Manager = struct - let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_011_PtHangz2/lib_protocol/apply.ml b/src/proto_011_PtHangz2/lib_protocol/apply.ml index ff7568a14b80d..9bddb77a03870 100644 --- a/src/proto_011_PtHangz2/lib_protocol/apply.ml +++ b/src/proto_011_PtHangz2/lib_protocol/apply.ml @@ -801,7 +801,7 @@ let apply_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let[@coq_struct "ctxt"] rec apply ctxt applied worklist = + let rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Internal_operation ({source; operation; nonce} as op) :: rest -> ( @@ -841,7 +841,7 @@ let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = let precheck_manager_contents (type kind) ctxt (op : kind Kind.manager contents) : context tzresult Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; fee; @@ -889,7 +889,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_operation_result list) Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; operation; @@ -954,7 +954,7 @@ let rec mark_skipped : Level.t -> kind Kind.manager contents_list -> kind Kind.manager contents_result_list = - fun ~baker level -> function[@coq_match_with_default] + fun ~baker level -> function | Single (Manager_operation {source; fee; operation; _}) -> let source = Contract.implicit_contract source in Single_result @@ -990,7 +990,7 @@ let rec precheck_manager_contents_list : Alpha_context.t -> kind Kind.manager contents_list -> context tzresult Lwt.t = fun ctxt contents_list -> - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Manager_operation _ as op) -> precheck_manager_contents ctxt op | Cons ((Manager_operation _ as op), rest) -> precheck_manager_contents ctxt op >>=? fun ctxt -> @@ -1019,7 +1019,7 @@ let check_manager_signature ctxt chain_id (op : _ Kind.manager contents_list) (Signature.public_key_hash * Signature.public_key option) option -> (Signature.public_key_hash * Signature.public_key option) tzresult = fun contents_list manager -> - let source (type kind) = function[@coq_match_with_default] + let source (type kind) = function | (Manager_operation {source; operation = Reveal key; _} : kind Kind.manager contents) -> (source, Some key) @@ -1048,7 +1048,7 @@ let rec apply_manager_contents_list_rec : (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = fun ctxt mode baker chain_id contents_list -> let level = Level.current ctxt in - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Manager_operation {source; fee; _} as op) -> let source = Contract.implicit_contract source in apply_manager_contents ctxt mode chain_id op @@ -1162,7 +1162,7 @@ let apply_manager_contents_list ctxt mode baker chain_id contents_list = let apply_contents_list (type kind) ctxt chain_id mode pred_block baker (operation : kind operation) (contents_list : kind contents_list) : (context * kind contents_result_list) tzresult Lwt.t = - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Endorsement_with_slot { diff --git a/src/proto_011_PtHangz2/lib_protocol/apply_results.ml b/src/proto_011_PtHangz2/lib_protocol/apply_results.ml index efb188f96f79b..a4d1f68dbf3e1 100644 --- a/src/proto_011_PtHangz2/lib_protocol/apply_results.ml +++ b/src/proto_011_PtHangz2/lib_protocol/apply_results.ml @@ -197,7 +197,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; iselect; select; proj; inj; t} - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -220,7 +220,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding: @@ -298,7 +298,7 @@ module Manager_result = struct allocated_destination_contract; }) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -366,7 +366,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -412,7 +412,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function[@coq_match_with_default] + ~proj:(function | Delegation_result {consumed_gas} -> (Gas.Arith.ceil consumed_gas, consumed_gas)) ~inj:(fun (consumed_gas, consumed_milligas) -> @@ -562,7 +562,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let[@coq_axiom_with_reason "gadt"] endorsement_case = + let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -587,7 +587,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; slots}); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -605,7 +605,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case = + let endorsement_with_slot_case = Case { op_case = Operation.Encoding.endorsement_with_slot_case; @@ -634,7 +634,7 @@ module Encoding = struct (Endorsement_result {balance_updates; delegate; slots})); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = + let double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -653,7 +653,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -671,7 +671,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -689,7 +689,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -705,7 +705,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -721,7 +721,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) + let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -801,7 +801,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -811,7 +811,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -821,7 +821,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -831,7 +831,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -841,7 +841,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1190,7 +1190,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : +let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_011_PtHangz2/lib_protocol/baking.ml b/src/proto_011_PtHangz2/lib_protocol/baking.ml index 2e6b6c6532e2c..176ea20ff998e 100644 --- a/src/proto_011_PtHangz2/lib_protocol/baking.ml +++ b/src/proto_011_PtHangz2/lib_protocol/baking.ml @@ -185,7 +185,7 @@ let minimal_time_fastpath_case minimal_block_delay pred_timestamp = (* The function implements the slow-path case in [minimal_time]. (See [minimal_valid_time] for the definition of the slow-path.) *) let minimal_time_slowpath_case time_between_blocks priority pred_timestamp = - let[@coq_struct "durations"] rec cumsum_time_between_blocks acc durations p = + let rec cumsum_time_between_blocks acc durations p = if Compare.Int32.( <= ) p 0l then ok acc else match durations with @@ -325,7 +325,7 @@ let endorsement_rights ctxt level = (0 --> (Constants.endorsers_per_block ctxt - 1)) Signature.Public_key_hash.Map.empty -let[@coq_axiom_with_reason "gadt"] check_endorsement_right ctxt chain_id ~slot +let check_endorsement_right ctxt chain_id ~slot (op : Kind.endorsement Operation.t) = if Compare.Int.(slot < 0 (* should not happen because of binary format *)) diff --git a/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml b/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml index 07b78e0fd888c..d705ed864ca30 100644 --- a/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml @@ -161,7 +161,7 @@ let originated_contracts ({origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let[@coq_struct "origination_index"] rec contracts acc origination_index = + let rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_011_PtHangz2/lib_protocol/contract_services.ml b/src/proto_011_PtHangz2/lib_protocol/contract_services.ml index 8fb552b10479a..8de17bfb7516a 100644 --- a/src/proto_011_PtHangz2/lib_protocol/contract_services.ml +++ b/src/proto_011_PtHangz2/lib_protocol/contract_services.ml @@ -254,7 +254,7 @@ module S = struct end end -let[@coq_axiom_with_reason "gadt"] register () = +let register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field ~chunked s f = diff --git a/src/proto_011_PtHangz2/lib_protocol/level_storage.ml b/src/proto_011_PtHangz2/lib_protocol/level_storage.ml index de01a2f49d5b5..551b9ce07fdb8 100644 --- a/src/proto_011_PtHangz2/lib_protocol/level_storage.ml +++ b/src/proto_011_PtHangz2/lib_protocol/level_storage.ml @@ -61,7 +61,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -77,7 +77,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_011_PtHangz2/lib_protocol/main.ml b/src/proto_011_PtHangz2/lib_protocol/main.ml index c68235cff4b09..4cdf7fd9f4466 100644 --- a/src/proto_011_PtHangz2/lib_protocol/main.ml +++ b/src/proto_011_PtHangz2/lib_protocol/main.ml @@ -402,7 +402,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match[@coq_match_with_default] (op1.contents, op2.contents) with + match (op1.contents, op2.contents) with | (Single (Endorsement _), Single (Endorsement _)) -> 0 | (_, Single (Endorsement _)) -> 1 | (Single (Endorsement _), _) -> -1 diff --git a/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml b/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml index 5197d0a887afa..057973a90aa64 100644 --- a/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml @@ -226,7 +226,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let[@coq_struct "a_value"] rec for_all a b f = + let rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_011_PtHangz2/lib_protocol/misc.ml b/src/proto_011_PtHangz2/lib_protocol/misc.ml index 6e3d49853380e..4b6b76ad81c4d 100644 --- a/src/proto_011_PtHangz2/lib_protocol/misc.ml +++ b/src/proto_011_PtHangz2/lib_protocol/misc.ml @@ -29,11 +29,11 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let[@coq_struct "i"] rec ( --> ) i j = +let rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let[@coq_struct "i"] rec ( ---> ) i j = +let rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml b/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml index ed496155628f0..29541e8d91df6 100644 --- a/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml @@ -248,7 +248,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = MCase { tag = 0; @@ -288,7 +288,7 @@ module Encoding = struct (fun s -> s); ] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { tag = 1; @@ -325,7 +325,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { tag = 2; @@ -356,7 +356,7 @@ module Encoding = struct Origination {credit; delegate; script; preorigination = None}); } - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { tag = 3; @@ -368,7 +368,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = MCase { tag = 4; @@ -421,11 +421,11 @@ module Encoding = struct encoding = obj1 (req "level" Raw_level_repr.encoding); select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); - proj = (fun [@coq_match_with_default] (Endorsement {level}) -> level); + proj = (fun (Endorsement {level}) -> level); inj = (fun level -> Endorsement {level}); } - let[@coq_axiom_with_reason "gadt"] endorsement_encoding = + let endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -447,7 +447,7 @@ module Encoding = struct @@ union [make endorsement_case])) (varopt "signature" Signature.encoding))) - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { tag = 1; @@ -463,7 +463,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case : + let endorsement_with_slot_case : Kind.endorsement_with_slot case = Case { @@ -483,7 +483,7 @@ module Encoding = struct (fun (endorsement, slot) -> Endorsement_with_slot {endorsement; slot}); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -505,7 +505,7 @@ module Encoding = struct (fun (op1, op2, slot) -> Double_endorsement_evidence {op1; op2; slot}); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { tag = 3; @@ -521,7 +521,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { tag = 4; @@ -540,7 +540,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { tag = 5; @@ -560,7 +560,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { tag = 6; @@ -590,7 +590,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function[@coq_match_with_default] Failing_noop message -> message); + (function Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -603,7 +603,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function[@coq_match_with_default] + function | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -612,7 +612,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) + let make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml b/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml index 9b872cb49263f..fede8d640b652 100644 --- a/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml +++ b/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml @@ -105,7 +105,7 @@ let clear_cycle ctxt cycle = let fold ctxt ~f init = Storage.Roll.Next.get ctxt >>=? fun last -> - let[@coq_struct "roll"] rec loop ctxt roll acc = + let rec loop ctxt roll acc = if Roll_repr.(roll = last) then return acc else Storage.Roll.Owner.find ctxt roll >>=? function @@ -185,7 +185,7 @@ let count_rolls ctxt delegate = Storage.Roll.Delegate_roll_list.find ctxt delegate >>=? function | None -> return 0 | Some head_roll -> - let[@coq_struct "roll"] rec loop acc roll = + let rec loop acc roll = Storage.Roll.Successor.find ctxt roll >>=? function | None -> return acc | Some next -> loop (succ acc) next @@ -308,7 +308,7 @@ module Delegate = struct Tez_repr.(amount +? change) >>?= fun change -> Storage.Roll.Delegate_change.update ctxt delegate change >>=? fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> @@ -326,7 +326,7 @@ module Delegate = struct let remove_amount ctxt delegate amount = let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = if Tez_repr.(amount <= change) then return (ctxt, change) else pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) -> @@ -356,7 +356,7 @@ module Delegate = struct (Contract_repr.implicit_contract delegate) >>= fun ctxt -> Storage.Active_delegates_with_rolls.remove ctxt delegate >>= fun ctxt -> - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = Storage.Roll.Delegate_roll_list.find ctxt delegate >>=? function | None -> return (ctxt, change) | Some _roll -> @@ -406,7 +406,7 @@ module Delegate = struct (Contract_repr.implicit_contract delegate) >>= fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> diff --git a/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml b/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml index 167f75f1f913b..186f0359ad799 100644 --- a/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml +++ b/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let[@coq_struct "height"] rec insert ctx id node height pos cms = + let rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height + let rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let[@coq_struct "pos"] rec aux acc pos = + let rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let[@coq_struct "pos"] rec aux ctx pos = + let rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml b/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml index ca7e23c9b3326..1a53e7f9e3ba8 100644 --- a/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml +++ b/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml @@ -343,7 +343,7 @@ let rec unparse_ty : type a. context -> a ty -> (Script.node * context) tzresult return ctxt (T_chest_key, [], unparse_type_annot meta.annot) | Chest_t meta -> return ctxt (T_chest, [], unparse_type_annot meta.annot) -let[@coq_struct "function_parameter"] rec strip_var_annots = function +let rec strip_var_annots = function | (Int _ | String _ | Bytes _) as atom -> atom | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args) | Prim (loc, name, args, annots) -> @@ -358,7 +358,7 @@ let serialize_ty_for_error ctxt ty = (Micheline.strip_locations (strip_var_annots ty), ctxt)) |> record_trace Cannot_serialize_error -let[@coq_axiom_with_reason "gadt"] rec comparable_ty_of_ty : +let rec comparable_ty_of_ty : type a. context -> Script.location -> a ty -> (a comparable_ty * context) tzresult = fun ctxt loc ty -> @@ -633,7 +633,7 @@ let comparable_comb_witness2 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : +let rec unparse_comparable_data : type a. context -> unparsing_mode -> @@ -1257,7 +1257,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] + | Ok _ as ok_memo_size -> ok_memo_size | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -1266,7 +1266,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : type ex_comparable_ty = | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty -let[@coq_struct "ty"] rec parse_comparable_ty : +let rec parse_comparable_ty : stack_depth:int -> context -> Script.node -> @@ -1395,7 +1395,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : type ex_ty = Ex_ty : 'a ty -> ex_ty -let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_packable_ty +let rec parse_packable_ty : context -> stack_depth:int -> @@ -1412,7 +1412,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_pa ~allow_contract:legacy ~allow_ticket:false -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_parameter_ty +and parse_parameter_ty : context -> stack_depth:int -> @@ -1461,7 +1461,7 @@ and parse_view_output_ty : ~allow_contract:true ~allow_ticket:false -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_normal_storage_ty +and parse_normal_storage_ty : context -> stack_depth:int -> @@ -1478,7 +1478,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_normal ~allow_contract:legacy ~allow_ticket:true -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty +and parse_any_ty : context -> stack_depth:int -> @@ -1495,7 +1495,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty ~allow_contract:true ~allow_ticket:true -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : +and parse_ty : context -> stack_depth:int -> legacy:bool -> @@ -1779,7 +1779,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : T_ticket; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty +and parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1797,7 +1797,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_ma (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty +and parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2044,7 +2044,7 @@ exception Duplicate of string exception Too_long of string -let[@coq_axiom_with_reason "use of exceptions"] well_formed_entrypoints +let well_formed_entrypoints (type full) (full : full ty) ~root_name = let merge path annot (type t) (ty : t ty) reachable ((first_unreachable, all) as acc) = @@ -2419,7 +2419,7 @@ let comparable_comb_witness1 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : +let rec parse_comparable_data : type a. ?type_logger:type_logger -> context -> @@ -2500,7 +2500,7 @@ let comb_witness1 : type t. t ty -> (t, unit -> unit) comb_witness = function - storage after origination *) -let[@coq_axiom_with_reason "gadt"] rec parse_data : +let rec parse_data : type a. ?type_logger:type_logger -> stack_depth:int -> @@ -2987,7 +2987,7 @@ and typecheck_views : in SMap.fold_es aux views ctxt -and[@coq_axiom_with_reason "gadt"] parse_returning : +and parse_returning : type arg ret. ?type_logger:type_logger -> stack_depth:int -> @@ -3037,7 +3037,7 @@ and[@coq_axiom_with_reason "gadt"] parse_returning : : (arg, ret) lambda), ctxt ) -and[@coq_axiom_with_reason "gadt"] parse_instr : +and parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -5428,7 +5428,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : I_OPEN_CHEST; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : +and parse_contract : type arg. stack_depth:int -> legacy:bool -> @@ -5791,7 +5791,7 @@ let parse_storage : storage_type (root storage)) -let[@coq_axiom_with_reason "gadt"] parse_script : +let parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5958,7 +5958,7 @@ let comb_witness2 : type t. t ty -> (t, unit -> unit -> unit) comb_witness = | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_data : +let rec unparse_data : type a. context -> stack_depth:int -> @@ -6145,7 +6145,7 @@ and unparse_items : ([], ctxt) items -and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = +and unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -6482,7 +6482,7 @@ let rec has_lazy_storage : type t. t ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode +let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a. @@ -6590,7 +6590,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : +let rec fold_lazy_storage : type a error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -6652,7 +6652,7 @@ let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : (ok (Fold_lazy_storage.Ok init, ctxt)) | _ -> (* TODO: fix injectivity of types *) assert false -let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = +let collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -6662,7 +6662,7 @@ let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode +let extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6737,7 +6737,7 @@ let parse_ty = parse_ty ~stack_depth:0 let ty_eq ctxt = ty_eq ~legacy:true ctxt -let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = +let get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_011_PtHangz2/lib_protocol/script_repr.ml b/src/proto_011_PtHangz2/lib_protocol/script_repr.ml index cf361c027f63f..ceebba35167b5 100644 --- a/src/proto_011_PtHangz2/lib_protocol/script_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/script_repr.ml @@ -114,7 +114,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = + let rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -269,7 +269,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let[@coq_struct "node"] rec strip_annotations node = +let rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -287,7 +287,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes +and micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml b/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml index cae0b6bf28449..5d453d565b5a2 100644 --- a/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml @@ -125,7 +125,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = nonce seed zero_bytes let initial_seeds n = - let[@coq_struct "i"] rec loop acc elt i = + let rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_011_PtHangz2/lib_protocol/storage_description.ml b/src/proto_011_PtHangz2/lib_protocol/storage_description.ml index 72b91e8bd4334..c8f78f5a76ac8 100644 --- a/src/proto_011_PtHangz2/lib_protocol/storage_description.ml +++ b/src/proto_011_PtHangz2/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let[@coq_struct "function_parameter"] rec pp : +let rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let[@coq_struct "function_parameter"] rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and[@coq_mutual_as_notation] pp_item : +and pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml b/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml index 99345920deec8..f631a35239bfe 100644 --- a/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml @@ -88,7 +88,7 @@ let of_string s = let pp ppf amount = let mult_int = 1_000_000L in - let[@coq_struct "amount"] rec left ppf amount = + let rec left ppf amount = let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r diff --git a/src/proto_012_Psithaca/lib_plugin/plugin.ml b/src/proto_012_Psithaca/lib_plugin/plugin.ml index 0fe35085e6998..dc36e95c092df 100644 --- a/src/proto_012_Psithaca/lib_plugin/plugin.ml +++ b/src/proto_012_Psithaca/lib_plugin/plugin.ml @@ -3001,7 +3001,7 @@ module RPC = struct })) module Manager = struct - let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_012_Psithaca/lib_protocol/apply.ml b/src/proto_012_Psithaca/lib_protocol/apply.ml index 4b20f9e2fb24d..75d493b9d27b9 100644 --- a/src/proto_012_Psithaca/lib_protocol/apply.ml +++ b/src/proto_012_Psithaca/lib_protocol/apply.ml @@ -1096,7 +1096,7 @@ let apply_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let[@coq_struct "ctxt"] rec apply ctxt applied worklist = + let rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Internal_operation ({source; operation; nonce} as op) :: rest -> ( @@ -1137,7 +1137,7 @@ let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = let precheck_manager_contents (type kind) ctxt (op : kind Kind.manager contents) ~(only_batch : bool) : (context * precheck_result) tzresult Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; fee; @@ -1299,7 +1299,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_operation_result list) Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; operation; @@ -1387,7 +1387,7 @@ let rec mark_skipped : kind Kind.manager prechecked_contents_list -> kind Kind.manager contents_result_list = fun ~payload_producer level prechecked_contents_list -> - match[@coq_match_with_default] prechecked_contents_list with + match prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation {operation; _}; @@ -1425,7 +1425,7 @@ let precheck_manager_contents_list ctxt contents_list ~mempool_mode = kind Kind.manager contents_list -> (context * kind Kind.manager prechecked_contents_list) tzresult Lwt.t = fun ctxt contents_list -> - match[@coq_match_with_default] contents_list with + match contents_list with | Single contents -> precheck_manager_contents ctxt contents ~only_batch:mempool_mode >>=? fun (ctxt, result) -> @@ -1463,7 +1463,7 @@ let check_manager_signature ctxt chain_id (op : _ Kind.manager contents_list) (Signature.public_key_hash * Signature.public_key option) option -> (Signature.public_key_hash * Signature.public_key option) tzresult = fun contents_list manager -> - let source (type kind) = function[@coq_match_with_default] + let source (type kind) = function | (Manager_operation {source; operation = Reveal key; _} : kind Kind.manager contents) -> (source, Some key) @@ -1492,7 +1492,7 @@ let rec apply_manager_contents_list_rec : (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = fun ctxt mode ~payload_producer chain_id prechecked_contents_list -> let level = Level.current ctxt in - match[@coq_match_with_default] prechecked_contents_list with + match prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation _ as op; @@ -2034,7 +2034,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_012_Psithaca/lib_protocol/apply_results.ml b/src/proto_012_Psithaca/lib_protocol/apply_results.ml index db84ac9e89c47..d94bf0020595e 100644 --- a/src/proto_012_Psithaca/lib_protocol/apply_results.ml +++ b/src/proto_012_Psithaca/lib_protocol/apply_results.ml @@ -201,7 +201,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; iselect; select; proj; inj; t} - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -224,7 +224,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding: @@ -303,7 +303,7 @@ module Manager_result = struct allocated_destination_contract; }) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -372,7 +372,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -418,7 +418,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function[@coq_match_with_default] + ~proj:(function | Delegation_result {consumed_gas} -> (Gas.Arith.ceil consumed_gas, consumed_gas)) ~inj:(fun (consumed_gas, consumed_milligas) -> @@ -605,7 +605,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let[@coq_axiom_with_reason "gadt"] preendorsement_case = + let preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -633,7 +633,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let[@coq_axiom_with_reason "gadt"] endorsement_case = + let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -658,7 +658,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -676,7 +676,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = + let double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -695,7 +695,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case = + let double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -715,7 +715,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -733,7 +733,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -751,7 +751,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -767,7 +767,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -783,7 +783,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) + let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -864,7 +864,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -874,7 +874,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -884,7 +884,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -894,7 +894,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -904,7 +904,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -916,7 +916,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1298,7 +1298,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : +let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_012_Psithaca/lib_protocol/contract_repr.ml b/src/proto_012_Psithaca/lib_protocol/contract_repr.ml index 84c4251b5c6a4..f4cef224afec1 100644 --- a/src/proto_012_Psithaca/lib_protocol/contract_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/contract_repr.ml @@ -161,7 +161,7 @@ let originated_contracts ({origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let[@coq_struct "origination_index"] rec contracts acc origination_index = + let rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_012_Psithaca/lib_protocol/contract_services.ml b/src/proto_012_Psithaca/lib_protocol/contract_services.ml index 799d8c5ae62bc..870a3d0dd8a87 100644 --- a/src/proto_012_Psithaca/lib_protocol/contract_services.ml +++ b/src/proto_012_Psithaca/lib_protocol/contract_services.ml @@ -254,7 +254,7 @@ module S = struct end end -let[@coq_axiom_with_reason "gadt"] register () = +let register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field ~chunked s f = diff --git a/src/proto_012_Psithaca/lib_protocol/level_storage.ml b/src/proto_012_Psithaca/lib_protocol/level_storage.ml index cf4fa87d12c45..74262b55496f9 100644 --- a/src/proto_012_Psithaca/lib_protocol/level_storage.ml +++ b/src/proto_012_Psithaca/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_012_Psithaca/lib_protocol/main.ml b/src/proto_012_Psithaca/lib_protocol/main.ml index a3b6fac5786d5..d12e51825b044 100644 --- a/src/proto_012_Psithaca/lib_protocol/main.ml +++ b/src/proto_012_Psithaca/lib_protocol/main.ml @@ -685,7 +685,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match[@coq_match_with_default] (op1.contents, op2.contents) with + match (op1.contents, op2.contents) with | (Single (Preendorsement _), Single (Preendorsement _)) -> 0 | (Single (Preendorsement _), _) -> -1 | (_, Single (Preendorsement _)) -> 1 diff --git a/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml b/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml index c1434b14ec146..42adfc5ff88b2 100644 --- a/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml @@ -227,7 +227,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let[@coq_struct "a_value"] rec for_all a b f = + let rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_012_Psithaca/lib_protocol/misc.ml b/src/proto_012_Psithaca/lib_protocol/misc.ml index bd350a5ef85b2..d7c95b87aa3c4 100644 --- a/src/proto_012_Psithaca/lib_protocol/misc.ml +++ b/src/proto_012_Psithaca/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let[@coq_struct "i"] rec ( --> ) i j = +let rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let[@coq_struct "j"] rec ( <-- ) i j = +let rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let[@coq_struct "i"] rec ( ---> ) i j = +let rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_012_Psithaca/lib_protocol/operation_repr.ml b/src/proto_012_Psithaca/lib_protocol/operation_repr.ml index 5db0a3162834a..50c58210061ab 100644 --- a/src/proto_012_Psithaca/lib_protocol/operation_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/operation_repr.ml @@ -347,7 +347,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = MCase { tag = 0; @@ -387,7 +387,7 @@ module Encoding = struct (fun s -> s); ] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { tag = 1; @@ -424,7 +424,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { tag = 2; @@ -455,7 +455,7 @@ module Encoding = struct Origination {credit; delegate; script; preorigination = None}); } - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { tag = 3; @@ -467,7 +467,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = MCase { tag = 4; @@ -480,7 +480,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = MCase { tag = 5; @@ -582,7 +582,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun [@coq_match_with_default] (Endorsement consensus_content) -> + (fun (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -592,7 +592,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let[@coq_axiom_with_reason "gadt"] endorsement_encoding = + let endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -614,7 +614,7 @@ module Encoding = struct @@ union [make endorsement_case])) (varopt "signature" Signature.encoding))) - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { tag = 1; @@ -630,7 +630,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case : + let double_preendorsement_evidence_case : Kind.double_preendorsement_evidence case = Case { @@ -648,7 +648,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -666,7 +666,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { tag = 3; @@ -682,7 +682,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { tag = 4; @@ -701,7 +701,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { tag = 5; @@ -721,7 +721,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { tag = 6; @@ -751,7 +751,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function[@coq_match_with_default] Failing_noop message -> message); + (function Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -764,7 +764,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function[@coq_match_with_default] + function | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -773,7 +773,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) + let make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml b/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml index b37010dff8988..1ae2e81205af7 100644 --- a/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml +++ b/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml @@ -97,7 +97,7 @@ let delegate_pubkey ctxt delegate = let fold ctxt ~f init = Storage.Roll_legacy.Next.get ctxt >>=? fun last -> - let[@coq_struct "roll"] rec loop ctxt roll acc = + let rec loop ctxt roll acc = if Roll_repr_legacy.(roll = last) then return acc else Storage.Roll_legacy.Owner.find ctxt roll >>=? function @@ -228,7 +228,7 @@ module Delegate = struct Storage.Roll_legacy.Delegate_change.update ctxt delegate change >>=? fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> @@ -248,7 +248,7 @@ module Delegate = struct let remove_amount ctxt delegate amount = let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = if Tez_repr.(amount <= change) then return (ctxt, change) else pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) -> @@ -280,7 +280,7 @@ module Delegate = struct >>= fun ctxt -> Storage.Legacy_active_delegates_with_rolls.remove ctxt delegate >>= fun ctxt -> - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate >>=? function | None -> return (ctxt, change) | Some _roll -> @@ -330,7 +330,7 @@ module Delegate = struct (Contract_repr.implicit_contract delegate) >>= fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let[@coq_struct "change"] rec loop ctxt change = + let rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> diff --git a/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml b/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml index 167f75f1f913b..186f0359ad799 100644 --- a/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml +++ b/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let[@coq_struct "height"] rec insert ctx id node height pos cms = + let rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height + let rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let[@coq_struct "pos"] rec aux acc pos = + let rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let[@coq_struct "pos"] rec aux ctx pos = + let rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml b/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml index ceb7553e3dc02..07564bf08ce1b 100644 --- a/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml +++ b/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml @@ -351,7 +351,7 @@ let unparse_comparable_ty ~loc ctxt comp_ty = Gas.consume ctxt (Unparse_costs.unparse_comparable_type comp_ty) >|? fun ctxt -> (unparse_comparable_ty_uncarbonated ~loc comp_ty, ctxt) -let[@coq_struct "function_parameter"] rec strip_var_annots = function +let rec strip_var_annots = function | (Int _ | String _ | Bytes _) as atom -> atom | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args) | Prim (loc, name, args, annots) -> @@ -371,7 +371,7 @@ let serialize_ty_for_error ty = let ty = unparse_ty_uncarbonated ~loc:() ty in Micheline.strip_locations (strip_var_annots ty) -let[@coq_axiom_with_reason "gadt"] rec comparable_ty_of_ty : +let rec comparable_ty_of_ty : type a. context -> Script.location -> a ty -> (a comparable_ty * context) tzresult = fun ctxt loc ty -> @@ -646,7 +646,7 @@ let comparable_comb_witness2 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : +let rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -1211,7 +1211,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] + | Ok _ as ok_memo_size -> ok_memo_size | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -1220,7 +1220,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : type ex_comparable_ty = | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty -let[@coq_struct "ty"] rec parse_comparable_ty : +let rec parse_comparable_ty : stack_depth:int -> context -> Script.node -> @@ -1349,7 +1349,7 @@ let[@coq_struct "ty"] rec parse_comparable_ty : type ex_ty = Ex_ty : 'a ty -> ex_ty -let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_packable_ty +let rec parse_packable_ty : context -> stack_depth:int -> @@ -1369,7 +1369,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_pa https://gitlab.com/tezos/tezos/-/issues/301 *) ~allow_ticket:false -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_parameter_ty +and parse_parameter_ty : context -> stack_depth:int -> @@ -1418,7 +1418,7 @@ and parse_view_output_ty : ~allow_contract:true ~allow_ticket:false -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_normal_storage_ty +and parse_normal_storage_ty : context -> stack_depth:int -> @@ -1435,7 +1435,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_normal ~allow_contract:legacy ~allow_ticket:true -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty +and parse_any_ty : context -> stack_depth:int -> @@ -1452,7 +1452,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty ~allow_contract:true ~allow_ticket:true -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : +and parse_ty : context -> stack_depth:int -> legacy:bool -> @@ -1736,7 +1736,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : T_ticket; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty +and parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1754,7 +1754,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_ma (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty +and parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2371,7 +2371,7 @@ let comparable_comb_witness1 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : +let rec parse_comparable_data : type a. ?type_logger:type_logger -> context -> @@ -2450,7 +2450,7 @@ let comb_witness1 : type t. t ty -> (t, unit -> unit) comb_witness = function - storage after origination *) -let[@coq_axiom_with_reason "gadt"] rec parse_data : +let rec parse_data : type a. ?type_logger:type_logger -> stack_depth:int -> @@ -2934,7 +2934,7 @@ and typecheck_views : in SMap.fold_es aux views ctxt -and[@coq_axiom_with_reason "gadt"] parse_returning : +and parse_returning : type arg ret. ?type_logger:type_logger -> stack_depth:int -> @@ -2983,7 +2983,7 @@ and[@coq_axiom_with_reason "gadt"] parse_returning : : (arg, ret) lambda), ctxt ) -and[@coq_axiom_with_reason "gadt"] parse_instr : +and parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -5390,7 +5390,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : I_OPEN_CHEST; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : +and parse_contract : type arg. stack_depth:int -> legacy:bool -> @@ -5762,7 +5762,7 @@ let parse_storage : storage_type (root storage)) -let[@coq_axiom_with_reason "gadt"] parse_script : +let parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5932,7 +5932,7 @@ let comb_witness2 : type t. t ty -> (t, unit -> unit -> unit) comb_witness = | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_data : +let rec unparse_data : type a. context -> stack_depth:int -> @@ -6123,7 +6123,7 @@ and unparse_items : ([], ctxt) items -and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = +and unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -6461,7 +6461,7 @@ let rec has_lazy_storage : type t. t ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode +let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a. @@ -6573,7 +6573,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : +let rec fold_lazy_storage : type a error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -6638,7 +6638,7 @@ let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : fix injectivity of types *) assert false -let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = +let collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -6648,7 +6648,7 @@ let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode +let extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6723,7 +6723,7 @@ let parse_ty = parse_ty ~stack_depth:0 let ty_eq ctxt = ty_eq ~legacy:true ctxt -let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = +let get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_012_Psithaca/lib_protocol/script_repr.ml b/src/proto_012_Psithaca/lib_protocol/script_repr.ml index c286e56f90874..9a4894001f8f4 100644 --- a/src/proto_012_Psithaca/lib_protocol/script_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/script_repr.ml @@ -119,7 +119,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = + let rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -314,7 +314,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let[@coq_struct "node"] rec strip_annotations node = +let rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -332,7 +332,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes +and micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_012_Psithaca/lib_protocol/seed_repr.ml b/src/proto_012_Psithaca/lib_protocol/seed_repr.ml index ea1c28351d311..1e2ace7a2cba6 100644 --- a/src/proto_012_Psithaca/lib_protocol/seed_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/seed_repr.ml @@ -143,7 +143,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = nonce seed zero_bytes let initial_seeds n = - let[@coq_struct "i"] rec loop acc elt i = + let rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_012_Psithaca/lib_protocol/storage_description.ml b/src/proto_012_Psithaca/lib_protocol/storage_description.ml index 7bac72c5a9690..807ce41e32664 100644 --- a/src/proto_012_Psithaca/lib_protocol/storage_description.ml +++ b/src/proto_012_Psithaca/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let[@coq_struct "function_parameter"] rec pp : +let rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let[@coq_struct "function_parameter"] rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and[@coq_mutual_as_notation] pp_item : +and pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_012_Psithaca/lib_protocol/tez_repr.ml b/src/proto_012_Psithaca/lib_protocol/tez_repr.ml index 5636b07a16f09..fc2d6518d2902 100644 --- a/src/proto_012_Psithaca/lib_protocol/tez_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/tez_repr.ml @@ -88,7 +88,7 @@ let of_string s = let pp ppf amount = let mult_int = 1_000_000L in - let[@coq_struct "amount"] rec left ppf amount = + let rec left ppf amount = let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r diff --git a/src/proto_013_PtJakart/lib_plugin/plugin.ml b/src/proto_013_PtJakart/lib_plugin/plugin.ml index d0490cc0ba9d9..b64b4e653c961 100644 --- a/src/proto_013_PtJakart/lib_plugin/plugin.ml +++ b/src/proto_013_PtJakart/lib_plugin/plugin.ml @@ -3498,7 +3498,7 @@ module RPC = struct return (Tx_rollup_withdraw_list_hash.hash_uncarbonated withdrawals)) module Manager = struct - let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_013_PtJakart/lib_protocol/apply.ml b/src/proto_013_PtJakart/lib_protocol/apply.ml index dd33934423cdf..dce3a7c7e5ff7 100644 --- a/src/proto_013_PtJakart/lib_protocol/apply.ml +++ b/src/proto_013_PtJakart/lib_protocol/apply.ml @@ -1781,7 +1781,7 @@ let apply_external_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let[@coq_struct "ctxt"] rec apply ctxt applied worklist = + let rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Script_typed_ir.Internal_operation ({source; operation; nonce} as op) @@ -1826,7 +1826,7 @@ let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = let precheck_manager_contents (type kind) ctxt (op : kind Kind.manager contents) ~(only_batch : bool) : (context * precheck_result) tzresult Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; fee; @@ -2140,7 +2140,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_manager_operation_result list) Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; operation; @@ -2225,7 +2225,7 @@ let rec mark_skipped : kind Kind.manager prechecked_contents_list -> kind Kind.manager contents_result_list = fun ~payload_producer level prechecked_contents_list -> - match[@coq_match_with_default] prechecked_contents_list with + match prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation {operation; _}; @@ -2271,7 +2271,7 @@ let check_counters_consistency contents_list = type kind. counter option -> kind Kind.manager contents_list -> unit tzresult Lwt.t = fun previous_counter contents_list -> - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Manager_operation {counter; _}) -> check_counter ~previous_counter counter | Cons (Manager_operation {counter; _}, rest) -> @@ -2327,7 +2327,7 @@ let find_manager_public_key ctxt (op : _ Kind.manager contents_list) = (Signature.public_key_hash * Signature.public_key option) option -> (Signature.public_key_hash * Signature.public_key option) tzresult = fun contents_list manager -> - let source (type kind) = function[@coq_match_with_default] + let source (type kind) = function | (Manager_operation {source; operation = Reveal key; _} : kind Kind.manager contents) -> (source, Some key) @@ -2359,7 +2359,7 @@ let rec apply_manager_contents_list_rec : (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = fun ctxt mode ~payload_producer chain_id prechecked_contents_list -> let level = Level.current ctxt in - match[@coq_match_with_default] prechecked_contents_list with + match prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation _ as op; @@ -2902,7 +2902,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_013_PtJakart/lib_protocol/apply_results.ml b/src/proto_013_PtJakart/lib_protocol/apply_results.ml index 065e5d6c4f0c0..bb81cc319a32d 100644 --- a/src/proto_013_PtJakart/lib_protocol/apply_results.ml +++ b/src/proto_013_PtJakart/lib_protocol/apply_results.ml @@ -333,7 +333,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; select; proj; inj; t} - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -352,7 +352,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] transaction_contract_variant_cases = + let transaction_contract_variant_cases = union [ case @@ -451,7 +451,7 @@ module Manager_result = struct }); ] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding:transaction_contract_variant_cases @@ -462,7 +462,7 @@ module Manager_result = struct ~proj:(function Transaction_result x -> x) ~inj:(fun x -> Transaction_result x) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -514,7 +514,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -565,7 +565,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function[@coq_match_with_default] + ~proj:(function | Delegation_result {consumed_gas} -> (Gas.Arith.ceil consumed_gas, consumed_gas)) ~inj:(fun (consumed_gas, consumed_milligas) -> @@ -592,7 +592,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Set_deposits_limit_result {consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_origination_case ~encoding: @@ -627,7 +627,7 @@ module Manager_result = struct originated_tx_rollup; }) - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_submit_batch_case ~encoding: @@ -662,7 +662,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_commit_case ~encoding: @@ -683,7 +683,7 @@ module Manager_result = struct Tx_rollup_commit_result {balance_updates; consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_return_bond_case ~encoding: @@ -705,7 +705,7 @@ module Manager_result = struct Tx_rollup_return_bond_result {balance_updates; consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_finalize_commitment_case @@ -731,7 +731,7 @@ module Manager_result = struct Tx_rollup_finalize_commitment_result {balance_updates; consumed_gas = consumed_milligas; level}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_remove_commitment_case @@ -757,7 +757,7 @@ module Manager_result = struct Tx_rollup_remove_commitment_result {balance_updates; consumed_gas = consumed_milligas; level}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_rejection_case ~encoding: @@ -779,7 +779,7 @@ module Manager_result = struct Tx_rollup_rejection_result {balance_updates; consumed_gas = consumed_milligas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_dispatch_tickets_case @@ -816,7 +816,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = make ~op_case:Operation.Encoding.Manager_operations.transfer_ticket_case ~encoding: @@ -850,7 +850,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_originate_case ~encoding: @@ -961,7 +961,7 @@ module Internal_result = struct -> 'kind case [@@coq_force_gadt] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { tag = Operation.Encoding.Manager_operations.transaction_tag; @@ -1004,7 +1004,7 @@ module Internal_result = struct Transaction {amount; destination; parameters; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { tag = Operation.Encoding.Manager_operations.origination_tag; @@ -1030,7 +1030,7 @@ module Internal_result = struct Origination {credit; delegate; script}); } - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { tag = Operation.Encoding.Manager_operations.delegation_tag; @@ -1283,7 +1283,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let[@coq_axiom_with_reason "gadt"] preendorsement_case = + let preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -1311,7 +1311,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let[@coq_axiom_with_reason "gadt"] endorsement_case = + let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -1336,7 +1336,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -1355,7 +1355,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = + let double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -1375,7 +1375,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case = + let double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -1396,7 +1396,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -1415,7 +1415,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -1434,7 +1434,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -1450,7 +1450,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -1466,7 +1466,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) + let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -1547,7 +1547,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -1557,7 +1557,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -1567,7 +1567,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -1577,7 +1577,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1587,7 +1587,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1599,7 +1599,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1610,7 +1610,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = make_manager_case Operation.Encoding.tx_rollup_origination_case Manager_result.tx_rollup_origination_case @@ -1621,7 +1621,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make_manager_case Operation.Encoding.tx_rollup_submit_batch_case Manager_result.tx_rollup_submit_batch_case @@ -1632,7 +1632,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = make_manager_case Operation.Encoding.tx_rollup_commit_case Manager_result.tx_rollup_commit_case @@ -1643,7 +1643,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make_manager_case Operation.Encoding.tx_rollup_return_bond_case Manager_result.tx_rollup_return_bond_case @@ -1654,7 +1654,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make_manager_case Operation.Encoding.tx_rollup_finalize_commitment_case Manager_result.tx_rollup_finalize_commitment_case @@ -1666,7 +1666,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make_manager_case Operation.Encoding.tx_rollup_remove_commitment_case Manager_result.tx_rollup_remove_commitment_case @@ -1678,7 +1678,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = make_manager_case Operation.Encoding.tx_rollup_rejection_case Manager_result.tx_rollup_rejection_case @@ -1689,7 +1689,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make_manager_case Operation.Encoding.tx_rollup_dispatch_tickets_case Manager_result.tx_rollup_dispatch_tickets_case @@ -1701,7 +1701,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = make_manager_case Operation.Encoding.transfer_ticket_case Manager_result.transfer_ticket_case @@ -1712,7 +1712,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = make_manager_case Operation.Encoding.sc_rollup_originate_case Manager_result.sc_rollup_originate_case @@ -1723,7 +1723,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = make_manager_case Operation.Encoding.sc_rollup_add_messages_case Manager_result.sc_rollup_add_messages_case @@ -1734,7 +1734,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = + let sc_rollup_cement_case = make_manager_case Operation.Encoding.sc_rollup_cement_case Manager_result.sc_rollup_cement_case @@ -1745,7 +1745,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = + let sc_rollup_publish_case = make_manager_case Operation.Encoding.sc_rollup_publish_case Manager_result.sc_rollup_publish_case @@ -2504,7 +2504,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : +let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_013_PtJakart/lib_protocol/contract_repr.ml b/src/proto_013_PtJakart/lib_protocol/contract_repr.ml index 5b57f87e18449..09cdc7a5ee7fb 100644 --- a/src/proto_013_PtJakart/lib_protocol/contract_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/contract_repr.ml @@ -151,7 +151,7 @@ let originated_contracts (Origination_nonce.{origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let[@coq_struct "origination_index"] rec contracts acc origination_index = + let rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_013_PtJakart/lib_protocol/contract_services.ml b/src/proto_013_PtJakart/lib_protocol/contract_services.ml index f60675624690c..23010c3e5b2ff 100644 --- a/src/proto_013_PtJakart/lib_protocol/contract_services.ml +++ b/src/proto_013_PtJakart/lib_protocol/contract_services.ml @@ -285,7 +285,7 @@ module S = struct end end -let[@coq_axiom_with_reason "gadt"] register () = +let register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field ~chunked s f = diff --git a/src/proto_013_PtJakart/lib_protocol/level_storage.ml b/src/proto_013_PtJakart/lib_protocol/level_storage.ml index 526e64e963887..306d9f5acdad4 100644 --- a/src/proto_013_PtJakart/lib_protocol/level_storage.ml +++ b/src/proto_013_PtJakart/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_013_PtJakart/lib_protocol/main.ml b/src/proto_013_PtJakart/lib_protocol/main.ml index e4a4230232a2d..e0aebe7d13a7c 100644 --- a/src/proto_013_PtJakart/lib_protocol/main.ml +++ b/src/proto_013_PtJakart/lib_protocol/main.ml @@ -683,7 +683,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match[@coq_match_with_default] (op1.contents, op2.contents) with + match (op1.contents, op2.contents) with | (Single (Preendorsement _), Single (Preendorsement _)) -> 0 | (Single (Preendorsement _), _) -> -1 | (_, Single (Preendorsement _)) -> 1 diff --git a/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml b/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml index b85b7ea065986..de1a5ef6e2cb0 100644 --- a/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml @@ -230,7 +230,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let[@coq_struct "a_value"] rec for_all a b f = + let rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_013_PtJakart/lib_protocol/misc.ml b/src/proto_013_PtJakart/lib_protocol/misc.ml index bd350a5ef85b2..d7c95b87aa3c4 100644 --- a/src/proto_013_PtJakart/lib_protocol/misc.ml +++ b/src/proto_013_PtJakart/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let[@coq_struct "i"] rec ( --> ) i j = +let rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let[@coq_struct "j"] rec ( <-- ) i j = +let rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let[@coq_struct "i"] rec ( ---> ) i j = +let rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_013_PtJakart/lib_protocol/operation_repr.ml b/src/proto_013_PtJakart/lib_protocol/operation_repr.ml index dec9abba76d0d..cb9c3b1c7d761 100644 --- a/src/proto_013_PtJakart/lib_protocol/operation_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/operation_repr.ml @@ -506,7 +506,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = MCase { tag = 0; @@ -519,7 +519,7 @@ module Encoding = struct let transaction_tag = 1 - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { tag = transaction_tag; @@ -558,7 +558,7 @@ module Encoding = struct let origination_tag = 2 - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { tag = origination_tag; @@ -581,7 +581,7 @@ module Encoding = struct let delegation_tag = 3 - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { tag = delegation_tag; @@ -593,7 +593,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = MCase { tag = 4; @@ -606,7 +606,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = MCase { tag = 5; @@ -619,7 +619,7 @@ module Encoding = struct inj = (fun key -> Set_deposits_limit key); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = MCase { tag = tx_rollup_operation_origination_tag; @@ -638,7 +638,7 @@ module Encoding = struct encoding which is in hexadecimal for JSON. *) conv Bytes.of_string Bytes.to_string bytes - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = MCase { tag = tx_rollup_operation_submit_batch_tag; @@ -660,7 +660,7 @@ module Encoding = struct Tx_rollup_submit_batch {tx_rollup; content; burn_limit}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = MCase { tag = tx_rollup_operation_commit_tag; @@ -680,7 +680,7 @@ module Encoding = struct Tx_rollup_commit {tx_rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = MCase { tag = tx_rollup_operation_return_bond_tag; @@ -693,7 +693,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_return_bond {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = MCase { tag = tx_rollup_operation_finalize_commitment_tag; @@ -708,7 +708,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_finalize_commitment {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = MCase { tag = tx_rollup_operation_remove_commitment_tag; @@ -723,7 +723,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_remove_commitment {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = MCase { tag = tx_rollup_operation_rejection_tag; @@ -802,7 +802,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = MCase { tag = tx_rollup_operation_dispatch_tickets_tag; @@ -858,7 +858,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = MCase { tag = transfer_ticket_tag; @@ -885,7 +885,7 @@ module Encoding = struct {contents; ty; ticketer; amount; destination; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = MCase { tag = sc_rollup_operation_origination_tag; @@ -904,7 +904,7 @@ module Encoding = struct (fun (kind, boot_sector) -> Sc_rollup_originate {kind; boot_sector}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = MCase { tag = sc_rollup_operation_add_message_tag; @@ -924,7 +924,7 @@ module Encoding = struct Sc_rollup_add_messages {rollup; messages}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = + let sc_rollup_cement_case = MCase { tag = sc_rollup_operation_cement_tag; @@ -943,7 +943,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_cement {rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = + let sc_rollup_publish_case = MCase { tag = sc_rollup_operation_publish_tag; @@ -1028,7 +1028,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun [@coq_match_with_default] (Endorsement consensus_content) -> + (fun (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -1038,7 +1038,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let[@coq_axiom_with_reason "gadt"] endorsement_encoding = + let endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -1060,7 +1060,7 @@ module Encoding = struct @@ union [make endorsement_case])) (varopt "signature" Signature.encoding))) - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { tag = 1; @@ -1076,7 +1076,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case : + let double_preendorsement_evidence_case : Kind.double_preendorsement_evidence case = Case { @@ -1094,7 +1094,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -1112,7 +1112,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { tag = 3; @@ -1128,7 +1128,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { tag = 4; @@ -1147,7 +1147,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { tag = 5; @@ -1167,7 +1167,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { tag = 6; @@ -1197,7 +1197,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function[@coq_match_with_default] Failing_noop message -> message); + (function Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -1210,7 +1210,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function[@coq_match_with_default] + function | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -1219,7 +1219,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) + let make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml b/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml index 167f75f1f913b..186f0359ad799 100644 --- a/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml +++ b/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let[@coq_struct "height"] rec insert ctx id node height pos cms = + let rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height + let rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let[@coq_struct "pos"] rec aux acc pos = + let rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let[@coq_struct "pos"] rec aux ctx pos = + let rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml b/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml index 1c99eb32003dd..2d5b7e0fdd7b7 100644 --- a/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml +++ b/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml @@ -334,7 +334,7 @@ let serialize_ty_for_error ty = *) unparse_ty_uncarbonated ~loc:() ty |> Micheline.strip_locations -let[@coq_axiom_with_reason "gadt"] rec comparable_ty_of_ty : +let rec comparable_ty_of_ty : type a ac. context -> Script.location -> @@ -596,7 +596,7 @@ let comparable_comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : +let rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -1090,7 +1090,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] + | Ok _ as ok_memo_size -> ok_memo_size | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -1099,7 +1099,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : type ex_comparable_ty = | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty -let[@coq_struct "ty"] rec parse_comparable_ty : +let rec parse_comparable_ty : stack_depth:int -> context -> Script.node -> @@ -1249,7 +1249,7 @@ type ('ret, 'name) parse_ty_ret = | Parse_entrypoints : (ex_parameter_ty_and_entrypoints_node, Entrypoint.t option) parse_ty_ret -let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty : +let rec parse_ty : type ret name. context -> stack_depth:int -> @@ -1589,7 +1589,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty T_tx_rollup_l2_address; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passable_ty : +and parse_passable_ty : type ret name. context -> stack_depth:int -> @@ -1607,7 +1607,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passab ~allow_contract:true ~allow_ticket:true -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty +and parse_any_ty : context -> stack_depth:int -> @@ -1625,7 +1625,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty ~allow_ticket:true ~ret:Don't_parse_entrypoints -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty +and parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1643,7 +1643,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_ma (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty +and parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2434,7 +2434,7 @@ let comparable_comb_witness1 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : +let rec parse_comparable_data : type a. ?type_logger:type_logger -> context -> @@ -2514,7 +2514,7 @@ let comb_witness1 : type t tc. (t, tc) ty -> (t, unit -> unit) comb_witness = - storage after origination *) -let[@coq_axiom_with_reason "gadt"] rec parse_data : +let rec parse_data : type a ac. ?type_logger:type_logger -> stack_depth:int -> @@ -3039,7 +3039,7 @@ and parse_views : in Script_map.map_es_in_context aux ctxt views -and[@coq_axiom_with_reason "gadt"] parse_returning : +and parse_returning : type arg argc ret retc. ?type_logger:type_logger -> stack_depth:int -> @@ -3081,7 +3081,7 @@ and[@coq_axiom_with_reason "gadt"] parse_returning : : (arg, ret) lambda), ctxt ) -and[@coq_axiom_with_reason "gadt"] parse_instr : +and parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -5122,7 +5122,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : I_OPEN_CHEST; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : +and parse_contract : type arg argc. stack_depth:int -> context -> @@ -5504,7 +5504,7 @@ let parse_storage : storage_type (root storage)) -let[@coq_axiom_with_reason "gadt"] parse_script : +let parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5658,7 +5658,7 @@ let comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_data : +let rec unparse_data : type a ac. context -> stack_depth:int -> @@ -5863,7 +5863,7 @@ and unparse_items : ([], ctxt) items -and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = +and unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -6247,7 +6247,7 @@ let rec has_lazy_storage : type t tc. (t, tc) ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode +let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a ac. @@ -6359,7 +6359,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : +let rec fold_lazy_storage : type a ac error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -6418,7 +6418,7 @@ let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : m (ok (Fold_lazy_storage.Ok init, ctxt)) -let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = +let collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -6428,7 +6428,7 @@ let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode +let extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6504,7 +6504,7 @@ let parse_ty = parse_ty ~stack_depth:0 ~ret:Don't_parse_entrypoints let parse_parameter_ty_and_entrypoints = parse_parameter_ty_and_entrypoints ~stack_depth:0 -let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = +let get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_013_PtJakart/lib_protocol/script_repr.ml b/src/proto_013_PtJakart/lib_protocol/script_repr.ml index 681d6d7c627a5..81e8474d5fd6e 100644 --- a/src/proto_013_PtJakart/lib_protocol/script_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/script_repr.ml @@ -117,7 +117,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = + let rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -312,7 +312,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let[@coq_struct "node"] rec strip_annotations node = +let rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -330,7 +330,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes +and micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_013_PtJakart/lib_protocol/seed_repr.ml b/src/proto_013_PtJakart/lib_protocol/seed_repr.ml index b9f6d85160c85..f8a136e9d26ed 100644 --- a/src/proto_013_PtJakart/lib_protocol/seed_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/seed_repr.ml @@ -153,7 +153,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = nonce seed zero_bytes let initial_seeds ?initial_seed n = - let[@coq_struct "i"] rec loop acc elt i = + let rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_013_PtJakart/lib_protocol/storage_description.ml b/src/proto_013_PtJakart/lib_protocol/storage_description.ml index 7bac72c5a9690..807ce41e32664 100644 --- a/src/proto_013_PtJakart/lib_protocol/storage_description.ml +++ b/src/proto_013_PtJakart/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let[@coq_struct "function_parameter"] rec pp : +let rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let[@coq_struct "function_parameter"] rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and[@coq_mutual_as_notation] pp_item : +and pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_013_PtJakart/lib_protocol/tez_repr.ml b/src/proto_013_PtJakart/lib_protocol/tez_repr.ml index e80c732071c53..a1663546ab210 100644 --- a/src/proto_013_PtJakart/lib_protocol/tez_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/tez_repr.ml @@ -97,7 +97,7 @@ let of_string s = let pp ppf (Tez_tag amount) = let mult_int = 1_000_000L in - let[@coq_struct "amount"] rec left ppf amount = + let rec left ppf amount = let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index dd9c58546ded1..9fa6037840732 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -2324,7 +2324,7 @@ module Forge = struct return (Tx_rollup_withdraw_list_hash.hash_uncarbonated withdrawals)) module Manager = struct - let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 3462c7fb0d97a..0a5def747fdca 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1884,7 +1884,7 @@ let apply_external_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let[@coq_struct "ctxt"] rec apply ctxt applied worklist = + let rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Script_typed_ir.Internal_operation ({source; operation; nonce} as op) @@ -2146,7 +2146,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_manager_operation_result list) Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; operation; @@ -2864,7 +2864,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index 824c7b4bdeef6..0559065ddff7b 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -274,7 +274,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; select; proj; inj; t} - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -287,7 +287,7 @@ module Manager_result = struct ~proj:(function Reveal_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Reveal_result {consumed_gas}) - let[@coq_axiom_with_reason "gadt"] transaction_contract_variant_cases = + let transaction_contract_variant_cases = union [ case @@ -400,7 +400,7 @@ module Manager_result = struct (fun consumed_gas -> Transaction_to_event_result {consumed_gas}); ] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding:transaction_contract_variant_cases @@ -411,7 +411,7 @@ module Manager_result = struct ~proj:(function Transaction_result x -> x) ~inj:(fun x -> Transaction_result x) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -464,7 +464,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -498,7 +498,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function[@coq_match_with_default] + ~proj:(function | Delegation_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Delegation_result {consumed_gas}) @@ -517,7 +517,7 @@ module Manager_result = struct | Set_deposits_limit_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Set_deposits_limit_result {consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_origination_case ~encoding: @@ -539,7 +539,7 @@ module Manager_result = struct Tx_rollup_origination_result {balance_updates; consumed_gas; originated_tx_rollup}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_submit_batch_case ~encoding: @@ -561,7 +561,7 @@ module Manager_result = struct Tx_rollup_submit_batch_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_commit_case ~encoding: @@ -579,7 +579,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_commit_result {balance_updates; consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_return_bond_case ~encoding: @@ -598,7 +598,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_return_bond_result {balance_updates; consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_finalize_commitment_case @@ -622,7 +622,7 @@ module Manager_result = struct Tx_rollup_finalize_commitment_result {balance_updates; consumed_gas; level}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_remove_commitment_case @@ -646,7 +646,7 @@ module Manager_result = struct Tx_rollup_remove_commitment_result {balance_updates; consumed_gas; level}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_rejection_case ~encoding: @@ -665,7 +665,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_rejection_result {balance_updates; consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_dispatch_tickets_case @@ -689,7 +689,7 @@ module Manager_result = struct Tx_rollup_dispatch_tickets_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = make ~op_case:Operation.Encoding.Manager_operations.transfer_ticket_case ~encoding: @@ -710,7 +710,7 @@ module Manager_result = struct Transfer_ticket_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = + let dal_publish_slot_header_case = make ~op_case: Operation.Encoding.Manager_operations.dal_publish_slot_header_case @@ -725,7 +725,7 @@ module Manager_result = struct ~kind:Kind.Dal_publish_slot_header_manager_kind ~inj:(fun consumed_gas -> Dal_publish_slot_header_result {consumed_gas}) - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_originate_case ~encoding: @@ -863,7 +863,7 @@ module Manager_result = struct Sc_rollup_execute_outbox_message_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_recover_bond_case ~encoding: @@ -1101,7 +1101,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let[@coq_axiom_with_reason "gadt"] preendorsement_case = + let preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -1129,7 +1129,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let[@coq_axiom_with_reason "gadt"] endorsement_case = + let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -1154,7 +1154,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let[@coq_axiom_with_reason "gadt"] dal_slot_availability_case = + let dal_slot_availability_case = Case { op_case = Operation.Encoding.dal_slot_availability_case; @@ -1172,7 +1172,7 @@ module Encoding = struct inj = (fun delegate -> Dal_slot_availability_result {delegate}); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -1229,7 +1229,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case = + let double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -1250,7 +1250,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -1269,7 +1269,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -1288,7 +1288,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -1304,7 +1304,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -1320,7 +1320,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) + let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -1403,7 +1403,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -1413,7 +1413,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -1423,7 +1423,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -1433,7 +1433,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1443,7 +1443,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1455,7 +1455,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1466,7 +1466,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = make_manager_case Operation.Encoding.tx_rollup_origination_case Manager_result.tx_rollup_origination_case @@ -1477,7 +1477,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make_manager_case Operation.Encoding.tx_rollup_submit_batch_case Manager_result.tx_rollup_submit_batch_case @@ -1488,7 +1488,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = make_manager_case Operation.Encoding.tx_rollup_commit_case Manager_result.tx_rollup_commit_case @@ -1499,7 +1499,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make_manager_case Operation.Encoding.tx_rollup_return_bond_case Manager_result.tx_rollup_return_bond_case @@ -1510,7 +1510,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make_manager_case Operation.Encoding.tx_rollup_finalize_commitment_case Manager_result.tx_rollup_finalize_commitment_case @@ -1522,7 +1522,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make_manager_case Operation.Encoding.tx_rollup_remove_commitment_case Manager_result.tx_rollup_remove_commitment_case @@ -1534,7 +1534,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = make_manager_case Operation.Encoding.tx_rollup_rejection_case Manager_result.tx_rollup_rejection_case @@ -1545,7 +1545,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make_manager_case Operation.Encoding.tx_rollup_dispatch_tickets_case Manager_result.tx_rollup_dispatch_tickets_case @@ -1557,7 +1557,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = make_manager_case Operation.Encoding.transfer_ticket_case Manager_result.transfer_ticket_case @@ -1568,7 +1568,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = + let dal_publish_slot_header_case = make_manager_case Operation.Encoding.dal_publish_slot_header_case Manager_result.dal_publish_slot_header_case @@ -1580,7 +1580,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = make_manager_case Operation.Encoding.sc_rollup_originate_case Manager_result.sc_rollup_originate_case @@ -1591,7 +1591,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = make_manager_case Operation.Encoding.sc_rollup_add_messages_case Manager_result.sc_rollup_add_messages_case @@ -1602,7 +1602,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = + let sc_rollup_cement_case = make_manager_case Operation.Encoding.sc_rollup_cement_case Manager_result.sc_rollup_cement_case @@ -1613,7 +1613,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = + let sc_rollup_publish_case = make_manager_case Operation.Encoding.sc_rollup_publish_case Manager_result.sc_rollup_publish_case @@ -1624,7 +1624,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_refute_case = + let sc_rollup_refute_case = make_manager_case Operation.Encoding.sc_rollup_refute_case Manager_result.sc_rollup_refute_case @@ -1635,7 +1635,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_timeout_case = + let sc_rollup_timeout_case = make_manager_case Operation.Encoding.sc_rollup_timeout_case Manager_result.sc_rollup_timeout_case @@ -1646,7 +1646,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_execute_outbox_message_case = + let sc_rollup_execute_outbox_message_case = make_manager_case Operation.Encoding.sc_rollup_execute_outbox_message_case Manager_result.sc_rollup_execute_outbox_message_case @@ -1658,7 +1658,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = make_manager_case Operation.Encoding.sc_rollup_recover_bond_case Manager_result.sc_rollup_recover_bond_case @@ -2618,7 +2618,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : +let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_alpha/lib_protocol/contract_repr.ml b/src/proto_alpha/lib_protocol/contract_repr.ml index 20045646df690..155115572d078 100644 --- a/src/proto_alpha/lib_protocol/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/contract_repr.ml @@ -190,7 +190,7 @@ let originated_contracts (Origination_nonce.{origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let[@coq_struct "origination_index"] rec contracts acc origination_index = + let rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index 1d18c7117acf7..ab2f9660c8c3e 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -290,7 +290,7 @@ module S = struct end end -let[@coq_axiom_with_reason "gadt"] register () = +let register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field_gen ~filter_contract ~wrap_result ~chunked s f = diff --git a/src/proto_alpha/lib_protocol/level_storage.ml b/src/proto_alpha/lib_protocol/level_storage.ml index 852e8a84899b9..952c50ec33759 100644 --- a/src/proto_alpha/lib_protocol/level_storage.ml +++ b/src/proto_alpha/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 12ee15cff4cf3..5ab45236477ae 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -720,7 +720,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match[@coq_match_with_default] (op1.contents, op2.contents) with + match (op1.contents, op2.contents) with | Single (Preendorsement _), Single (Preendorsement _) -> 0 | Single (Preendorsement _), _ -> -1 | _, Single (Preendorsement _) -> 1 diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index abbad29046c1d..dafe0f448ee7f 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -232,7 +232,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let[@coq_struct "a_value"] rec for_all a b f = + let rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_alpha/lib_protocol/misc.ml b/src/proto_alpha/lib_protocol/misc.ml index bd350a5ef85b2..d7c95b87aa3c4 100644 --- a/src/proto_alpha/lib_protocol/misc.ml +++ b/src/proto_alpha/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let[@coq_struct "i"] rec ( --> ) i j = +let rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let[@coq_struct "j"] rec ( <-- ) i j = +let rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let[@coq_struct "i"] rec ( ---> ) i j = +let rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml index 5501508072a0b..0f2fad3891903 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/operation_repr.ml @@ -601,7 +601,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = MCase { tag = 0; @@ -612,7 +612,7 @@ module Encoding = struct inj = (fun pkh -> Reveal pkh); } - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { tag = 1; @@ -649,7 +649,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { tag = 2; @@ -670,7 +670,7 @@ module Encoding = struct Origination {credit; delegate; script}); } - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { tag = 3; @@ -682,7 +682,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = MCase { tag = 4; @@ -695,7 +695,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = MCase { tag = 5; @@ -708,7 +708,7 @@ module Encoding = struct inj = (fun key -> Set_deposits_limit key); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = MCase { tag = tx_rollup_operation_origination_tag; @@ -727,7 +727,7 @@ module Encoding = struct encoding which is in hexadecimal for JSON. *) conv Bytes.of_string Bytes.to_string bytes - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = MCase { tag = tx_rollup_operation_submit_batch_tag; @@ -749,7 +749,7 @@ module Encoding = struct Tx_rollup_submit_batch {tx_rollup; content; burn_limit}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = MCase { tag = tx_rollup_operation_commit_tag; @@ -769,7 +769,7 @@ module Encoding = struct Tx_rollup_commit {tx_rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = MCase { tag = tx_rollup_operation_return_bond_tag; @@ -782,7 +782,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_return_bond {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = MCase { tag = tx_rollup_operation_finalize_commitment_tag; @@ -797,7 +797,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_finalize_commitment {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = MCase { tag = tx_rollup_operation_remove_commitment_tag; @@ -812,7 +812,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_remove_commitment {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = MCase { tag = tx_rollup_operation_rejection_tag; @@ -891,7 +891,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = MCase { tag = tx_rollup_operation_dispatch_tickets_tag; @@ -947,7 +947,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = MCase { tag = transfer_ticket_tag; @@ -974,7 +974,7 @@ module Encoding = struct {contents; ty; ticketer; amount; destination; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = MCase { tag = sc_rollup_operation_origination_tag; @@ -996,7 +996,7 @@ module Encoding = struct Sc_rollup_originate {kind; boot_sector; parameters_ty}); } - let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = + let dal_publish_slot_header_case = MCase { tag = dal_publish_slot_header_tag; @@ -1009,7 +1009,7 @@ module Encoding = struct inj = (fun slot -> Dal_publish_slot_header {slot}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = MCase { tag = sc_rollup_operation_add_message_tag; @@ -1029,7 +1029,7 @@ module Encoding = struct Sc_rollup_add_messages {rollup; messages}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = + let sc_rollup_cement_case = MCase { tag = sc_rollup_operation_cement_tag; @@ -1048,7 +1048,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_cement {rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = + let sc_rollup_publish_case = MCase { tag = sc_rollup_operation_publish_tag; @@ -1067,7 +1067,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_publish {rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_refute_case = + let sc_rollup_refute_case = MCase { tag = sc_rollup_operation_refute_tag; @@ -1091,7 +1091,7 @@ module Encoding = struct Sc_rollup_refute {rollup; opponent; refutation}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_timeout_case = + let sc_rollup_timeout_case = MCase { tag = sc_rollup_operation_timeout_tag; @@ -1109,7 +1109,7 @@ module Encoding = struct inj = (fun (rollup, stakers) -> Sc_rollup_timeout {rollup; stakers}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_execute_outbox_message_case = + let sc_rollup_execute_outbox_message_case = MCase { tag = sc_rollup_execute_outbox_message_tag; @@ -1136,7 +1136,7 @@ module Encoding = struct {rollup; cemented_commitment; output_proof}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = MCase { tag = sc_rollup_operation_recover_bond_tag; @@ -1237,7 +1237,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun [@coq_match_with_default] (Endorsement consensus_content) -> + (fun (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -1247,7 +1247,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let[@coq_axiom_with_reason "gadt"] endorsement_encoding = + let endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -1284,7 +1284,7 @@ module Encoding = struct (function | Contents (Dal_slot_availability _ as op) -> Some op | _ -> None); proj = - (fun [@coq_match_with_default] (Dal_slot_availability + (fun (Dal_slot_availability (endorser, endorsement)) -> (endorser, endorsement)); inj = @@ -1292,7 +1292,7 @@ module Encoding = struct Dal_slot_availability (endorser, endorsement)); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { tag = 1; @@ -1338,7 +1338,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -1356,7 +1356,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { tag = 3; @@ -1372,7 +1372,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { tag = 4; @@ -1391,7 +1391,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { tag = 5; @@ -1411,7 +1411,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { tag = 6; @@ -1441,7 +1441,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function[@coq_match_with_default] Failing_noop message -> message); + (function Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -1454,7 +1454,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function[@coq_match_with_default] + function | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -1463,7 +1463,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) + let make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_alpha/lib_protocol/sapling_storage.ml b/src/proto_alpha/lib_protocol/sapling_storage.ml index 3f151b7578472..35ee7c2546a2c 100644 --- a/src/proto_alpha/lib_protocol/sapling_storage.ml +++ b/src/proto_alpha/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let[@coq_struct "height"] rec insert ctx id node height pos cms = + let rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height + let rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let[@coq_struct "pos"] rec aux acc pos = + let rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let[@coq_struct "pos"] rec aux ctx pos = + let rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 15ff0c3512818..dc53f0ffa71e3 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -291,7 +291,7 @@ let serialize_ty_for_error ty = *) unparse_ty_uncarbonated ~loc:() ty |> Micheline.strip_locations -let[@coq_axiom_with_reason "gadt"] check_comparable : +let check_comparable : type a ac. Script.location -> (a, ac) ty -> (ac, Dependent_bool.yes) eq tzresult = fun loc ty -> @@ -521,7 +521,7 @@ let comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : +let rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -938,7 +938,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] + | Ok _ as ok_memo_size -> ok_memo_size | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -970,7 +970,7 @@ type ('ret, 'name) parse_ty_ret = | Parse_entrypoints : (ex_parameter_ty_and_entrypoints_node, Entrypoint.t option) parse_ty_ret -let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty : +let rec parse_ty : type ret name. context -> stack_depth:int -> @@ -1310,7 +1310,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty T_unit; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_comparable_ty +and parse_comparable_ty : context -> stack_depth:int -> @@ -1334,7 +1334,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_compar error (Comparable_type_expected (location node, Micheline.strip_locations node)) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passable_ty : +and parse_passable_ty : type ret name. context -> stack_depth:int -> @@ -1352,7 +1352,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passab ~allow_contract:true ~allow_ticket:true -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty +and parse_any_ty : context -> stack_depth:int -> @@ -1370,7 +1370,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty ~allow_ticket:true ~ret:Don't_parse_entrypoints -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty +and parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1388,7 +1388,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_ma (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty +and parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2306,7 +2306,7 @@ let parse_toplevel : - storage after origination *) -let[@coq_axiom_with_reason "gadt"] rec parse_data : +let rec parse_data : type a ac. ?type_logger:type_logger -> stack_depth:int -> @@ -2829,7 +2829,7 @@ and parse_views : in Script_map.map_es_in_context aux ctxt views -and[@coq_axiom_with_reason "gadt"] parse_returning : +and parse_returning : type arg argc ret retc. ?type_logger:type_logger -> stack_depth:int -> @@ -2872,7 +2872,7 @@ and[@coq_axiom_with_reason "gadt"] parse_returning : : (arg, ret) lambda), ctxt ) -and[@coq_axiom_with_reason "gadt"] parse_instr : +and parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -4854,7 +4854,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : I_XOR; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract_data : +and parse_contract_data : type arg argc. stack_depth:int -> context -> @@ -4886,7 +4886,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contra The inner [result] is turned into an [option] by [parse_contract_for_script]. Both [tzresult] are merged by [parse_contract_data]. *) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : +and parse_contract : type arg argc err. stack_depth:int -> context -> @@ -5128,7 +5128,7 @@ let parse_storage : storage_type (root storage)) -let[@coq_axiom_with_reason "gadt"] parse_script : +let parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5274,7 +5274,7 @@ let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty) (* -- Unparsing data of any type -- *) -let[@coq_axiom_with_reason "gadt"] rec unparse_data : +let rec unparse_data : type a ac. context -> stack_depth:int -> @@ -5478,7 +5478,7 @@ and unparse_items : ([], ctxt) items -and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = +and unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -5797,7 +5797,7 @@ let rec has_lazy_storage : type t tc. (t, tc) ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode +let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a ac. @@ -5909,7 +5909,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : +let rec fold_lazy_storage : type a ac error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -5968,7 +5968,7 @@ let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : m (ok (Fold_lazy_storage.Ok init, ctxt)) -let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = +let collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -5978,7 +5978,7 @@ let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode +let extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6056,7 +6056,7 @@ let parse_ty = parse_ty ~stack_depth:0 ~ret:Don't_parse_entrypoints let parse_parameter_ty_and_entrypoints = parse_parameter_ty_and_entrypoints ~stack_depth:0 -let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = +let get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_alpha/lib_protocol/script_repr.ml b/src/proto_alpha/lib_protocol/script_repr.ml index 681d6d7c627a5..81e8474d5fd6e 100644 --- a/src/proto_alpha/lib_protocol/script_repr.ml +++ b/src/proto_alpha/lib_protocol/script_repr.ml @@ -117,7 +117,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = + let rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -312,7 +312,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let[@coq_struct "node"] rec strip_annotations node = +let rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -330,7 +330,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes +and micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_alpha/lib_protocol/seed_repr.ml b/src/proto_alpha/lib_protocol/seed_repr.ml index 23dc8fe39f521..e0a6df765893d 100644 --- a/src/proto_alpha/lib_protocol/seed_repr.ml +++ b/src/proto_alpha/lib_protocol/seed_repr.ml @@ -215,7 +215,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = update_seed seed zero_bytes let initial_seeds ?initial_seed n = - let[@coq_struct "i"] rec loop acc elt i = + let rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_alpha/lib_protocol/storage_description.ml b/src/proto_alpha/lib_protocol/storage_description.ml index 86aed867ac161..7d5fc23ef679a 100644 --- a/src/proto_alpha/lib_protocol/storage_description.ml +++ b/src/proto_alpha/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let[@coq_struct "function_parameter"] rec pp : +let rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let[@coq_struct "function_parameter"] rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and[@coq_mutual_as_notation] pp_item : +and pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_alpha/lib_protocol/tez_repr.ml b/src/proto_alpha/lib_protocol/tez_repr.ml index 99bbe0b87d09b..2da8256338748 100644 --- a/src/proto_alpha/lib_protocol/tez_repr.ml +++ b/src/proto_alpha/lib_protocol/tez_repr.ml @@ -97,7 +97,7 @@ let of_string s = let pp ppf (Tez_tag amount) = let mult_int = 1_000_000L in - let[@coq_struct "amount"] rec left ppf amount = + let rec left ppf amount = let d, r = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r -- GitLab From 7eae8470f138e303c6c157fd3e5eed4d7381dc50 Mon Sep 17 00:00:00 2001 From: Shubham Date: Tue, 28 Jun 2022 20:38:47 +0530 Subject: [PATCH 2/5] Revert "remove coq attributes" This reverts commit ae7a7d04ba5c2f9e793c8e9c54957a1281cad1c4. --- src/proto_010_PtGRANAD/lib_plugin/plugin.ml | 2 +- .../lib_protocol/apply_results.ml | 34 +++--- src/proto_010_PtGRANAD/lib_protocol/baking.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/michelson_v1_gas.ml | 2 +- .../lib_protocol/operation_repr.ml | 26 ++--- src/proto_011_PtHangz2/lib_plugin/plugin.ml | 2 +- src/proto_011_PtHangz2/lib_protocol/apply.ml | 16 +-- .../lib_protocol/apply_results.ml | 40 +++---- src/proto_011_PtHangz2/lib_protocol/baking.ml | 4 +- .../lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/level_storage.ml | 4 +- src/proto_011_PtHangz2/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_011_PtHangz2/lib_protocol/misc.ml | 4 +- .../lib_protocol/operation_repr.ml | 34 +++--- .../lib_protocol/roll_storage.ml | 12 +- .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 52 ++++----- .../lib_protocol/script_repr.ml | 6 +- .../lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- .../lib_protocol/tez_repr.ml | 2 +- src/proto_012_Psithaca/lib_plugin/plugin.ml | 2 +- src/proto_012_Psithaca/lib_protocol/apply.ml | 16 +-- .../lib_protocol/apply_results.ml | 44 ++++---- .../lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/level_storage.ml | 4 +- src/proto_012_Psithaca/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_012_Psithaca/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 36 +++--- .../lib_protocol/roll_storage_legacy.ml | 10 +- .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 50 ++++----- .../lib_protocol/script_repr.ml | 6 +- .../lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- .../lib_protocol/tez_repr.ml | 2 +- src/proto_013_PtJakart/lib_plugin/plugin.ml | 2 +- src/proto_013_PtJakart/lib_protocol/apply.ml | 16 +-- .../lib_protocol/apply_results.ml | 98 ++++++++-------- .../lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- .../lib_protocol/level_storage.ml | 4 +- src/proto_013_PtJakart/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_013_PtJakart/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 62 +++++----- .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 44 ++++---- .../lib_protocol/script_repr.ml | 6 +- .../lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- .../lib_protocol/tez_repr.ml | 2 +- src/proto_alpha/lib_plugin/RPC.ml | 2 +- src/proto_alpha/lib_protocol/apply.ml | 6 +- src/proto_alpha/lib_protocol/apply_results.ml | 106 +++++++++--------- src/proto_alpha/lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- src/proto_alpha/lib_protocol/level_storage.ml | 4 +- src/proto_alpha/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_alpha/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 72 ++++++------ .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 44 ++++---- src/proto_alpha/lib_protocol/script_repr.ml | 6 +- src/proto_alpha/lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- src/proto_alpha/lib_protocol/tez_repr.ml | 2 +- 73 files changed, 498 insertions(+), 498 deletions(-) diff --git a/src/proto_010_PtGRANAD/lib_plugin/plugin.ml b/src/proto_010_PtGRANAD/lib_plugin/plugin.ml index 46a6e0ee19149..549d3e3c74005 100644 --- a/src/proto_010_PtGRANAD/lib_plugin/plugin.ml +++ b/src/proto_010_PtGRANAD/lib_plugin/plugin.ml @@ -1495,7 +1495,7 @@ module RPC = struct })) module Manager = struct - let operations ctxt block ~branch + let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml b/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml index 666bcfcf77e2c..da0867bd95e9c 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/apply_results.ml @@ -191,7 +191,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; iselect; select; proj; inj; t} - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -217,7 +217,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding: @@ -296,7 +296,7 @@ module Manager_result = struct allocated_destination_contract; }) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -537,7 +537,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let endorsement_case = + let[@coq_axiom_with_reason "gadt"] endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -564,7 +564,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; slots}); } - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -586,7 +586,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let endorsement_with_slot_case = + let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case = Case { op_case = Operation.Encoding.endorsement_with_slot_case; @@ -618,7 +618,7 @@ module Encoding = struct (Endorsement_result {balance_updates; delegate; slots})); } - let double_endorsement_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -640,7 +640,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -662,7 +662,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -684,7 +684,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -702,7 +702,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -720,7 +720,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let make_manager_case (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -810,7 +810,7 @@ module Encoding = struct }); } - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -821,7 +821,7 @@ module Encoding = struct | _ -> None) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -832,7 +832,7 @@ module Encoding = struct | _ -> None) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -843,7 +843,7 @@ module Encoding = struct | _ -> None) - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1169,7 +1169,7 @@ let rec kind_equal_list : | _ -> None -let rec pack_contents_list : +let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_010_PtGRANAD/lib_protocol/baking.ml b/src/proto_010_PtGRANAD/lib_protocol/baking.ml index 6f984c91cb9ee..436a8e8a81e79 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/baking.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/baking.ml @@ -335,7 +335,7 @@ let endorsement_rights ctxt level = (0 --> (Constants.endorsers_per_block ctxt - 1)) Signature.Public_key_hash.Map.empty -let check_endorsement_rights ctxt chain_id ~slot +let[@coq_axiom_with_reason "gadt"] check_endorsement_rights ctxt chain_id ~slot (op : Kind.endorsement Operation.t) = if Compare.Int.(slot < 0 (* should not happen because of binary format *)) diff --git a/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml b/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml index e9898cbf85865..ccc3c887987e1 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/contract_services.ml @@ -256,7 +256,7 @@ module S = struct end end -let register () = +let[@coq_axiom_with_reason "gadt"] register () = let open Services_registration in register0 S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field s f = diff --git a/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml b/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml index 17749e3a26a3b..8c5d185d9f933 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/michelson_v1_gas.ml @@ -1346,7 +1346,7 @@ module Cost_of = struct let compare : type a. a Script_typed_ir.comparable_ty -> a -> a -> cost = fun ty x y -> - let rec compare : + let[@coq_axiom_with_reason "gadt"] rec compare : type a. a Script_typed_ir.comparable_ty -> a -> a -> cost -> cont -> cost = fun ty x y acc k -> diff --git a/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml b/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml index d6fe107639676..5666100d52f22 100644 --- a/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml +++ b/src/proto_010_PtGRANAD/lib_protocol/operation_repr.ml @@ -239,7 +239,7 @@ module Encoding = struct } -> 'kind case - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = MCase { tag = 0; @@ -277,7 +277,7 @@ module Encoding = struct (fun s -> Some s) (fun s -> s) ] - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = MCase { tag = 1; @@ -316,7 +316,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = MCase { tag = 2; @@ -346,7 +346,7 @@ module Encoding = struct Origination {credit; delegate; script; preorigination = None}); } - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = MCase { tag = 3; @@ -401,7 +401,7 @@ module Encoding = struct inj = (fun level -> Endorsement {level}); } - let endorsement_encoding = + let[@coq_axiom_with_reason "gadt"] endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -426,7 +426,7 @@ module Encoding = struct @@ union [make endorsement_case] )) (varopt "signature" Signature.encoding))) - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { tag = 1; @@ -442,7 +442,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let endorsement_with_slot_case : + let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case : Kind.endorsement_with_slot case = Case { @@ -463,7 +463,7 @@ module Encoding = struct Endorsement_with_slot {endorsement; slot}); } - let double_endorsement_evidence_case : + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -488,7 +488,7 @@ module Encoding = struct Double_endorsement_evidence {op1; op2; slot}); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { tag = 3; @@ -504,7 +504,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { tag = 4; @@ -523,7 +523,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { tag = 5; @@ -543,7 +543,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { tag = 6; @@ -594,7 +594,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let make_manager_case tag (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_011_PtHangz2/lib_plugin/plugin.ml b/src/proto_011_PtHangz2/lib_plugin/plugin.ml index 027e8556de352..faa3009e42cf6 100644 --- a/src/proto_011_PtHangz2/lib_plugin/plugin.ml +++ b/src/proto_011_PtHangz2/lib_plugin/plugin.ml @@ -1645,7 +1645,7 @@ module RPC = struct })) module Manager = struct - let operations ctxt block ~branch + let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_011_PtHangz2/lib_protocol/apply.ml b/src/proto_011_PtHangz2/lib_protocol/apply.ml index 9bddb77a03870..ff7568a14b80d 100644 --- a/src/proto_011_PtHangz2/lib_protocol/apply.ml +++ b/src/proto_011_PtHangz2/lib_protocol/apply.ml @@ -801,7 +801,7 @@ let apply_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let rec apply ctxt applied worklist = + let[@coq_struct "ctxt"] rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Internal_operation ({source; operation; nonce} as op) :: rest -> ( @@ -841,7 +841,7 @@ let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = let precheck_manager_contents (type kind) ctxt (op : kind Kind.manager contents) : context tzresult Lwt.t = - let (Manager_operation + let[@coq_match_with_default] (Manager_operation { source; fee; @@ -889,7 +889,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_operation_result list) Lwt.t = - let (Manager_operation + let[@coq_match_with_default] (Manager_operation { source; operation; @@ -954,7 +954,7 @@ let rec mark_skipped : Level.t -> kind Kind.manager contents_list -> kind Kind.manager contents_result_list = - fun ~baker level -> function + fun ~baker level -> function[@coq_match_with_default] | Single (Manager_operation {source; fee; operation; _}) -> let source = Contract.implicit_contract source in Single_result @@ -990,7 +990,7 @@ let rec precheck_manager_contents_list : Alpha_context.t -> kind Kind.manager contents_list -> context tzresult Lwt.t = fun ctxt contents_list -> - match contents_list with + match[@coq_match_with_default] contents_list with | Single (Manager_operation _ as op) -> precheck_manager_contents ctxt op | Cons ((Manager_operation _ as op), rest) -> precheck_manager_contents ctxt op >>=? fun ctxt -> @@ -1019,7 +1019,7 @@ let check_manager_signature ctxt chain_id (op : _ Kind.manager contents_list) (Signature.public_key_hash * Signature.public_key option) option -> (Signature.public_key_hash * Signature.public_key option) tzresult = fun contents_list manager -> - let source (type kind) = function + let source (type kind) = function[@coq_match_with_default] | (Manager_operation {source; operation = Reveal key; _} : kind Kind.manager contents) -> (source, Some key) @@ -1048,7 +1048,7 @@ let rec apply_manager_contents_list_rec : (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = fun ctxt mode baker chain_id contents_list -> let level = Level.current ctxt in - match contents_list with + match[@coq_match_with_default] contents_list with | Single (Manager_operation {source; fee; _} as op) -> let source = Contract.implicit_contract source in apply_manager_contents ctxt mode chain_id op @@ -1162,7 +1162,7 @@ let apply_manager_contents_list ctxt mode baker chain_id contents_list = let apply_contents_list (type kind) ctxt chain_id mode pred_block baker (operation : kind operation) (contents_list : kind contents_list) : (context * kind contents_result_list) tzresult Lwt.t = - match contents_list with + match[@coq_match_with_default] contents_list with | Single (Endorsement_with_slot { diff --git a/src/proto_011_PtHangz2/lib_protocol/apply_results.ml b/src/proto_011_PtHangz2/lib_protocol/apply_results.ml index a4d1f68dbf3e1..efb188f96f79b 100644 --- a/src/proto_011_PtHangz2/lib_protocol/apply_results.ml +++ b/src/proto_011_PtHangz2/lib_protocol/apply_results.ml @@ -197,7 +197,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; iselect; select; proj; inj; t} - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -220,7 +220,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding: @@ -298,7 +298,7 @@ module Manager_result = struct allocated_destination_contract; }) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -366,7 +366,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -412,7 +412,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function + ~proj:(function[@coq_match_with_default] | Delegation_result {consumed_gas} -> (Gas.Arith.ceil consumed_gas, consumed_gas)) ~inj:(fun (consumed_gas, consumed_milligas) -> @@ -562,7 +562,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let endorsement_case = + let[@coq_axiom_with_reason "gadt"] endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -587,7 +587,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; slots}); } - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -605,7 +605,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let endorsement_with_slot_case = + let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case = Case { op_case = Operation.Encoding.endorsement_with_slot_case; @@ -634,7 +634,7 @@ module Encoding = struct (Endorsement_result {balance_updates; delegate; slots})); } - let double_endorsement_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -653,7 +653,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -671,7 +671,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -689,7 +689,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -705,7 +705,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -721,7 +721,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let make_manager_case (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -801,7 +801,7 @@ module Encoding = struct }); } - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -811,7 +811,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -821,7 +821,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -831,7 +831,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -841,7 +841,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1190,7 +1190,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let rec pack_contents_list : +let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_011_PtHangz2/lib_protocol/baking.ml b/src/proto_011_PtHangz2/lib_protocol/baking.ml index 176ea20ff998e..2e6b6c6532e2c 100644 --- a/src/proto_011_PtHangz2/lib_protocol/baking.ml +++ b/src/proto_011_PtHangz2/lib_protocol/baking.ml @@ -185,7 +185,7 @@ let minimal_time_fastpath_case minimal_block_delay pred_timestamp = (* The function implements the slow-path case in [minimal_time]. (See [minimal_valid_time] for the definition of the slow-path.) *) let minimal_time_slowpath_case time_between_blocks priority pred_timestamp = - let rec cumsum_time_between_blocks acc durations p = + let[@coq_struct "durations"] rec cumsum_time_between_blocks acc durations p = if Compare.Int32.( <= ) p 0l then ok acc else match durations with @@ -325,7 +325,7 @@ let endorsement_rights ctxt level = (0 --> (Constants.endorsers_per_block ctxt - 1)) Signature.Public_key_hash.Map.empty -let check_endorsement_right ctxt chain_id ~slot +let[@coq_axiom_with_reason "gadt"] check_endorsement_right ctxt chain_id ~slot (op : Kind.endorsement Operation.t) = if Compare.Int.(slot < 0 (* should not happen because of binary format *)) diff --git a/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml b/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml index d705ed864ca30..07b78e0fd888c 100644 --- a/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/contract_repr.ml @@ -161,7 +161,7 @@ let originated_contracts ({origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let rec contracts acc origination_index = + let[@coq_struct "origination_index"] rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_011_PtHangz2/lib_protocol/contract_services.ml b/src/proto_011_PtHangz2/lib_protocol/contract_services.ml index 8de17bfb7516a..8fb552b10479a 100644 --- a/src/proto_011_PtHangz2/lib_protocol/contract_services.ml +++ b/src/proto_011_PtHangz2/lib_protocol/contract_services.ml @@ -254,7 +254,7 @@ module S = struct end end -let register () = +let[@coq_axiom_with_reason "gadt"] register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field ~chunked s f = diff --git a/src/proto_011_PtHangz2/lib_protocol/level_storage.ml b/src/proto_011_PtHangz2/lib_protocol/level_storage.ml index 551b9ce07fdb8..de01a2f49d5b5 100644 --- a/src/proto_011_PtHangz2/lib_protocol/level_storage.ml +++ b/src/proto_011_PtHangz2/lib_protocol/level_storage.ml @@ -61,7 +61,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -77,7 +77,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_011_PtHangz2/lib_protocol/main.ml b/src/proto_011_PtHangz2/lib_protocol/main.ml index 4cdf7fd9f4466..c68235cff4b09 100644 --- a/src/proto_011_PtHangz2/lib_protocol/main.ml +++ b/src/proto_011_PtHangz2/lib_protocol/main.ml @@ -402,7 +402,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match (op1.contents, op2.contents) with + match[@coq_match_with_default] (op1.contents, op2.contents) with | (Single (Endorsement _), Single (Endorsement _)) -> 0 | (_, Single (Endorsement _)) -> 1 | (Single (Endorsement _), _) -> -1 diff --git a/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml b/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml index 057973a90aa64..5197d0a887afa 100644 --- a/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_011_PtHangz2/lib_protocol/michelson_v1_primitives.ml @@ -226,7 +226,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let rec for_all a b f = + let[@coq_struct "a_value"] rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_011_PtHangz2/lib_protocol/misc.ml b/src/proto_011_PtHangz2/lib_protocol/misc.ml index 4b6b76ad81c4d..6e3d49853380e 100644 --- a/src/proto_011_PtHangz2/lib_protocol/misc.ml +++ b/src/proto_011_PtHangz2/lib_protocol/misc.ml @@ -29,11 +29,11 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let rec ( --> ) i j = +let[@coq_struct "i"] rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let rec ( ---> ) i j = +let[@coq_struct "i"] rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml b/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml index 29541e8d91df6..ed496155628f0 100644 --- a/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/operation_repr.ml @@ -248,7 +248,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = MCase { tag = 0; @@ -288,7 +288,7 @@ module Encoding = struct (fun s -> s); ] - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = MCase { tag = 1; @@ -325,7 +325,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = MCase { tag = 2; @@ -356,7 +356,7 @@ module Encoding = struct Origination {credit; delegate; script; preorigination = None}); } - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = MCase { tag = 3; @@ -368,7 +368,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = MCase { tag = 4; @@ -421,11 +421,11 @@ module Encoding = struct encoding = obj1 (req "level" Raw_level_repr.encoding); select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); - proj = (fun (Endorsement {level}) -> level); + proj = (fun [@coq_match_with_default] (Endorsement {level}) -> level); inj = (fun level -> Endorsement {level}); } - let endorsement_encoding = + let[@coq_axiom_with_reason "gadt"] endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -447,7 +447,7 @@ module Encoding = struct @@ union [make endorsement_case])) (varopt "signature" Signature.encoding))) - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { tag = 1; @@ -463,7 +463,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let endorsement_with_slot_case : + let[@coq_axiom_with_reason "gadt"] endorsement_with_slot_case : Kind.endorsement_with_slot case = Case { @@ -483,7 +483,7 @@ module Encoding = struct (fun (endorsement, slot) -> Endorsement_with_slot {endorsement; slot}); } - let double_endorsement_evidence_case : + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -505,7 +505,7 @@ module Encoding = struct (fun (op1, op2, slot) -> Double_endorsement_evidence {op1; op2; slot}); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { tag = 3; @@ -521,7 +521,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { tag = 4; @@ -540,7 +540,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { tag = 5; @@ -560,7 +560,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { tag = 6; @@ -590,7 +590,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function Failing_noop message -> message); + (function[@coq_match_with_default] Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -603,7 +603,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function + function[@coq_match_with_default] | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -612,7 +612,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let make_manager_case tag (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml b/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml index fede8d640b652..9b872cb49263f 100644 --- a/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml +++ b/src/proto_011_PtHangz2/lib_protocol/roll_storage.ml @@ -105,7 +105,7 @@ let clear_cycle ctxt cycle = let fold ctxt ~f init = Storage.Roll.Next.get ctxt >>=? fun last -> - let rec loop ctxt roll acc = + let[@coq_struct "roll"] rec loop ctxt roll acc = if Roll_repr.(roll = last) then return acc else Storage.Roll.Owner.find ctxt roll >>=? function @@ -185,7 +185,7 @@ let count_rolls ctxt delegate = Storage.Roll.Delegate_roll_list.find ctxt delegate >>=? function | None -> return 0 | Some head_roll -> - let rec loop acc roll = + let[@coq_struct "roll"] rec loop acc roll = Storage.Roll.Successor.find ctxt roll >>=? function | None -> return acc | Some next -> loop (succ acc) next @@ -308,7 +308,7 @@ module Delegate = struct Tez_repr.(amount +? change) >>?= fun change -> Storage.Roll.Delegate_change.update ctxt delegate change >>=? fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> @@ -326,7 +326,7 @@ module Delegate = struct let remove_amount ctxt delegate amount = let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = if Tez_repr.(amount <= change) then return (ctxt, change) else pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) -> @@ -356,7 +356,7 @@ module Delegate = struct (Contract_repr.implicit_contract delegate) >>= fun ctxt -> Storage.Active_delegates_with_rolls.remove ctxt delegate >>= fun ctxt -> - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = Storage.Roll.Delegate_roll_list.find ctxt delegate >>=? function | None -> return (ctxt, change) | Some _roll -> @@ -406,7 +406,7 @@ module Delegate = struct (Contract_repr.implicit_contract delegate) >>= fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> diff --git a/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml b/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml index 186f0359ad799..167f75f1f913b 100644 --- a/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml +++ b/src/proto_011_PtHangz2/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let rec insert ctx id node height pos cms = + let[@coq_struct "height"] rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let rec fold_from_height ctx id node ~pos ~f ~acc height + let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let rec aux acc pos = + let[@coq_struct "pos"] rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let rec aux ctx pos = + let[@coq_struct "pos"] rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml b/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml index 1a53e7f9e3ba8..ca7e23c9b3326 100644 --- a/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml +++ b/src/proto_011_PtHangz2/lib_protocol/script_ir_translator.ml @@ -343,7 +343,7 @@ let rec unparse_ty : type a. context -> a ty -> (Script.node * context) tzresult return ctxt (T_chest_key, [], unparse_type_annot meta.annot) | Chest_t meta -> return ctxt (T_chest, [], unparse_type_annot meta.annot) -let rec strip_var_annots = function +let[@coq_struct "function_parameter"] rec strip_var_annots = function | (Int _ | String _ | Bytes _) as atom -> atom | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args) | Prim (loc, name, args, annots) -> @@ -358,7 +358,7 @@ let serialize_ty_for_error ctxt ty = (Micheline.strip_locations (strip_var_annots ty), ctxt)) |> record_trace Cannot_serialize_error -let rec comparable_ty_of_ty : +let[@coq_axiom_with_reason "gadt"] rec comparable_ty_of_ty : type a. context -> Script.location -> a ty -> (a comparable_ty * context) tzresult = fun ctxt loc ty -> @@ -633,7 +633,7 @@ let comparable_comb_witness2 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_comparable_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : type a. context -> unparsing_mode -> @@ -1257,7 +1257,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size + | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -1266,7 +1266,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : type ex_comparable_ty = | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty -let rec parse_comparable_ty : +let[@coq_struct "ty"] rec parse_comparable_ty : stack_depth:int -> context -> Script.node -> @@ -1395,7 +1395,7 @@ let rec parse_comparable_ty : type ex_ty = Ex_ty : 'a ty -> ex_ty -let rec parse_packable_ty +let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_packable_ty : context -> stack_depth:int -> @@ -1412,7 +1412,7 @@ let rec parse_packable_ty ~allow_contract:legacy ~allow_ticket:false -and parse_parameter_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_parameter_ty : context -> stack_depth:int -> @@ -1461,7 +1461,7 @@ and parse_view_output_ty : ~allow_contract:true ~allow_ticket:false -and parse_normal_storage_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_normal_storage_ty : context -> stack_depth:int -> @@ -1478,7 +1478,7 @@ and parse_normal_storage_ty ~allow_contract:legacy ~allow_ticket:true -and parse_any_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty : context -> stack_depth:int -> @@ -1495,7 +1495,7 @@ and parse_any_ty ~allow_contract:true ~allow_ticket:true -and parse_ty : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : context -> stack_depth:int -> legacy:bool -> @@ -1779,7 +1779,7 @@ and parse_ty : T_ticket; ] -and parse_big_map_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1797,7 +1797,7 @@ and parse_big_map_ty (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and parse_big_map_value_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2044,7 +2044,7 @@ exception Duplicate of string exception Too_long of string -let well_formed_entrypoints +let[@coq_axiom_with_reason "use of exceptions"] well_formed_entrypoints (type full) (full : full ty) ~root_name = let merge path annot (type t) (ty : t ty) reachable ((first_unreachable, all) as acc) = @@ -2419,7 +2419,7 @@ let comparable_comb_witness1 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec parse_comparable_data : +let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : type a. ?type_logger:type_logger -> context -> @@ -2500,7 +2500,7 @@ let comb_witness1 : type t. t ty -> (t, unit -> unit) comb_witness = function - storage after origination *) -let rec parse_data : +let[@coq_axiom_with_reason "gadt"] rec parse_data : type a. ?type_logger:type_logger -> stack_depth:int -> @@ -2987,7 +2987,7 @@ and typecheck_views : in SMap.fold_es aux views ctxt -and parse_returning : +and[@coq_axiom_with_reason "gadt"] parse_returning : type arg ret. ?type_logger:type_logger -> stack_depth:int -> @@ -3037,7 +3037,7 @@ and parse_returning : : (arg, ret) lambda), ctxt ) -and parse_instr : +and[@coq_axiom_with_reason "gadt"] parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -5428,7 +5428,7 @@ and parse_instr : I_OPEN_CHEST; ] -and parse_contract : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : type arg. stack_depth:int -> legacy:bool -> @@ -5791,7 +5791,7 @@ let parse_storage : storage_type (root storage)) -let parse_script : +let[@coq_axiom_with_reason "gadt"] parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5958,7 +5958,7 @@ let comb_witness2 : type t. t ty -> (t, unit -> unit -> unit) comb_witness = | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_data : type a. context -> stack_depth:int -> @@ -6145,7 +6145,7 @@ and unparse_items : ([], ctxt) items -and unparse_code ctxt ~stack_depth mode code = +and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -6482,7 +6482,7 @@ let rec has_lazy_storage : type t. t ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let extract_lazy_storage_updates ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a. @@ -6590,7 +6590,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let rec fold_lazy_storage : +let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : type a error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -6652,7 +6652,7 @@ let rec fold_lazy_storage : (ok (Fold_lazy_storage.Ok init, ctxt)) | _ -> (* TODO: fix injectivity of types *) assert false -let collect_lazy_storage ctxt ty x = +let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -6662,7 +6662,7 @@ let collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let extract_lazy_storage_diff ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6737,7 +6737,7 @@ let parse_ty = parse_ty ~stack_depth:0 let ty_eq ctxt = ty_eq ~legacy:true ctxt -let get_single_sapling_state ctxt ty x = +let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_011_PtHangz2/lib_protocol/script_repr.ml b/src/proto_011_PtHangz2/lib_protocol/script_repr.ml index ceebba35167b5..cf361c027f63f 100644 --- a/src/proto_011_PtHangz2/lib_protocol/script_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/script_repr.ml @@ -114,7 +114,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let rec of_nodes acc nodes more_nodes = + let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -269,7 +269,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let rec strip_annotations node = +let[@coq_struct "node"] rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -287,7 +287,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and micheline_fold_nodes +and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml b/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml index 5d453d565b5a2..cae0b6bf28449 100644 --- a/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/seed_repr.ml @@ -125,7 +125,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = nonce seed zero_bytes let initial_seeds n = - let rec loop acc elt i = + let[@coq_struct "i"] rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_011_PtHangz2/lib_protocol/storage_description.ml b/src/proto_011_PtHangz2/lib_protocol/storage_description.ml index c8f78f5a76ac8..72b91e8bd4334 100644 --- a/src/proto_011_PtHangz2/lib_protocol/storage_description.ml +++ b/src/proto_011_PtHangz2/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let rec pp : +let[@coq_struct "function_parameter"] rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and pp_item : +and[@coq_mutual_as_notation] pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml b/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml index f631a35239bfe..99345920deec8 100644 --- a/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml +++ b/src/proto_011_PtHangz2/lib_protocol/tez_repr.ml @@ -88,7 +88,7 @@ let of_string s = let pp ppf amount = let mult_int = 1_000_000L in - let rec left ppf amount = + let[@coq_struct "amount"] rec left ppf amount = let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r diff --git a/src/proto_012_Psithaca/lib_plugin/plugin.ml b/src/proto_012_Psithaca/lib_plugin/plugin.ml index dc36e95c092df..0fe35085e6998 100644 --- a/src/proto_012_Psithaca/lib_plugin/plugin.ml +++ b/src/proto_012_Psithaca/lib_plugin/plugin.ml @@ -3001,7 +3001,7 @@ module RPC = struct })) module Manager = struct - let operations ctxt block ~branch + let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_012_Psithaca/lib_protocol/apply.ml b/src/proto_012_Psithaca/lib_protocol/apply.ml index 75d493b9d27b9..4b20f9e2fb24d 100644 --- a/src/proto_012_Psithaca/lib_protocol/apply.ml +++ b/src/proto_012_Psithaca/lib_protocol/apply.ml @@ -1096,7 +1096,7 @@ let apply_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let rec apply ctxt applied worklist = + let[@coq_struct "ctxt"] rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Internal_operation ({source; operation; nonce} as op) :: rest -> ( @@ -1137,7 +1137,7 @@ let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = let precheck_manager_contents (type kind) ctxt (op : kind Kind.manager contents) ~(only_batch : bool) : (context * precheck_result) tzresult Lwt.t = - let (Manager_operation + let[@coq_match_with_default] (Manager_operation { source; fee; @@ -1299,7 +1299,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_operation_result list) Lwt.t = - let (Manager_operation + let[@coq_match_with_default] (Manager_operation { source; operation; @@ -1387,7 +1387,7 @@ let rec mark_skipped : kind Kind.manager prechecked_contents_list -> kind Kind.manager contents_result_list = fun ~payload_producer level prechecked_contents_list -> - match prechecked_contents_list with + match[@coq_match_with_default] prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation {operation; _}; @@ -1425,7 +1425,7 @@ let precheck_manager_contents_list ctxt contents_list ~mempool_mode = kind Kind.manager contents_list -> (context * kind Kind.manager prechecked_contents_list) tzresult Lwt.t = fun ctxt contents_list -> - match contents_list with + match[@coq_match_with_default] contents_list with | Single contents -> precheck_manager_contents ctxt contents ~only_batch:mempool_mode >>=? fun (ctxt, result) -> @@ -1463,7 +1463,7 @@ let check_manager_signature ctxt chain_id (op : _ Kind.manager contents_list) (Signature.public_key_hash * Signature.public_key option) option -> (Signature.public_key_hash * Signature.public_key option) tzresult = fun contents_list manager -> - let source (type kind) = function + let source (type kind) = function[@coq_match_with_default] | (Manager_operation {source; operation = Reveal key; _} : kind Kind.manager contents) -> (source, Some key) @@ -1492,7 +1492,7 @@ let rec apply_manager_contents_list_rec : (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = fun ctxt mode ~payload_producer chain_id prechecked_contents_list -> let level = Level.current ctxt in - match prechecked_contents_list with + match[@coq_match_with_default] prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation _ as op; @@ -2034,7 +2034,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match contents_list with + match[@coq_match_with_default] contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_012_Psithaca/lib_protocol/apply_results.ml b/src/proto_012_Psithaca/lib_protocol/apply_results.ml index d94bf0020595e..db84ac9e89c47 100644 --- a/src/proto_012_Psithaca/lib_protocol/apply_results.ml +++ b/src/proto_012_Psithaca/lib_protocol/apply_results.ml @@ -201,7 +201,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; iselect; select; proj; inj; t} - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -224,7 +224,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding: @@ -303,7 +303,7 @@ module Manager_result = struct allocated_destination_contract; }) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -372,7 +372,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -418,7 +418,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function + ~proj:(function[@coq_match_with_default] | Delegation_result {consumed_gas} -> (Gas.Arith.ceil consumed_gas, consumed_gas)) ~inj:(fun (consumed_gas, consumed_milligas) -> @@ -605,7 +605,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let preendorsement_case = + let[@coq_axiom_with_reason "gadt"] preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -633,7 +633,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let endorsement_case = + let[@coq_axiom_with_reason "gadt"] endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -658,7 +658,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -676,7 +676,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let double_endorsement_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -695,7 +695,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let double_preendorsement_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -715,7 +715,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -733,7 +733,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -751,7 +751,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -767,7 +767,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -783,7 +783,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let make_manager_case (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -864,7 +864,7 @@ module Encoding = struct }); } - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -874,7 +874,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -884,7 +884,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -894,7 +894,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -904,7 +904,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -916,7 +916,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let set_deposits_limit_case = + let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1298,7 +1298,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let rec pack_contents_list : +let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_012_Psithaca/lib_protocol/contract_repr.ml b/src/proto_012_Psithaca/lib_protocol/contract_repr.ml index f4cef224afec1..84c4251b5c6a4 100644 --- a/src/proto_012_Psithaca/lib_protocol/contract_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/contract_repr.ml @@ -161,7 +161,7 @@ let originated_contracts ({origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let rec contracts acc origination_index = + let[@coq_struct "origination_index"] rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_012_Psithaca/lib_protocol/contract_services.ml b/src/proto_012_Psithaca/lib_protocol/contract_services.ml index 870a3d0dd8a87..799d8c5ae62bc 100644 --- a/src/proto_012_Psithaca/lib_protocol/contract_services.ml +++ b/src/proto_012_Psithaca/lib_protocol/contract_services.ml @@ -254,7 +254,7 @@ module S = struct end end -let register () = +let[@coq_axiom_with_reason "gadt"] register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field ~chunked s f = diff --git a/src/proto_012_Psithaca/lib_protocol/level_storage.ml b/src/proto_012_Psithaca/lib_protocol/level_storage.ml index 74262b55496f9..cf4fa87d12c45 100644 --- a/src/proto_012_Psithaca/lib_protocol/level_storage.ml +++ b/src/proto_012_Psithaca/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_012_Psithaca/lib_protocol/main.ml b/src/proto_012_Psithaca/lib_protocol/main.ml index d12e51825b044..a3b6fac5786d5 100644 --- a/src/proto_012_Psithaca/lib_protocol/main.ml +++ b/src/proto_012_Psithaca/lib_protocol/main.ml @@ -685,7 +685,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match (op1.contents, op2.contents) with + match[@coq_match_with_default] (op1.contents, op2.contents) with | (Single (Preendorsement _), Single (Preendorsement _)) -> 0 | (Single (Preendorsement _), _) -> -1 | (_, Single (Preendorsement _)) -> 1 diff --git a/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml b/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml index 42adfc5ff88b2..c1434b14ec146 100644 --- a/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_012_Psithaca/lib_protocol/michelson_v1_primitives.ml @@ -227,7 +227,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let rec for_all a b f = + let[@coq_struct "a_value"] rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_012_Psithaca/lib_protocol/misc.ml b/src/proto_012_Psithaca/lib_protocol/misc.ml index d7c95b87aa3c4..bd350a5ef85b2 100644 --- a/src/proto_012_Psithaca/lib_protocol/misc.ml +++ b/src/proto_012_Psithaca/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let rec ( --> ) i j = +let[@coq_struct "i"] rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let rec ( <-- ) i j = +let[@coq_struct "j"] rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let rec ( ---> ) i j = +let[@coq_struct "i"] rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_012_Psithaca/lib_protocol/operation_repr.ml b/src/proto_012_Psithaca/lib_protocol/operation_repr.ml index 50c58210061ab..5db0a3162834a 100644 --- a/src/proto_012_Psithaca/lib_protocol/operation_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/operation_repr.ml @@ -347,7 +347,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = MCase { tag = 0; @@ -387,7 +387,7 @@ module Encoding = struct (fun s -> s); ] - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = MCase { tag = 1; @@ -424,7 +424,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = MCase { tag = 2; @@ -455,7 +455,7 @@ module Encoding = struct Origination {credit; delegate; script; preorigination = None}); } - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = MCase { tag = 3; @@ -467,7 +467,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = MCase { tag = 4; @@ -480,7 +480,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let set_deposits_limit_case = + let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = MCase { tag = 5; @@ -582,7 +582,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun (Endorsement consensus_content) -> + (fun [@coq_match_with_default] (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -592,7 +592,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let endorsement_encoding = + let[@coq_axiom_with_reason "gadt"] endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -614,7 +614,7 @@ module Encoding = struct @@ union [make endorsement_case])) (varopt "signature" Signature.encoding))) - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { tag = 1; @@ -630,7 +630,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let double_preendorsement_evidence_case : + let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case : Kind.double_preendorsement_evidence case = Case { @@ -648,7 +648,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let double_endorsement_evidence_case : + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -666,7 +666,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { tag = 3; @@ -682,7 +682,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { tag = 4; @@ -701,7 +701,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { tag = 5; @@ -721,7 +721,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { tag = 6; @@ -751,7 +751,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function Failing_noop message -> message); + (function[@coq_match_with_default] Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -764,7 +764,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function + function[@coq_match_with_default] | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -773,7 +773,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let make_manager_case tag (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml b/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml index 1ae2e81205af7..b37010dff8988 100644 --- a/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml +++ b/src/proto_012_Psithaca/lib_protocol/roll_storage_legacy.ml @@ -97,7 +97,7 @@ let delegate_pubkey ctxt delegate = let fold ctxt ~f init = Storage.Roll_legacy.Next.get ctxt >>=? fun last -> - let rec loop ctxt roll acc = + let[@coq_struct "roll"] rec loop ctxt roll acc = if Roll_repr_legacy.(roll = last) then return acc else Storage.Roll_legacy.Owner.find ctxt roll >>=? function @@ -228,7 +228,7 @@ module Delegate = struct Storage.Roll_legacy.Delegate_change.update ctxt delegate change >>=? fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> @@ -248,7 +248,7 @@ module Delegate = struct let remove_amount ctxt delegate amount = let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = if Tez_repr.(amount <= change) then return (ctxt, change) else pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) -> @@ -280,7 +280,7 @@ module Delegate = struct >>= fun ctxt -> Storage.Legacy_active_delegates_with_rolls.remove ctxt delegate >>= fun ctxt -> - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate >>=? function | None -> return (ctxt, change) | Some _roll -> @@ -330,7 +330,7 @@ module Delegate = struct (Contract_repr.implicit_contract delegate) >>= fun ctxt -> delegate_pubkey ctxt delegate >>=? fun delegate_pk -> - let rec loop ctxt change = + let[@coq_struct "change"] rec loop ctxt change = if Tez_repr.(change < tokens_per_roll) then return ctxt else Tez_repr.(change -? tokens_per_roll) >>?= fun change -> diff --git a/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml b/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml index 186f0359ad799..167f75f1f913b 100644 --- a/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml +++ b/src/proto_012_Psithaca/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let rec insert ctx id node height pos cms = + let[@coq_struct "height"] rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let rec fold_from_height ctx id node ~pos ~f ~acc height + let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let rec aux acc pos = + let[@coq_struct "pos"] rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let rec aux ctx pos = + let[@coq_struct "pos"] rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml b/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml index 07564bf08ce1b..ceb7553e3dc02 100644 --- a/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml +++ b/src/proto_012_Psithaca/lib_protocol/script_ir_translator.ml @@ -351,7 +351,7 @@ let unparse_comparable_ty ~loc ctxt comp_ty = Gas.consume ctxt (Unparse_costs.unparse_comparable_type comp_ty) >|? fun ctxt -> (unparse_comparable_ty_uncarbonated ~loc comp_ty, ctxt) -let rec strip_var_annots = function +let[@coq_struct "function_parameter"] rec strip_var_annots = function | (Int _ | String _ | Bytes _) as atom -> atom | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args) | Prim (loc, name, args, annots) -> @@ -371,7 +371,7 @@ let serialize_ty_for_error ty = let ty = unparse_ty_uncarbonated ~loc:() ty in Micheline.strip_locations (strip_var_annots ty) -let rec comparable_ty_of_ty : +let[@coq_axiom_with_reason "gadt"] rec comparable_ty_of_ty : type a. context -> Script.location -> a ty -> (a comparable_ty * context) tzresult = fun ctxt loc ty -> @@ -646,7 +646,7 @@ let comparable_comb_witness2 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_comparable_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -1211,7 +1211,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size + | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -1220,7 +1220,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : type ex_comparable_ty = | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty -let rec parse_comparable_ty : +let[@coq_struct "ty"] rec parse_comparable_ty : stack_depth:int -> context -> Script.node -> @@ -1349,7 +1349,7 @@ let rec parse_comparable_ty : type ex_ty = Ex_ty : 'a ty -> ex_ty -let rec parse_packable_ty +let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_packable_ty : context -> stack_depth:int -> @@ -1369,7 +1369,7 @@ let rec parse_packable_ty https://gitlab.com/tezos/tezos/-/issues/301 *) ~allow_ticket:false -and parse_parameter_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_parameter_ty : context -> stack_depth:int -> @@ -1418,7 +1418,7 @@ and parse_view_output_ty : ~allow_contract:true ~allow_ticket:false -and parse_normal_storage_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_normal_storage_ty : context -> stack_depth:int -> @@ -1435,7 +1435,7 @@ and parse_normal_storage_ty ~allow_contract:legacy ~allow_ticket:true -and parse_any_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty : context -> stack_depth:int -> @@ -1452,7 +1452,7 @@ and parse_any_ty ~allow_contract:true ~allow_ticket:true -and parse_ty : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_ty : context -> stack_depth:int -> legacy:bool -> @@ -1736,7 +1736,7 @@ and parse_ty : T_ticket; ] -and parse_big_map_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1754,7 +1754,7 @@ and parse_big_map_ty (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and parse_big_map_value_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2371,7 +2371,7 @@ let comparable_comb_witness1 : | Pair_key _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec parse_comparable_data : +let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : type a. ?type_logger:type_logger -> context -> @@ -2450,7 +2450,7 @@ let comb_witness1 : type t. t ty -> (t, unit -> unit) comb_witness = function - storage after origination *) -let rec parse_data : +let[@coq_axiom_with_reason "gadt"] rec parse_data : type a. ?type_logger:type_logger -> stack_depth:int -> @@ -2934,7 +2934,7 @@ and typecheck_views : in SMap.fold_es aux views ctxt -and parse_returning : +and[@coq_axiom_with_reason "gadt"] parse_returning : type arg ret. ?type_logger:type_logger -> stack_depth:int -> @@ -2983,7 +2983,7 @@ and parse_returning : : (arg, ret) lambda), ctxt ) -and parse_instr : +and[@coq_axiom_with_reason "gadt"] parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -5390,7 +5390,7 @@ and parse_instr : I_OPEN_CHEST; ] -and parse_contract : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : type arg. stack_depth:int -> legacy:bool -> @@ -5762,7 +5762,7 @@ let parse_storage : storage_type (root storage)) -let parse_script : +let[@coq_axiom_with_reason "gadt"] parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5932,7 +5932,7 @@ let comb_witness2 : type t. t ty -> (t, unit -> unit -> unit) comb_witness = | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_data : type a. context -> stack_depth:int -> @@ -6123,7 +6123,7 @@ and unparse_items : ([], ctxt) items -and unparse_code ctxt ~stack_depth mode code = +and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -6461,7 +6461,7 @@ let rec has_lazy_storage : type t. t ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let extract_lazy_storage_updates ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a. @@ -6573,7 +6573,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let rec fold_lazy_storage : +let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : type a error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -6638,7 +6638,7 @@ let rec fold_lazy_storage : fix injectivity of types *) assert false -let collect_lazy_storage ctxt ty x = +let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -6648,7 +6648,7 @@ let collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let extract_lazy_storage_diff ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6723,7 +6723,7 @@ let parse_ty = parse_ty ~stack_depth:0 let ty_eq ctxt = ty_eq ~legacy:true ctxt -let get_single_sapling_state ctxt ty x = +let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_012_Psithaca/lib_protocol/script_repr.ml b/src/proto_012_Psithaca/lib_protocol/script_repr.ml index 9a4894001f8f4..c286e56f90874 100644 --- a/src/proto_012_Psithaca/lib_protocol/script_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/script_repr.ml @@ -119,7 +119,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let rec of_nodes acc nodes more_nodes = + let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -314,7 +314,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let rec strip_annotations node = +let[@coq_struct "node"] rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -332,7 +332,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and micheline_fold_nodes +and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_012_Psithaca/lib_protocol/seed_repr.ml b/src/proto_012_Psithaca/lib_protocol/seed_repr.ml index 1e2ace7a2cba6..ea1c28351d311 100644 --- a/src/proto_012_Psithaca/lib_protocol/seed_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/seed_repr.ml @@ -143,7 +143,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = nonce seed zero_bytes let initial_seeds n = - let rec loop acc elt i = + let[@coq_struct "i"] rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_012_Psithaca/lib_protocol/storage_description.ml b/src/proto_012_Psithaca/lib_protocol/storage_description.ml index 807ce41e32664..7bac72c5a9690 100644 --- a/src/proto_012_Psithaca/lib_protocol/storage_description.ml +++ b/src/proto_012_Psithaca/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let rec pp : +let[@coq_struct "function_parameter"] rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and pp_item : +and[@coq_mutual_as_notation] pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_012_Psithaca/lib_protocol/tez_repr.ml b/src/proto_012_Psithaca/lib_protocol/tez_repr.ml index fc2d6518d2902..5636b07a16f09 100644 --- a/src/proto_012_Psithaca/lib_protocol/tez_repr.ml +++ b/src/proto_012_Psithaca/lib_protocol/tez_repr.ml @@ -88,7 +88,7 @@ let of_string s = let pp ppf amount = let mult_int = 1_000_000L in - let rec left ppf amount = + let[@coq_struct "amount"] rec left ppf amount = let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r diff --git a/src/proto_013_PtJakart/lib_plugin/plugin.ml b/src/proto_013_PtJakart/lib_plugin/plugin.ml index b64b4e653c961..d0490cc0ba9d9 100644 --- a/src/proto_013_PtJakart/lib_plugin/plugin.ml +++ b/src/proto_013_PtJakart/lib_plugin/plugin.ml @@ -3498,7 +3498,7 @@ module RPC = struct return (Tx_rollup_withdraw_list_hash.hash_uncarbonated withdrawals)) module Manager = struct - let operations ctxt block ~branch + let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_013_PtJakart/lib_protocol/apply.ml b/src/proto_013_PtJakart/lib_protocol/apply.ml index dce3a7c7e5ff7..dd33934423cdf 100644 --- a/src/proto_013_PtJakart/lib_protocol/apply.ml +++ b/src/proto_013_PtJakart/lib_protocol/apply.ml @@ -1781,7 +1781,7 @@ let apply_external_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let rec apply ctxt applied worklist = + let[@coq_struct "ctxt"] rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Script_typed_ir.Internal_operation ({source; operation; nonce} as op) @@ -1826,7 +1826,7 @@ let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = let precheck_manager_contents (type kind) ctxt (op : kind Kind.manager contents) ~(only_batch : bool) : (context * precheck_result) tzresult Lwt.t = - let (Manager_operation + let[@coq_match_with_default] (Manager_operation { source; fee; @@ -2140,7 +2140,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_manager_operation_result list) Lwt.t = - let (Manager_operation + let[@coq_match_with_default] (Manager_operation { source; operation; @@ -2225,7 +2225,7 @@ let rec mark_skipped : kind Kind.manager prechecked_contents_list -> kind Kind.manager contents_result_list = fun ~payload_producer level prechecked_contents_list -> - match prechecked_contents_list with + match[@coq_match_with_default] prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation {operation; _}; @@ -2271,7 +2271,7 @@ let check_counters_consistency contents_list = type kind. counter option -> kind Kind.manager contents_list -> unit tzresult Lwt.t = fun previous_counter contents_list -> - match contents_list with + match[@coq_match_with_default] contents_list with | Single (Manager_operation {counter; _}) -> check_counter ~previous_counter counter | Cons (Manager_operation {counter; _}, rest) -> @@ -2327,7 +2327,7 @@ let find_manager_public_key ctxt (op : _ Kind.manager contents_list) = (Signature.public_key_hash * Signature.public_key option) option -> (Signature.public_key_hash * Signature.public_key option) tzresult = fun contents_list manager -> - let source (type kind) = function + let source (type kind) = function[@coq_match_with_default] | (Manager_operation {source; operation = Reveal key; _} : kind Kind.manager contents) -> (source, Some key) @@ -2359,7 +2359,7 @@ let rec apply_manager_contents_list_rec : (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = fun ctxt mode ~payload_producer chain_id prechecked_contents_list -> let level = Level.current ctxt in - match prechecked_contents_list with + match[@coq_match_with_default] prechecked_contents_list with | PrecheckedSingle { contents = Manager_operation _ as op; @@ -2902,7 +2902,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match contents_list with + match[@coq_match_with_default] contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_013_PtJakart/lib_protocol/apply_results.ml b/src/proto_013_PtJakart/lib_protocol/apply_results.ml index bb81cc319a32d..065e5d6c4f0c0 100644 --- a/src/proto_013_PtJakart/lib_protocol/apply_results.ml +++ b/src/proto_013_PtJakart/lib_protocol/apply_results.ml @@ -333,7 +333,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; select; proj; inj; t} - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -352,7 +352,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Reveal_result {consumed_gas = consumed_milligas}) - let transaction_contract_variant_cases = + let[@coq_axiom_with_reason "gadt"] transaction_contract_variant_cases = union [ case @@ -451,7 +451,7 @@ module Manager_result = struct }); ] - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding:transaction_contract_variant_cases @@ -462,7 +462,7 @@ module Manager_result = struct ~proj:(function Transaction_result x -> x) ~inj:(fun x -> Transaction_result x) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -514,7 +514,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -565,7 +565,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function + ~proj:(function[@coq_match_with_default] | Delegation_result {consumed_gas} -> (Gas.Arith.ceil consumed_gas, consumed_gas)) ~inj:(fun (consumed_gas, consumed_milligas) -> @@ -592,7 +592,7 @@ module Manager_result = struct assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ; Set_deposits_limit_result {consumed_gas = consumed_milligas}) - let tx_rollup_origination_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_origination_case ~encoding: @@ -627,7 +627,7 @@ module Manager_result = struct originated_tx_rollup; }) - let tx_rollup_submit_batch_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_submit_batch_case ~encoding: @@ -662,7 +662,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let tx_rollup_commit_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_commit_case ~encoding: @@ -683,7 +683,7 @@ module Manager_result = struct Tx_rollup_commit_result {balance_updates; consumed_gas = consumed_milligas}) - let tx_rollup_return_bond_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_return_bond_case ~encoding: @@ -705,7 +705,7 @@ module Manager_result = struct Tx_rollup_return_bond_result {balance_updates; consumed_gas = consumed_milligas}) - let tx_rollup_finalize_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_finalize_commitment_case @@ -731,7 +731,7 @@ module Manager_result = struct Tx_rollup_finalize_commitment_result {balance_updates; consumed_gas = consumed_milligas; level}) - let tx_rollup_remove_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_remove_commitment_case @@ -757,7 +757,7 @@ module Manager_result = struct Tx_rollup_remove_commitment_result {balance_updates; consumed_gas = consumed_milligas; level}) - let tx_rollup_rejection_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_rejection_case ~encoding: @@ -779,7 +779,7 @@ module Manager_result = struct Tx_rollup_rejection_result {balance_updates; consumed_gas = consumed_milligas}) - let tx_rollup_dispatch_tickets_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_dispatch_tickets_case @@ -816,7 +816,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let transfer_ticket_case = + let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = make ~op_case:Operation.Encoding.Manager_operations.transfer_ticket_case ~encoding: @@ -850,7 +850,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let sc_rollup_originate_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_originate_case ~encoding: @@ -961,7 +961,7 @@ module Internal_result = struct -> 'kind case [@@coq_force_gadt] - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = MCase { tag = Operation.Encoding.Manager_operations.transaction_tag; @@ -1004,7 +1004,7 @@ module Internal_result = struct Transaction {amount; destination; parameters; entrypoint}); } - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = MCase { tag = Operation.Encoding.Manager_operations.origination_tag; @@ -1030,7 +1030,7 @@ module Internal_result = struct Origination {credit; delegate; script}); } - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = MCase { tag = Operation.Encoding.Manager_operations.delegation_tag; @@ -1283,7 +1283,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let preendorsement_case = + let[@coq_axiom_with_reason "gadt"] preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -1311,7 +1311,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let endorsement_case = + let[@coq_axiom_with_reason "gadt"] endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -1336,7 +1336,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -1355,7 +1355,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let double_endorsement_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -1375,7 +1375,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let double_preendorsement_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -1396,7 +1396,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -1415,7 +1415,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -1434,7 +1434,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -1450,7 +1450,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -1466,7 +1466,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let make_manager_case (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -1547,7 +1547,7 @@ module Encoding = struct }); } - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -1557,7 +1557,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -1567,7 +1567,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -1577,7 +1577,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1587,7 +1587,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1599,7 +1599,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let set_deposits_limit_case = + let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1610,7 +1610,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_origination_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = make_manager_case Operation.Encoding.tx_rollup_origination_case Manager_result.tx_rollup_origination_case @@ -1621,7 +1621,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_submit_batch_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = make_manager_case Operation.Encoding.tx_rollup_submit_batch_case Manager_result.tx_rollup_submit_batch_case @@ -1632,7 +1632,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_commit_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = make_manager_case Operation.Encoding.tx_rollup_commit_case Manager_result.tx_rollup_commit_case @@ -1643,7 +1643,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_return_bond_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = make_manager_case Operation.Encoding.tx_rollup_return_bond_case Manager_result.tx_rollup_return_bond_case @@ -1654,7 +1654,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_finalize_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = make_manager_case Operation.Encoding.tx_rollup_finalize_commitment_case Manager_result.tx_rollup_finalize_commitment_case @@ -1666,7 +1666,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_remove_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = make_manager_case Operation.Encoding.tx_rollup_remove_commitment_case Manager_result.tx_rollup_remove_commitment_case @@ -1678,7 +1678,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_rejection_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = make_manager_case Operation.Encoding.tx_rollup_rejection_case Manager_result.tx_rollup_rejection_case @@ -1689,7 +1689,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_dispatch_tickets_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = make_manager_case Operation.Encoding.tx_rollup_dispatch_tickets_case Manager_result.tx_rollup_dispatch_tickets_case @@ -1701,7 +1701,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transfer_ticket_case = + let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = make_manager_case Operation.Encoding.transfer_ticket_case Manager_result.transfer_ticket_case @@ -1712,7 +1712,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_originate_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = make_manager_case Operation.Encoding.sc_rollup_originate_case Manager_result.sc_rollup_originate_case @@ -1723,7 +1723,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_add_messages_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = make_manager_case Operation.Encoding.sc_rollup_add_messages_case Manager_result.sc_rollup_add_messages_case @@ -1734,7 +1734,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_cement_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = make_manager_case Operation.Encoding.sc_rollup_cement_case Manager_result.sc_rollup_cement_case @@ -1745,7 +1745,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_publish_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = make_manager_case Operation.Encoding.sc_rollup_publish_case Manager_result.sc_rollup_publish_case @@ -2504,7 +2504,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let rec pack_contents_list : +let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_013_PtJakart/lib_protocol/contract_repr.ml b/src/proto_013_PtJakart/lib_protocol/contract_repr.ml index 09cdc7a5ee7fb..5b57f87e18449 100644 --- a/src/proto_013_PtJakart/lib_protocol/contract_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/contract_repr.ml @@ -151,7 +151,7 @@ let originated_contracts (Origination_nonce.{origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let rec contracts acc origination_index = + let[@coq_struct "origination_index"] rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_013_PtJakart/lib_protocol/contract_services.ml b/src/proto_013_PtJakart/lib_protocol/contract_services.ml index 23010c3e5b2ff..f60675624690c 100644 --- a/src/proto_013_PtJakart/lib_protocol/contract_services.ml +++ b/src/proto_013_PtJakart/lib_protocol/contract_services.ml @@ -285,7 +285,7 @@ module S = struct end end -let register () = +let[@coq_axiom_with_reason "gadt"] register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field ~chunked s f = diff --git a/src/proto_013_PtJakart/lib_protocol/level_storage.ml b/src/proto_013_PtJakart/lib_protocol/level_storage.ml index 306d9f5acdad4..526e64e963887 100644 --- a/src/proto_013_PtJakart/lib_protocol/level_storage.ml +++ b/src/proto_013_PtJakart/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_013_PtJakart/lib_protocol/main.ml b/src/proto_013_PtJakart/lib_protocol/main.ml index e0aebe7d13a7c..e4a4230232a2d 100644 --- a/src/proto_013_PtJakart/lib_protocol/main.ml +++ b/src/proto_013_PtJakart/lib_protocol/main.ml @@ -683,7 +683,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match (op1.contents, op2.contents) with + match[@coq_match_with_default] (op1.contents, op2.contents) with | (Single (Preendorsement _), Single (Preendorsement _)) -> 0 | (Single (Preendorsement _), _) -> -1 | (_, Single (Preendorsement _)) -> 1 diff --git a/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml b/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml index de1a5ef6e2cb0..b85b7ea065986 100644 --- a/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_013_PtJakart/lib_protocol/michelson_v1_primitives.ml @@ -230,7 +230,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let rec for_all a b f = + let[@coq_struct "a_value"] rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_013_PtJakart/lib_protocol/misc.ml b/src/proto_013_PtJakart/lib_protocol/misc.ml index d7c95b87aa3c4..bd350a5ef85b2 100644 --- a/src/proto_013_PtJakart/lib_protocol/misc.ml +++ b/src/proto_013_PtJakart/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let rec ( --> ) i j = +let[@coq_struct "i"] rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let rec ( <-- ) i j = +let[@coq_struct "j"] rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let rec ( ---> ) i j = +let[@coq_struct "i"] rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_013_PtJakart/lib_protocol/operation_repr.ml b/src/proto_013_PtJakart/lib_protocol/operation_repr.ml index cb9c3b1c7d761..dec9abba76d0d 100644 --- a/src/proto_013_PtJakart/lib_protocol/operation_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/operation_repr.ml @@ -506,7 +506,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = MCase { tag = 0; @@ -519,7 +519,7 @@ module Encoding = struct let transaction_tag = 1 - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = MCase { tag = transaction_tag; @@ -558,7 +558,7 @@ module Encoding = struct let origination_tag = 2 - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = MCase { tag = origination_tag; @@ -581,7 +581,7 @@ module Encoding = struct let delegation_tag = 3 - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = MCase { tag = delegation_tag; @@ -593,7 +593,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = MCase { tag = 4; @@ -606,7 +606,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let set_deposits_limit_case = + let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = MCase { tag = 5; @@ -619,7 +619,7 @@ module Encoding = struct inj = (fun key -> Set_deposits_limit key); } - let tx_rollup_origination_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = MCase { tag = tx_rollup_operation_origination_tag; @@ -638,7 +638,7 @@ module Encoding = struct encoding which is in hexadecimal for JSON. *) conv Bytes.of_string Bytes.to_string bytes - let tx_rollup_submit_batch_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = MCase { tag = tx_rollup_operation_submit_batch_tag; @@ -660,7 +660,7 @@ module Encoding = struct Tx_rollup_submit_batch {tx_rollup; content; burn_limit}); } - let tx_rollup_commit_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = MCase { tag = tx_rollup_operation_commit_tag; @@ -680,7 +680,7 @@ module Encoding = struct Tx_rollup_commit {tx_rollup; commitment}); } - let tx_rollup_return_bond_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = MCase { tag = tx_rollup_operation_return_bond_tag; @@ -693,7 +693,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_return_bond {tx_rollup}); } - let tx_rollup_finalize_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = MCase { tag = tx_rollup_operation_finalize_commitment_tag; @@ -708,7 +708,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_finalize_commitment {tx_rollup}); } - let tx_rollup_remove_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = MCase { tag = tx_rollup_operation_remove_commitment_tag; @@ -723,7 +723,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_remove_commitment {tx_rollup}); } - let tx_rollup_rejection_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = MCase { tag = tx_rollup_operation_rejection_tag; @@ -802,7 +802,7 @@ module Encoding = struct }); } - let tx_rollup_dispatch_tickets_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = MCase { tag = tx_rollup_operation_dispatch_tickets_tag; @@ -858,7 +858,7 @@ module Encoding = struct }); } - let transfer_ticket_case = + let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = MCase { tag = transfer_ticket_tag; @@ -885,7 +885,7 @@ module Encoding = struct {contents; ty; ticketer; amount; destination; entrypoint}); } - let sc_rollup_originate_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = MCase { tag = sc_rollup_operation_origination_tag; @@ -904,7 +904,7 @@ module Encoding = struct (fun (kind, boot_sector) -> Sc_rollup_originate {kind; boot_sector}); } - let sc_rollup_add_messages_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = MCase { tag = sc_rollup_operation_add_message_tag; @@ -924,7 +924,7 @@ module Encoding = struct Sc_rollup_add_messages {rollup; messages}); } - let sc_rollup_cement_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = MCase { tag = sc_rollup_operation_cement_tag; @@ -943,7 +943,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_cement {rollup; commitment}); } - let sc_rollup_publish_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = MCase { tag = sc_rollup_operation_publish_tag; @@ -1028,7 +1028,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun (Endorsement consensus_content) -> + (fun [@coq_match_with_default] (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -1038,7 +1038,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let endorsement_encoding = + let[@coq_axiom_with_reason "gadt"] endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -1060,7 +1060,7 @@ module Encoding = struct @@ union [make endorsement_case])) (varopt "signature" Signature.encoding))) - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { tag = 1; @@ -1076,7 +1076,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let double_preendorsement_evidence_case : + let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case : Kind.double_preendorsement_evidence case = Case { @@ -1094,7 +1094,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let double_endorsement_evidence_case : + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -1112,7 +1112,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { tag = 3; @@ -1128,7 +1128,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { tag = 4; @@ -1147,7 +1147,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { tag = 5; @@ -1167,7 +1167,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { tag = 6; @@ -1197,7 +1197,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function Failing_noop message -> message); + (function[@coq_match_with_default] Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -1210,7 +1210,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function + function[@coq_match_with_default] | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -1219,7 +1219,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let make_manager_case tag (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml b/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml index 186f0359ad799..167f75f1f913b 100644 --- a/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml +++ b/src/proto_013_PtJakart/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let rec insert ctx id node height pos cms = + let[@coq_struct "height"] rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let rec fold_from_height ctx id node ~pos ~f ~acc height + let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let rec aux acc pos = + let[@coq_struct "pos"] rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let rec aux ctx pos = + let[@coq_struct "pos"] rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml b/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml index 2d5b7e0fdd7b7..1c99eb32003dd 100644 --- a/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml +++ b/src/proto_013_PtJakart/lib_protocol/script_ir_translator.ml @@ -334,7 +334,7 @@ let serialize_ty_for_error ty = *) unparse_ty_uncarbonated ~loc:() ty |> Micheline.strip_locations -let rec comparable_ty_of_ty : +let[@coq_axiom_with_reason "gadt"] rec comparable_ty_of_ty : type a ac. context -> Script.location -> @@ -596,7 +596,7 @@ let comparable_comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_comparable_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -1090,7 +1090,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size + | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -1099,7 +1099,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : type ex_comparable_ty = | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty -let rec parse_comparable_ty : +let[@coq_struct "ty"] rec parse_comparable_ty : stack_depth:int -> context -> Script.node -> @@ -1249,7 +1249,7 @@ type ('ret, 'name) parse_ty_ret = | Parse_entrypoints : (ex_parameter_ty_and_entrypoints_node, Entrypoint.t option) parse_ty_ret -let rec parse_ty : +let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty : type ret name. context -> stack_depth:int -> @@ -1589,7 +1589,7 @@ let rec parse_ty : T_tx_rollup_l2_address; ] -and parse_passable_ty : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passable_ty : type ret name. context -> stack_depth:int -> @@ -1607,7 +1607,7 @@ and parse_passable_ty : ~allow_contract:true ~allow_ticket:true -and parse_any_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty : context -> stack_depth:int -> @@ -1625,7 +1625,7 @@ and parse_any_ty ~allow_ticket:true ~ret:Don't_parse_entrypoints -and parse_big_map_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1643,7 +1643,7 @@ and parse_big_map_ty (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and parse_big_map_value_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2434,7 +2434,7 @@ let comparable_comb_witness1 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec parse_comparable_data : +let[@coq_axiom_with_reason "gadt"] rec parse_comparable_data : type a. ?type_logger:type_logger -> context -> @@ -2514,7 +2514,7 @@ let comb_witness1 : type t tc. (t, tc) ty -> (t, unit -> unit) comb_witness = - storage after origination *) -let rec parse_data : +let[@coq_axiom_with_reason "gadt"] rec parse_data : type a ac. ?type_logger:type_logger -> stack_depth:int -> @@ -3039,7 +3039,7 @@ and parse_views : in Script_map.map_es_in_context aux ctxt views -and parse_returning : +and[@coq_axiom_with_reason "gadt"] parse_returning : type arg argc ret retc. ?type_logger:type_logger -> stack_depth:int -> @@ -3081,7 +3081,7 @@ and parse_returning : : (arg, ret) lambda), ctxt ) -and parse_instr : +and[@coq_axiom_with_reason "gadt"] parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -5122,7 +5122,7 @@ and parse_instr : I_OPEN_CHEST; ] -and parse_contract : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : type arg argc. stack_depth:int -> context -> @@ -5504,7 +5504,7 @@ let parse_storage : storage_type (root storage)) -let parse_script : +let[@coq_axiom_with_reason "gadt"] parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5658,7 +5658,7 @@ let comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_data : type a ac. context -> stack_depth:int -> @@ -5863,7 +5863,7 @@ and unparse_items : ([], ctxt) items -and unparse_code ctxt ~stack_depth mode code = +and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -6247,7 +6247,7 @@ let rec has_lazy_storage : type t tc. (t, tc) ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let extract_lazy_storage_updates ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a ac. @@ -6359,7 +6359,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let rec fold_lazy_storage : +let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : type a ac error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -6418,7 +6418,7 @@ let rec fold_lazy_storage : m (ok (Fold_lazy_storage.Ok init, ctxt)) -let collect_lazy_storage ctxt ty x = +let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -6428,7 +6428,7 @@ let collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let extract_lazy_storage_diff ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6504,7 +6504,7 @@ let parse_ty = parse_ty ~stack_depth:0 ~ret:Don't_parse_entrypoints let parse_parameter_ty_and_entrypoints = parse_parameter_ty_and_entrypoints ~stack_depth:0 -let get_single_sapling_state ctxt ty x = +let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_013_PtJakart/lib_protocol/script_repr.ml b/src/proto_013_PtJakart/lib_protocol/script_repr.ml index 81e8474d5fd6e..681d6d7c627a5 100644 --- a/src/proto_013_PtJakart/lib_protocol/script_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/script_repr.ml @@ -117,7 +117,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let rec of_nodes acc nodes more_nodes = + let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -312,7 +312,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let rec strip_annotations node = +let[@coq_struct "node"] rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -330,7 +330,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and micheline_fold_nodes +and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_013_PtJakart/lib_protocol/seed_repr.ml b/src/proto_013_PtJakart/lib_protocol/seed_repr.ml index f8a136e9d26ed..b9f6d85160c85 100644 --- a/src/proto_013_PtJakart/lib_protocol/seed_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/seed_repr.ml @@ -153,7 +153,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = nonce seed zero_bytes let initial_seeds ?initial_seed n = - let rec loop acc elt i = + let[@coq_struct "i"] rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_013_PtJakart/lib_protocol/storage_description.ml b/src/proto_013_PtJakart/lib_protocol/storage_description.ml index 807ce41e32664..7bac72c5a9690 100644 --- a/src/proto_013_PtJakart/lib_protocol/storage_description.ml +++ b/src/proto_013_PtJakart/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let rec pp : +let[@coq_struct "function_parameter"] rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and pp_item : +and[@coq_mutual_as_notation] pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_013_PtJakart/lib_protocol/tez_repr.ml b/src/proto_013_PtJakart/lib_protocol/tez_repr.ml index a1663546ab210..e80c732071c53 100644 --- a/src/proto_013_PtJakart/lib_protocol/tez_repr.ml +++ b/src/proto_013_PtJakart/lib_protocol/tez_repr.ml @@ -97,7 +97,7 @@ let of_string s = let pp ppf (Tez_tag amount) = let mult_int = 1_000_000L in - let rec left ppf amount = + let[@coq_struct "amount"] rec left ppf amount = let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 9fa6037840732..dd9c58546ded1 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -2324,7 +2324,7 @@ module Forge = struct return (Tx_rollup_withdraw_list_hash.hash_uncarbonated withdrawals)) module Manager = struct - let operations ctxt block ~branch + let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 0a5def747fdca..3462c7fb0d97a 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1884,7 +1884,7 @@ let apply_external_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let rec apply ctxt applied worklist = + let[@coq_struct "ctxt"] rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Script_typed_ir.Internal_operation ({source; operation; nonce} as op) @@ -2146,7 +2146,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_manager_operation_result list) Lwt.t = - let (Manager_operation + let[@coq_match_with_default] (Manager_operation { source; operation; @@ -2864,7 +2864,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match contents_list with + match[@coq_match_with_default] contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index 0559065ddff7b..824c7b4bdeef6 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -274,7 +274,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; select; proj; inj; t} - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -287,7 +287,7 @@ module Manager_result = struct ~proj:(function Reveal_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Reveal_result {consumed_gas}) - let transaction_contract_variant_cases = + let[@coq_axiom_with_reason "gadt"] transaction_contract_variant_cases = union [ case @@ -400,7 +400,7 @@ module Manager_result = struct (fun consumed_gas -> Transaction_to_event_result {consumed_gas}); ] - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding:transaction_contract_variant_cases @@ -411,7 +411,7 @@ module Manager_result = struct ~proj:(function Transaction_result x -> x) ~inj:(fun x -> Transaction_result x) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -464,7 +464,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -498,7 +498,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function + ~proj:(function[@coq_match_with_default] | Delegation_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Delegation_result {consumed_gas}) @@ -517,7 +517,7 @@ module Manager_result = struct | Set_deposits_limit_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Set_deposits_limit_result {consumed_gas}) - let tx_rollup_origination_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_origination_case ~encoding: @@ -539,7 +539,7 @@ module Manager_result = struct Tx_rollup_origination_result {balance_updates; consumed_gas; originated_tx_rollup}) - let tx_rollup_submit_batch_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_submit_batch_case ~encoding: @@ -561,7 +561,7 @@ module Manager_result = struct Tx_rollup_submit_batch_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let tx_rollup_commit_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_commit_case ~encoding: @@ -579,7 +579,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_commit_result {balance_updates; consumed_gas}) - let tx_rollup_return_bond_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_return_bond_case ~encoding: @@ -598,7 +598,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_return_bond_result {balance_updates; consumed_gas}) - let tx_rollup_finalize_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_finalize_commitment_case @@ -622,7 +622,7 @@ module Manager_result = struct Tx_rollup_finalize_commitment_result {balance_updates; consumed_gas; level}) - let tx_rollup_remove_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_remove_commitment_case @@ -646,7 +646,7 @@ module Manager_result = struct Tx_rollup_remove_commitment_result {balance_updates; consumed_gas; level}) - let tx_rollup_rejection_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_rejection_case ~encoding: @@ -665,7 +665,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_rejection_result {balance_updates; consumed_gas}) - let tx_rollup_dispatch_tickets_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_dispatch_tickets_case @@ -689,7 +689,7 @@ module Manager_result = struct Tx_rollup_dispatch_tickets_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let transfer_ticket_case = + let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = make ~op_case:Operation.Encoding.Manager_operations.transfer_ticket_case ~encoding: @@ -710,7 +710,7 @@ module Manager_result = struct Transfer_ticket_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let dal_publish_slot_header_case = + let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = make ~op_case: Operation.Encoding.Manager_operations.dal_publish_slot_header_case @@ -725,7 +725,7 @@ module Manager_result = struct ~kind:Kind.Dal_publish_slot_header_manager_kind ~inj:(fun consumed_gas -> Dal_publish_slot_header_result {consumed_gas}) - let sc_rollup_originate_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_originate_case ~encoding: @@ -863,7 +863,7 @@ module Manager_result = struct Sc_rollup_execute_outbox_message_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let sc_rollup_recover_bond_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_recover_bond_case ~encoding: @@ -1101,7 +1101,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let preendorsement_case = + let[@coq_axiom_with_reason "gadt"] preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -1129,7 +1129,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let endorsement_case = + let[@coq_axiom_with_reason "gadt"] endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -1154,7 +1154,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let dal_slot_availability_case = + let[@coq_axiom_with_reason "gadt"] dal_slot_availability_case = Case { op_case = Operation.Encoding.dal_slot_availability_case; @@ -1172,7 +1172,7 @@ module Encoding = struct inj = (fun delegate -> Dal_slot_availability_result {delegate}); } - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -1229,7 +1229,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let double_preendorsement_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -1250,7 +1250,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -1269,7 +1269,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -1288,7 +1288,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -1304,7 +1304,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -1320,7 +1320,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let make_manager_case (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -1403,7 +1403,7 @@ module Encoding = struct }); } - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -1413,7 +1413,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -1423,7 +1423,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -1433,7 +1433,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1443,7 +1443,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1455,7 +1455,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let set_deposits_limit_case = + let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1466,7 +1466,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_origination_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = make_manager_case Operation.Encoding.tx_rollup_origination_case Manager_result.tx_rollup_origination_case @@ -1477,7 +1477,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_submit_batch_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = make_manager_case Operation.Encoding.tx_rollup_submit_batch_case Manager_result.tx_rollup_submit_batch_case @@ -1488,7 +1488,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_commit_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = make_manager_case Operation.Encoding.tx_rollup_commit_case Manager_result.tx_rollup_commit_case @@ -1499,7 +1499,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_return_bond_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = make_manager_case Operation.Encoding.tx_rollup_return_bond_case Manager_result.tx_rollup_return_bond_case @@ -1510,7 +1510,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_finalize_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = make_manager_case Operation.Encoding.tx_rollup_finalize_commitment_case Manager_result.tx_rollup_finalize_commitment_case @@ -1522,7 +1522,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_remove_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = make_manager_case Operation.Encoding.tx_rollup_remove_commitment_case Manager_result.tx_rollup_remove_commitment_case @@ -1534,7 +1534,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_rejection_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = make_manager_case Operation.Encoding.tx_rollup_rejection_case Manager_result.tx_rollup_rejection_case @@ -1545,7 +1545,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_dispatch_tickets_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = make_manager_case Operation.Encoding.tx_rollup_dispatch_tickets_case Manager_result.tx_rollup_dispatch_tickets_case @@ -1557,7 +1557,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transfer_ticket_case = + let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = make_manager_case Operation.Encoding.transfer_ticket_case Manager_result.transfer_ticket_case @@ -1568,7 +1568,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let dal_publish_slot_header_case = + let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = make_manager_case Operation.Encoding.dal_publish_slot_header_case Manager_result.dal_publish_slot_header_case @@ -1580,7 +1580,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_originate_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = make_manager_case Operation.Encoding.sc_rollup_originate_case Manager_result.sc_rollup_originate_case @@ -1591,7 +1591,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_add_messages_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = make_manager_case Operation.Encoding.sc_rollup_add_messages_case Manager_result.sc_rollup_add_messages_case @@ -1602,7 +1602,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_cement_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = make_manager_case Operation.Encoding.sc_rollup_cement_case Manager_result.sc_rollup_cement_case @@ -1613,7 +1613,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_publish_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = make_manager_case Operation.Encoding.sc_rollup_publish_case Manager_result.sc_rollup_publish_case @@ -1624,7 +1624,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_refute_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_refute_case = make_manager_case Operation.Encoding.sc_rollup_refute_case Manager_result.sc_rollup_refute_case @@ -1635,7 +1635,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_timeout_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_timeout_case = make_manager_case Operation.Encoding.sc_rollup_timeout_case Manager_result.sc_rollup_timeout_case @@ -1646,7 +1646,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_execute_outbox_message_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_execute_outbox_message_case = make_manager_case Operation.Encoding.sc_rollup_execute_outbox_message_case Manager_result.sc_rollup_execute_outbox_message_case @@ -1658,7 +1658,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_recover_bond_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = make_manager_case Operation.Encoding.sc_rollup_recover_bond_case Manager_result.sc_rollup_recover_bond_case @@ -2618,7 +2618,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let rec pack_contents_list : +let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_alpha/lib_protocol/contract_repr.ml b/src/proto_alpha/lib_protocol/contract_repr.ml index 155115572d078..20045646df690 100644 --- a/src/proto_alpha/lib_protocol/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/contract_repr.ml @@ -190,7 +190,7 @@ let originated_contracts (Origination_nonce.{origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let rec contracts acc origination_index = + let[@coq_struct "origination_index"] rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index ab2f9660c8c3e..1d18c7117acf7 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -290,7 +290,7 @@ module S = struct end end -let register () = +let[@coq_axiom_with_reason "gadt"] register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field_gen ~filter_contract ~wrap_result ~chunked s f = diff --git a/src/proto_alpha/lib_protocol/level_storage.ml b/src/proto_alpha/lib_protocol/level_storage.ml index 952c50ec33759..852e8a84899b9 100644 --- a/src/proto_alpha/lib_protocol/level_storage.ml +++ b/src/proto_alpha/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let rec loop (n : Level_repr.t) acc = + let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 5ab45236477ae..12ee15cff4cf3 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -720,7 +720,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match (op1.contents, op2.contents) with + match[@coq_match_with_default] (op1.contents, op2.contents) with | Single (Preendorsement _), Single (Preendorsement _) -> 0 | Single (Preendorsement _), _ -> -1 | _, Single (Preendorsement _) -> 1 diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index dafe0f448ee7f..abbad29046c1d 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -232,7 +232,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let rec for_all a b f = + let[@coq_struct "a_value"] rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_alpha/lib_protocol/misc.ml b/src/proto_alpha/lib_protocol/misc.ml index d7c95b87aa3c4..bd350a5ef85b2 100644 --- a/src/proto_alpha/lib_protocol/misc.ml +++ b/src/proto_alpha/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let rec ( --> ) i j = +let[@coq_struct "i"] rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let rec ( <-- ) i j = +let[@coq_struct "j"] rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let rec ( ---> ) i j = +let[@coq_struct "i"] rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml index 0f2fad3891903..5501508072a0b 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/operation_repr.ml @@ -601,7 +601,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let reveal_case = + let[@coq_axiom_with_reason "gadt"] reveal_case = MCase { tag = 0; @@ -612,7 +612,7 @@ module Encoding = struct inj = (fun pkh -> Reveal pkh); } - let transaction_case = + let[@coq_axiom_with_reason "gadt"] transaction_case = MCase { tag = 1; @@ -649,7 +649,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let origination_case = + let[@coq_axiom_with_reason "gadt"] origination_case = MCase { tag = 2; @@ -670,7 +670,7 @@ module Encoding = struct Origination {credit; delegate; script}); } - let delegation_case = + let[@coq_axiom_with_reason "gadt"] delegation_case = MCase { tag = 3; @@ -682,7 +682,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let register_global_constant_case = + let[@coq_axiom_with_reason "gadt"] register_global_constant_case = MCase { tag = 4; @@ -695,7 +695,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let set_deposits_limit_case = + let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = MCase { tag = 5; @@ -708,7 +708,7 @@ module Encoding = struct inj = (fun key -> Set_deposits_limit key); } - let tx_rollup_origination_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = MCase { tag = tx_rollup_operation_origination_tag; @@ -727,7 +727,7 @@ module Encoding = struct encoding which is in hexadecimal for JSON. *) conv Bytes.of_string Bytes.to_string bytes - let tx_rollup_submit_batch_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = MCase { tag = tx_rollup_operation_submit_batch_tag; @@ -749,7 +749,7 @@ module Encoding = struct Tx_rollup_submit_batch {tx_rollup; content; burn_limit}); } - let tx_rollup_commit_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = MCase { tag = tx_rollup_operation_commit_tag; @@ -769,7 +769,7 @@ module Encoding = struct Tx_rollup_commit {tx_rollup; commitment}); } - let tx_rollup_return_bond_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = MCase { tag = tx_rollup_operation_return_bond_tag; @@ -782,7 +782,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_return_bond {tx_rollup}); } - let tx_rollup_finalize_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = MCase { tag = tx_rollup_operation_finalize_commitment_tag; @@ -797,7 +797,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_finalize_commitment {tx_rollup}); } - let tx_rollup_remove_commitment_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = MCase { tag = tx_rollup_operation_remove_commitment_tag; @@ -812,7 +812,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_remove_commitment {tx_rollup}); } - let tx_rollup_rejection_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = MCase { tag = tx_rollup_operation_rejection_tag; @@ -891,7 +891,7 @@ module Encoding = struct }); } - let tx_rollup_dispatch_tickets_case = + let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = MCase { tag = tx_rollup_operation_dispatch_tickets_tag; @@ -947,7 +947,7 @@ module Encoding = struct }); } - let transfer_ticket_case = + let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = MCase { tag = transfer_ticket_tag; @@ -974,7 +974,7 @@ module Encoding = struct {contents; ty; ticketer; amount; destination; entrypoint}); } - let sc_rollup_originate_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = MCase { tag = sc_rollup_operation_origination_tag; @@ -996,7 +996,7 @@ module Encoding = struct Sc_rollup_originate {kind; boot_sector; parameters_ty}); } - let dal_publish_slot_header_case = + let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = MCase { tag = dal_publish_slot_header_tag; @@ -1009,7 +1009,7 @@ module Encoding = struct inj = (fun slot -> Dal_publish_slot_header {slot}); } - let sc_rollup_add_messages_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = MCase { tag = sc_rollup_operation_add_message_tag; @@ -1029,7 +1029,7 @@ module Encoding = struct Sc_rollup_add_messages {rollup; messages}); } - let sc_rollup_cement_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = MCase { tag = sc_rollup_operation_cement_tag; @@ -1048,7 +1048,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_cement {rollup; commitment}); } - let sc_rollup_publish_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = MCase { tag = sc_rollup_operation_publish_tag; @@ -1067,7 +1067,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_publish {rollup; commitment}); } - let sc_rollup_refute_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_refute_case = MCase { tag = sc_rollup_operation_refute_tag; @@ -1091,7 +1091,7 @@ module Encoding = struct Sc_rollup_refute {rollup; opponent; refutation}); } - let sc_rollup_timeout_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_timeout_case = MCase { tag = sc_rollup_operation_timeout_tag; @@ -1109,7 +1109,7 @@ module Encoding = struct inj = (fun (rollup, stakers) -> Sc_rollup_timeout {rollup; stakers}); } - let sc_rollup_execute_outbox_message_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_execute_outbox_message_case = MCase { tag = sc_rollup_execute_outbox_message_tag; @@ -1136,7 +1136,7 @@ module Encoding = struct {rollup; cemented_commitment; output_proof}); } - let sc_rollup_recover_bond_case = + let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = MCase { tag = sc_rollup_operation_recover_bond_tag; @@ -1237,7 +1237,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun (Endorsement consensus_content) -> + (fun [@coq_match_with_default] (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -1247,7 +1247,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let endorsement_encoding = + let[@coq_axiom_with_reason "gadt"] endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -1284,7 +1284,7 @@ module Encoding = struct (function | Contents (Dal_slot_availability _ as op) -> Some op | _ -> None); proj = - (fun (Dal_slot_availability + (fun [@coq_match_with_default] (Dal_slot_availability (endorser, endorsement)) -> (endorser, endorsement)); inj = @@ -1292,7 +1292,7 @@ module Encoding = struct Dal_slot_availability (endorser, endorsement)); } - let seed_nonce_revelation_case = + let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = Case { tag = 1; @@ -1338,7 +1338,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let double_endorsement_evidence_case : + let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -1356,7 +1356,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let double_baking_evidence_case = + let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = Case { tag = 3; @@ -1372,7 +1372,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let activate_account_case = + let[@coq_axiom_with_reason "gadt"] activate_account_case = Case { tag = 4; @@ -1391,7 +1391,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let proposals_case = + let[@coq_axiom_with_reason "gadt"] proposals_case = Case { tag = 5; @@ -1411,7 +1411,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let ballot_case = + let[@coq_axiom_with_reason "gadt"] ballot_case = Case { tag = 6; @@ -1441,7 +1441,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function Failing_noop message -> message); + (function[@coq_match_with_default] Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -1454,7 +1454,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function + function[@coq_match_with_default] | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -1463,7 +1463,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let make_manager_case tag (type kind) + let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_alpha/lib_protocol/sapling_storage.ml b/src/proto_alpha/lib_protocol/sapling_storage.ml index 35ee7c2546a2c..3f151b7578472 100644 --- a/src/proto_alpha/lib_protocol/sapling_storage.ml +++ b/src/proto_alpha/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let rec insert ctx id node height pos cms = + let[@coq_struct "height"] rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let rec fold_from_height ctx id node ~pos ~f ~acc height + let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let rec aux acc pos = + let[@coq_struct "pos"] rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let rec aux ctx pos = + let[@coq_struct "pos"] rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index dc53f0ffa71e3..15ff0c3512818 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -291,7 +291,7 @@ let serialize_ty_for_error ty = *) unparse_ty_uncarbonated ~loc:() ty |> Micheline.strip_locations -let check_comparable : +let[@coq_axiom_with_reason "gadt"] check_comparable : type a ac. Script.location -> (a, ac) ty -> (ac, Dependent_bool.yes) eq tzresult = fun loc ty -> @@ -521,7 +521,7 @@ let comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_comparable_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -938,7 +938,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size + | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -970,7 +970,7 @@ type ('ret, 'name) parse_ty_ret = | Parse_entrypoints : (ex_parameter_ty_and_entrypoints_node, Entrypoint.t option) parse_ty_ret -let rec parse_ty : +let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty : type ret name. context -> stack_depth:int -> @@ -1310,7 +1310,7 @@ let rec parse_ty : T_unit; ] -and parse_comparable_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_comparable_ty : context -> stack_depth:int -> @@ -1334,7 +1334,7 @@ and parse_comparable_ty error (Comparable_type_expected (location node, Micheline.strip_locations node)) -and parse_passable_ty : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passable_ty : type ret name. context -> stack_depth:int -> @@ -1352,7 +1352,7 @@ and parse_passable_ty : ~allow_contract:true ~allow_ticket:true -and parse_any_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty : context -> stack_depth:int -> @@ -1370,7 +1370,7 @@ and parse_any_ty ~allow_ticket:true ~ret:Don't_parse_entrypoints -and parse_big_map_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1388,7 +1388,7 @@ and parse_big_map_ty (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and parse_big_map_value_ty +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2306,7 +2306,7 @@ let parse_toplevel : - storage after origination *) -let rec parse_data : +let[@coq_axiom_with_reason "gadt"] rec parse_data : type a ac. ?type_logger:type_logger -> stack_depth:int -> @@ -2829,7 +2829,7 @@ and parse_views : in Script_map.map_es_in_context aux ctxt views -and parse_returning : +and[@coq_axiom_with_reason "gadt"] parse_returning : type arg argc ret retc. ?type_logger:type_logger -> stack_depth:int -> @@ -2872,7 +2872,7 @@ and parse_returning : : (arg, ret) lambda), ctxt ) -and parse_instr : +and[@coq_axiom_with_reason "gadt"] parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -4854,7 +4854,7 @@ and parse_instr : I_XOR; ] -and parse_contract_data : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract_data : type arg argc. stack_depth:int -> context -> @@ -4886,7 +4886,7 @@ and parse_contract_data : The inner [result] is turned into an [option] by [parse_contract_for_script]. Both [tzresult] are merged by [parse_contract_data]. *) -and parse_contract : +and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : type arg argc err. stack_depth:int -> context -> @@ -5128,7 +5128,7 @@ let parse_storage : storage_type (root storage)) -let parse_script : +let[@coq_axiom_with_reason "gadt"] parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5274,7 +5274,7 @@ let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty) (* -- Unparsing data of any type -- *) -let rec unparse_data : +let[@coq_axiom_with_reason "gadt"] rec unparse_data : type a ac. context -> stack_depth:int -> @@ -5478,7 +5478,7 @@ and unparse_items : ([], ctxt) items -and unparse_code ctxt ~stack_depth mode code = +and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -5797,7 +5797,7 @@ let rec has_lazy_storage : type t tc. (t, tc) ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let extract_lazy_storage_updates ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a ac. @@ -5909,7 +5909,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let rec fold_lazy_storage : +let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : type a ac error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -5968,7 +5968,7 @@ let rec fold_lazy_storage : m (ok (Fold_lazy_storage.Ok init, ctxt)) -let collect_lazy_storage ctxt ty x = +let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -5978,7 +5978,7 @@ let collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let extract_lazy_storage_diff ctxt mode +let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6056,7 +6056,7 @@ let parse_ty = parse_ty ~stack_depth:0 ~ret:Don't_parse_entrypoints let parse_parameter_ty_and_entrypoints = parse_parameter_ty_and_entrypoints ~stack_depth:0 -let get_single_sapling_state ctxt ty x = +let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_alpha/lib_protocol/script_repr.ml b/src/proto_alpha/lib_protocol/script_repr.ml index 81e8474d5fd6e..681d6d7c627a5 100644 --- a/src/proto_alpha/lib_protocol/script_repr.ml +++ b/src/proto_alpha/lib_protocol/script_repr.ml @@ -117,7 +117,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let rec of_nodes acc nodes more_nodes = + let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -312,7 +312,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let rec strip_annotations node = +let[@coq_struct "node"] rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -330,7 +330,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and micheline_fold_nodes +and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_alpha/lib_protocol/seed_repr.ml b/src/proto_alpha/lib_protocol/seed_repr.ml index e0a6df765893d..23dc8fe39f521 100644 --- a/src/proto_alpha/lib_protocol/seed_repr.ml +++ b/src/proto_alpha/lib_protocol/seed_repr.ml @@ -215,7 +215,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = update_seed seed zero_bytes let initial_seeds ?initial_seed n = - let rec loop acc elt i = + let[@coq_struct "i"] rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_alpha/lib_protocol/storage_description.ml b/src/proto_alpha/lib_protocol/storage_description.ml index 7d5fc23ef679a..86aed867ac161 100644 --- a/src/proto_alpha/lib_protocol/storage_description.ml +++ b/src/proto_alpha/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let rec pp : +let[@coq_struct "function_parameter"] rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and pp_item : +and[@coq_mutual_as_notation] pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_alpha/lib_protocol/tez_repr.ml b/src/proto_alpha/lib_protocol/tez_repr.ml index 2da8256338748..99bbe0b87d09b 100644 --- a/src/proto_alpha/lib_protocol/tez_repr.ml +++ b/src/proto_alpha/lib_protocol/tez_repr.ml @@ -97,7 +97,7 @@ let of_string s = let pp ppf (Tez_tag amount) = let mult_int = 1_000_000L in - let rec left ppf amount = + let[@coq_struct "amount"] rec left ppf amount = let d, r = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r -- GitLab From 97388dd7f29bf79bd24d1cfad7b78aa84602819b Mon Sep 17 00:00:00 2001 From: Shubham Date: Tue, 28 Jun 2022 20:51:58 +0530 Subject: [PATCH 3/5] remove coq attributes only from src/proto_alpha --- src/proto_alpha/lib_plugin/RPC.ml | 2 +- src/proto_alpha/lib_protocol/apply.ml | 6 +- src/proto_alpha/lib_protocol/apply_results.ml | 106 +++++++++--------- src/proto_alpha/lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- src/proto_alpha/lib_protocol/level_storage.ml | 4 +- src/proto_alpha/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 2 +- src/proto_alpha/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 72 ++++++------ .../lib_protocol/sapling_storage.ml | 8 +- .../lib_protocol/script_ir_translator.ml | 44 ++++---- src/proto_alpha/lib_protocol/script_repr.ml | 6 +- src/proto_alpha/lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 4 +- src/proto_alpha/lib_protocol/tez_repr.ml | 2 +- 16 files changed, 135 insertions(+), 135 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index dd9c58546ded1..9fa6037840732 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -2324,7 +2324,7 @@ module Forge = struct return (Tx_rollup_withdraw_list_hash.hash_uncarbonated withdrawals)) module Manager = struct - let[@coq_axiom_with_reason "cast on e"] operations ctxt block ~branch + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 3462c7fb0d97a..0a5def747fdca 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1884,7 +1884,7 @@ let apply_external_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let[@coq_struct "ctxt"] rec apply ctxt applied worklist = + let rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Script_typed_ir.Internal_operation ({source; operation; nonce} as op) @@ -2146,7 +2146,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_manager_operation_result list) Lwt.t = - let[@coq_match_with_default] (Manager_operation + let (Manager_operation { source; operation; @@ -2864,7 +2864,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match[@coq_match_with_default] contents_list with + match contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index 824c7b4bdeef6..0559065ddff7b 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -274,7 +274,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; select; proj; inj; t} - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -287,7 +287,7 @@ module Manager_result = struct ~proj:(function Reveal_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Reveal_result {consumed_gas}) - let[@coq_axiom_with_reason "gadt"] transaction_contract_variant_cases = + let transaction_contract_variant_cases = union [ case @@ -400,7 +400,7 @@ module Manager_result = struct (fun consumed_gas -> Transaction_to_event_result {consumed_gas}); ] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding:transaction_contract_variant_cases @@ -411,7 +411,7 @@ module Manager_result = struct ~proj:(function Transaction_result x -> x) ~inj:(fun x -> Transaction_result x) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -464,7 +464,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -498,7 +498,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function[@coq_match_with_default] + ~proj:(function | Delegation_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Delegation_result {consumed_gas}) @@ -517,7 +517,7 @@ module Manager_result = struct | Set_deposits_limit_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Set_deposits_limit_result {consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_origination_case ~encoding: @@ -539,7 +539,7 @@ module Manager_result = struct Tx_rollup_origination_result {balance_updates; consumed_gas; originated_tx_rollup}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_submit_batch_case ~encoding: @@ -561,7 +561,7 @@ module Manager_result = struct Tx_rollup_submit_batch_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_commit_case ~encoding: @@ -579,7 +579,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_commit_result {balance_updates; consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_return_bond_case ~encoding: @@ -598,7 +598,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_return_bond_result {balance_updates; consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_finalize_commitment_case @@ -622,7 +622,7 @@ module Manager_result = struct Tx_rollup_finalize_commitment_result {balance_updates; consumed_gas; level}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_remove_commitment_case @@ -646,7 +646,7 @@ module Manager_result = struct Tx_rollup_remove_commitment_result {balance_updates; consumed_gas; level}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_rejection_case ~encoding: @@ -665,7 +665,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_rejection_result {balance_updates; consumed_gas}) - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_dispatch_tickets_case @@ -689,7 +689,7 @@ module Manager_result = struct Tx_rollup_dispatch_tickets_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = make ~op_case:Operation.Encoding.Manager_operations.transfer_ticket_case ~encoding: @@ -710,7 +710,7 @@ module Manager_result = struct Transfer_ticket_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = + let dal_publish_slot_header_case = make ~op_case: Operation.Encoding.Manager_operations.dal_publish_slot_header_case @@ -725,7 +725,7 @@ module Manager_result = struct ~kind:Kind.Dal_publish_slot_header_manager_kind ~inj:(fun consumed_gas -> Dal_publish_slot_header_result {consumed_gas}) - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_originate_case ~encoding: @@ -863,7 +863,7 @@ module Manager_result = struct Sc_rollup_execute_outbox_message_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_recover_bond_case ~encoding: @@ -1101,7 +1101,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let[@coq_axiom_with_reason "gadt"] preendorsement_case = + let preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -1129,7 +1129,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let[@coq_axiom_with_reason "gadt"] endorsement_case = + let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -1154,7 +1154,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let[@coq_axiom_with_reason "gadt"] dal_slot_availability_case = + let dal_slot_availability_case = Case { op_case = Operation.Encoding.dal_slot_availability_case; @@ -1172,7 +1172,7 @@ module Encoding = struct inj = (fun delegate -> Dal_slot_availability_result {delegate}); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -1229,7 +1229,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case = + let double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -1250,7 +1250,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -1269,7 +1269,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -1288,7 +1288,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -1304,7 +1304,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -1320,7 +1320,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let[@coq_axiom_with_reason "gadt"] make_manager_case (type kind) + let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -1403,7 +1403,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -1413,7 +1413,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -1423,7 +1423,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -1433,7 +1433,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1443,7 +1443,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1455,7 +1455,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1466,7 +1466,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = make_manager_case Operation.Encoding.tx_rollup_origination_case Manager_result.tx_rollup_origination_case @@ -1477,7 +1477,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make_manager_case Operation.Encoding.tx_rollup_submit_batch_case Manager_result.tx_rollup_submit_batch_case @@ -1488,7 +1488,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = make_manager_case Operation.Encoding.tx_rollup_commit_case Manager_result.tx_rollup_commit_case @@ -1499,7 +1499,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make_manager_case Operation.Encoding.tx_rollup_return_bond_case Manager_result.tx_rollup_return_bond_case @@ -1510,7 +1510,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make_manager_case Operation.Encoding.tx_rollup_finalize_commitment_case Manager_result.tx_rollup_finalize_commitment_case @@ -1522,7 +1522,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make_manager_case Operation.Encoding.tx_rollup_remove_commitment_case Manager_result.tx_rollup_remove_commitment_case @@ -1534,7 +1534,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = make_manager_case Operation.Encoding.tx_rollup_rejection_case Manager_result.tx_rollup_rejection_case @@ -1545,7 +1545,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make_manager_case Operation.Encoding.tx_rollup_dispatch_tickets_case Manager_result.tx_rollup_dispatch_tickets_case @@ -1557,7 +1557,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = make_manager_case Operation.Encoding.transfer_ticket_case Manager_result.transfer_ticket_case @@ -1568,7 +1568,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = + let dal_publish_slot_header_case = make_manager_case Operation.Encoding.dal_publish_slot_header_case Manager_result.dal_publish_slot_header_case @@ -1580,7 +1580,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = make_manager_case Operation.Encoding.sc_rollup_originate_case Manager_result.sc_rollup_originate_case @@ -1591,7 +1591,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = make_manager_case Operation.Encoding.sc_rollup_add_messages_case Manager_result.sc_rollup_add_messages_case @@ -1602,7 +1602,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = + let sc_rollup_cement_case = make_manager_case Operation.Encoding.sc_rollup_cement_case Manager_result.sc_rollup_cement_case @@ -1613,7 +1613,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = + let sc_rollup_publish_case = make_manager_case Operation.Encoding.sc_rollup_publish_case Manager_result.sc_rollup_publish_case @@ -1624,7 +1624,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_refute_case = + let sc_rollup_refute_case = make_manager_case Operation.Encoding.sc_rollup_refute_case Manager_result.sc_rollup_refute_case @@ -1635,7 +1635,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_timeout_case = + let sc_rollup_timeout_case = make_manager_case Operation.Encoding.sc_rollup_timeout_case Manager_result.sc_rollup_timeout_case @@ -1646,7 +1646,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_execute_outbox_message_case = + let sc_rollup_execute_outbox_message_case = make_manager_case Operation.Encoding.sc_rollup_execute_outbox_message_case Manager_result.sc_rollup_execute_outbox_message_case @@ -1658,7 +1658,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = make_manager_case Operation.Encoding.sc_rollup_recover_bond_case Manager_result.sc_rollup_recover_bond_case @@ -2618,7 +2618,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let[@coq_axiom_with_reason "gadt"] rec pack_contents_list : +let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_alpha/lib_protocol/contract_repr.ml b/src/proto_alpha/lib_protocol/contract_repr.ml index 20045646df690..155115572d078 100644 --- a/src/proto_alpha/lib_protocol/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/contract_repr.ml @@ -190,7 +190,7 @@ let originated_contracts (Origination_nonce.{origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let[@coq_struct "origination_index"] rec contracts acc origination_index = + let rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index 1d18c7117acf7..ab2f9660c8c3e 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -290,7 +290,7 @@ module S = struct end end -let[@coq_axiom_with_reason "gadt"] register () = +let register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field_gen ~filter_contract ~wrap_result ~chunked s f = diff --git a/src/proto_alpha/lib_protocol/level_storage.ml b/src/proto_alpha/lib_protocol/level_storage.ml index 852e8a84899b9..952c50ec33759 100644 --- a/src/proto_alpha/lib_protocol/level_storage.ml +++ b/src/proto_alpha/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let[@coq_struct "n"] rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 12ee15cff4cf3..5ab45236477ae 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -720,7 +720,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match[@coq_match_with_default] (op1.contents, op2.contents) with + match (op1.contents, op2.contents) with | Single (Preendorsement _), Single (Preendorsement _) -> 0 | Single (Preendorsement _), _ -> -1 | _, Single (Preendorsement _) -> 1 diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index abbad29046c1d..dafe0f448ee7f 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -232,7 +232,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let[@coq_struct "a_value"] rec for_all a b f = + let rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in diff --git a/src/proto_alpha/lib_protocol/misc.ml b/src/proto_alpha/lib_protocol/misc.ml index bd350a5ef85b2..d7c95b87aa3c4 100644 --- a/src/proto_alpha/lib_protocol/misc.ml +++ b/src/proto_alpha/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let[@coq_struct "i"] rec ( --> ) i j = +let rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let[@coq_struct "j"] rec ( <-- ) i j = +let rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let[@coq_struct "i"] rec ( ---> ) i j = +let rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml index 5501508072a0b..0f2fad3891903 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/operation_repr.ml @@ -601,7 +601,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let[@coq_axiom_with_reason "gadt"] reveal_case = + let reveal_case = MCase { tag = 0; @@ -612,7 +612,7 @@ module Encoding = struct inj = (fun pkh -> Reveal pkh); } - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { tag = 1; @@ -649,7 +649,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { tag = 2; @@ -670,7 +670,7 @@ module Encoding = struct Origination {credit; delegate; script}); } - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { tag = 3; @@ -682,7 +682,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let[@coq_axiom_with_reason "gadt"] register_global_constant_case = + let register_global_constant_case = MCase { tag = 4; @@ -695,7 +695,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let[@coq_axiom_with_reason "gadt"] set_deposits_limit_case = + let set_deposits_limit_case = MCase { tag = 5; @@ -708,7 +708,7 @@ module Encoding = struct inj = (fun key -> Set_deposits_limit key); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_origination_case = + let tx_rollup_origination_case = MCase { tag = tx_rollup_operation_origination_tag; @@ -727,7 +727,7 @@ module Encoding = struct encoding which is in hexadecimal for JSON. *) conv Bytes.of_string Bytes.to_string bytes - let[@coq_axiom_with_reason "gadt"] tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = MCase { tag = tx_rollup_operation_submit_batch_tag; @@ -749,7 +749,7 @@ module Encoding = struct Tx_rollup_submit_batch {tx_rollup; content; burn_limit}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_commit_case = + let tx_rollup_commit_case = MCase { tag = tx_rollup_operation_commit_tag; @@ -769,7 +769,7 @@ module Encoding = struct Tx_rollup_commit {tx_rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = MCase { tag = tx_rollup_operation_return_bond_tag; @@ -782,7 +782,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_return_bond {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = MCase { tag = tx_rollup_operation_finalize_commitment_tag; @@ -797,7 +797,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_finalize_commitment {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = MCase { tag = tx_rollup_operation_remove_commitment_tag; @@ -812,7 +812,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_remove_commitment {tx_rollup}); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_rejection_case = + let tx_rollup_rejection_case = MCase { tag = tx_rollup_operation_rejection_tag; @@ -891,7 +891,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = MCase { tag = tx_rollup_operation_dispatch_tickets_tag; @@ -947,7 +947,7 @@ module Encoding = struct }); } - let[@coq_axiom_with_reason "gadt"] transfer_ticket_case = + let transfer_ticket_case = MCase { tag = transfer_ticket_tag; @@ -974,7 +974,7 @@ module Encoding = struct {contents; ty; ticketer; amount; destination; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_originate_case = + let sc_rollup_originate_case = MCase { tag = sc_rollup_operation_origination_tag; @@ -996,7 +996,7 @@ module Encoding = struct Sc_rollup_originate {kind; boot_sector; parameters_ty}); } - let[@coq_axiom_with_reason "gadt"] dal_publish_slot_header_case = + let dal_publish_slot_header_case = MCase { tag = dal_publish_slot_header_tag; @@ -1009,7 +1009,7 @@ module Encoding = struct inj = (fun slot -> Dal_publish_slot_header {slot}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = MCase { tag = sc_rollup_operation_add_message_tag; @@ -1029,7 +1029,7 @@ module Encoding = struct Sc_rollup_add_messages {rollup; messages}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_cement_case = + let sc_rollup_cement_case = MCase { tag = sc_rollup_operation_cement_tag; @@ -1048,7 +1048,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_cement {rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_publish_case = + let sc_rollup_publish_case = MCase { tag = sc_rollup_operation_publish_tag; @@ -1067,7 +1067,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_publish {rollup; commitment}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_refute_case = + let sc_rollup_refute_case = MCase { tag = sc_rollup_operation_refute_tag; @@ -1091,7 +1091,7 @@ module Encoding = struct Sc_rollup_refute {rollup; opponent; refutation}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_timeout_case = + let sc_rollup_timeout_case = MCase { tag = sc_rollup_operation_timeout_tag; @@ -1109,7 +1109,7 @@ module Encoding = struct inj = (fun (rollup, stakers) -> Sc_rollup_timeout {rollup; stakers}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_execute_outbox_message_case = + let sc_rollup_execute_outbox_message_case = MCase { tag = sc_rollup_execute_outbox_message_tag; @@ -1136,7 +1136,7 @@ module Encoding = struct {rollup; cemented_commitment; output_proof}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = MCase { tag = sc_rollup_operation_recover_bond_tag; @@ -1237,7 +1237,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun [@coq_match_with_default] (Endorsement consensus_content) -> + (fun (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -1247,7 +1247,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let[@coq_axiom_with_reason "gadt"] endorsement_encoding = + let endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -1284,7 +1284,7 @@ module Encoding = struct (function | Contents (Dal_slot_availability _ as op) -> Some op | _ -> None); proj = - (fun [@coq_match_with_default] (Dal_slot_availability + (fun (Dal_slot_availability (endorser, endorsement)) -> (endorser, endorsement)); inj = @@ -1292,7 +1292,7 @@ module Encoding = struct Dal_slot_availability (endorser, endorsement)); } - let[@coq_axiom_with_reason "gadt"] seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { tag = 1; @@ -1338,7 +1338,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case : + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { @@ -1356,7 +1356,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let[@coq_axiom_with_reason "gadt"] double_baking_evidence_case = + let double_baking_evidence_case = Case { tag = 3; @@ -1372,7 +1372,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let[@coq_axiom_with_reason "gadt"] activate_account_case = + let activate_account_case = Case { tag = 4; @@ -1391,7 +1391,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let[@coq_axiom_with_reason "gadt"] proposals_case = + let proposals_case = Case { tag = 5; @@ -1411,7 +1411,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let[@coq_axiom_with_reason "gadt"] ballot_case = + let ballot_case = Case { tag = 6; @@ -1441,7 +1441,7 @@ module Encoding = struct select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); proj = - (function[@coq_match_with_default] Failing_noop message -> message); + (function Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -1454,7 +1454,7 @@ module Encoding = struct (req "storage_limit" (check_size 10 n)) let extract : type kind. kind Kind.manager contents -> _ = - function[@coq_match_with_default] + function | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -1463,7 +1463,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let[@coq_axiom_with_reason "gadt"] make_manager_case tag (type kind) + let make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_alpha/lib_protocol/sapling_storage.ml b/src/proto_alpha/lib_protocol/sapling_storage.ml index 3f151b7578472..35ee7c2546a2c 100644 --- a/src/proto_alpha/lib_protocol/sapling_storage.ml +++ b/src/proto_alpha/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let[@coq_struct "height"] rec insert ctx id node height pos cms = + let rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,7 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let[@coq_struct "height"] rec fold_from_height ctx id node ~pos ~f ~acc height + let rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; @@ -279,7 +279,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let[@coq_struct "pos"] rec aux acc pos = + let rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +306,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let[@coq_struct "pos"] rec aux ctx pos = + let rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 15ff0c3512818..dc53f0ffa71e3 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -291,7 +291,7 @@ let serialize_ty_for_error ty = *) unparse_ty_uncarbonated ~loc:() ty |> Micheline.strip_locations -let[@coq_axiom_with_reason "gadt"] check_comparable : +let check_comparable : type a ac. Script.location -> (a, ac) ty -> (ac, Dependent_bool.yes) eq tzresult = fun loc ty -> @@ -521,7 +521,7 @@ let comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let[@coq_axiom_with_reason "gadt"] rec unparse_comparable_data : +let rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -938,7 +938,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast] + | Ok _ as ok_memo_size -> ok_memo_size | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -970,7 +970,7 @@ type ('ret, 'name) parse_ty_ret = | Parse_entrypoints : (ex_parameter_ty_and_entrypoints_node, Entrypoint.t option) parse_ty_ret -let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty : +let rec parse_ty : type ret name. context -> stack_depth:int -> @@ -1310,7 +1310,7 @@ let[@coq_axiom_with_reason "complex mutually recursive definition"] rec parse_ty T_unit; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_comparable_ty +and parse_comparable_ty : context -> stack_depth:int -> @@ -1334,7 +1334,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_compar error (Comparable_type_expected (location node, Micheline.strip_locations node)) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passable_ty : +and parse_passable_ty : type ret name. context -> stack_depth:int -> @@ -1352,7 +1352,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_passab ~allow_contract:true ~allow_ticket:true -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty +and parse_any_ty : context -> stack_depth:int -> @@ -1370,7 +1370,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_any_ty ~allow_ticket:true ~ret:Don't_parse_entrypoints -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_ty +and parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with @@ -1388,7 +1388,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_ma (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_big_map_value_ty +and parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt @@ -2306,7 +2306,7 @@ let parse_toplevel : - storage after origination *) -let[@coq_axiom_with_reason "gadt"] rec parse_data : +let rec parse_data : type a ac. ?type_logger:type_logger -> stack_depth:int -> @@ -2829,7 +2829,7 @@ and parse_views : in Script_map.map_es_in_context aux ctxt views -and[@coq_axiom_with_reason "gadt"] parse_returning : +and parse_returning : type arg argc ret retc. ?type_logger:type_logger -> stack_depth:int -> @@ -2872,7 +2872,7 @@ and[@coq_axiom_with_reason "gadt"] parse_returning : : (arg, ret) lambda), ctxt ) -and[@coq_axiom_with_reason "gadt"] parse_instr : +and parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -4854,7 +4854,7 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : I_XOR; ] -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract_data : +and parse_contract_data : type arg argc. stack_depth:int -> context -> @@ -4886,7 +4886,7 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contra The inner [result] is turned into an [option] by [parse_contract_for_script]. Both [tzresult] are merged by [parse_contract_data]. *) -and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contract : +and parse_contract : type arg argc err. stack_depth:int -> context -> @@ -5128,7 +5128,7 @@ let parse_storage : storage_type (root storage)) -let[@coq_axiom_with_reason "gadt"] parse_script : +let parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5274,7 +5274,7 @@ let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty) (* -- Unparsing data of any type -- *) -let[@coq_axiom_with_reason "gadt"] rec unparse_data : +let rec unparse_data : type a ac. context -> stack_depth:int -> @@ -5478,7 +5478,7 @@ and unparse_items : ([], ctxt) items -and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code = +and unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -5797,7 +5797,7 @@ let rec has_lazy_storage : type t tc. (t, tc) ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode +let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a ac. @@ -5909,7 +5909,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : +let rec fold_lazy_storage : type a ac error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -5968,7 +5968,7 @@ let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage : m (ok (Fold_lazy_storage.Ok init, ctxt)) -let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = +let collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -5978,7 +5978,7 @@ let[@coq_axiom_with_reason "gadt"] collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_diff ctxt mode +let extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids @@ -6056,7 +6056,7 @@ let parse_ty = parse_ty ~stack_depth:0 ~ret:Don't_parse_entrypoints let parse_parameter_ty_and_entrypoints = parse_parameter_ty_and_entrypoints ~stack_depth:0 -let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x = +let get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_alpha/lib_protocol/script_repr.ml b/src/proto_alpha/lib_protocol/script_repr.ml index 681d6d7c627a5..81e8474d5fd6e 100644 --- a/src/proto_alpha/lib_protocol/script_repr.ml +++ b/src/proto_alpha/lib_protocol/script_repr.ml @@ -117,7 +117,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let[@coq_struct "nodes"] rec of_nodes acc nodes more_nodes = + let rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -312,7 +312,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let[@coq_struct "node"] rec strip_annotations node = +let rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -330,7 +330,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and[@coq_mutual_as_notation] [@coq_struct "subterms"] micheline_fold_nodes +and micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc diff --git a/src/proto_alpha/lib_protocol/seed_repr.ml b/src/proto_alpha/lib_protocol/seed_repr.ml index 23dc8fe39f521..e0a6df765893d 100644 --- a/src/proto_alpha/lib_protocol/seed_repr.ml +++ b/src/proto_alpha/lib_protocol/seed_repr.ml @@ -215,7 +215,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = update_seed seed zero_bytes let initial_seeds ?initial_seed n = - let[@coq_struct "i"] rec loop acc elt i = + let rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_alpha/lib_protocol/storage_description.ml b/src/proto_alpha/lib_protocol/storage_description.ml index 86aed867ac161..7d5fc23ef679a 100644 --- a/src/proto_alpha/lib_protocol/storage_description.ml +++ b/src/proto_alpha/lib_protocol/storage_description.ml @@ -56,7 +56,7 @@ and 'key description = } -> 'key description -let[@coq_struct "function_parameter"] rec pp : +let rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with @@ -72,7 +72,7 @@ let[@coq_struct "function_parameter"] rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and[@coq_mutual_as_notation] pp_item : +and pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc diff --git a/src/proto_alpha/lib_protocol/tez_repr.ml b/src/proto_alpha/lib_protocol/tez_repr.ml index 99bbe0b87d09b..2da8256338748 100644 --- a/src/proto_alpha/lib_protocol/tez_repr.ml +++ b/src/proto_alpha/lib_protocol/tez_repr.ml @@ -97,7 +97,7 @@ let of_string s = let pp ppf (Tez_tag amount) = let mult_int = 1_000_000L in - let[@coq_struct "amount"] rec left ppf amount = + let rec left ppf amount = let d, r = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r -- GitLab From 793c9bf57bae099541f4a1dac5f801f8f2354cab Mon Sep 17 00:00:00 2001 From: Shubham Date: Tue, 28 Jun 2022 21:15:26 +0530 Subject: [PATCH 4/5] update code with correct formatting --- src/proto_alpha/lib_plugin/RPC.ml | 5 +- src/proto_alpha/lib_protocol/apply.ml | 4 +- src/proto_alpha/lib_protocol/apply_results.ml | 107 +++++++++--------- src/proto_alpha/lib_protocol/contract_repr.ml | 2 +- .../lib_protocol/contract_services.ml | 2 +- src/proto_alpha/lib_protocol/level_storage.ml | 4 +- src/proto_alpha/lib_protocol/main.ml | 2 +- .../lib_protocol/michelson_v1_primitives.ml | 4 +- src/proto_alpha/lib_protocol/misc.ml | 6 +- .../lib_protocol/operation_repr.ml | 76 ++++++------- .../lib_protocol/sapling_storage.ml | 9 +- .../lib_protocol/script_ir_translator.ml | 51 ++++----- src/proto_alpha/lib_protocol/script_repr.ml | 7 +- src/proto_alpha/lib_protocol/seed_repr.ml | 2 +- .../lib_protocol/storage_description.ml | 6 +- src/proto_alpha/lib_protocol/tez_repr.ml | 2 +- 16 files changed, 136 insertions(+), 153 deletions(-) diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml index 9fa6037840732..7550c231055b2 100644 --- a/src/proto_alpha/lib_plugin/RPC.ml +++ b/src/proto_alpha/lib_plugin/RPC.ml @@ -2324,9 +2324,8 @@ module Forge = struct return (Tx_rollup_withdraw_list_hash.hash_uncarbonated withdrawals)) module Manager = struct - let operations ctxt block ~branch - ~source ?sourcePubKey ~counter ~fee ~gas_limit ~storage_limit operations - = + let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee + ~gas_limit ~storage_limit operations = Contract_services.manager_key ctxt block source >>= function | Error _ as e -> Lwt.return e | Ok revealed -> diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index 0a5def747fdca..d14c330ea710b 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -1884,7 +1884,7 @@ let apply_external_manager_operation_content : type success_or_failure = Success of context | Failure let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops = - let rec apply ctxt applied worklist = + let rec apply ctxt applied worklist = match worklist with | [] -> Lwt.return (Success ctxt, List.rev applied) | Script_typed_ir.Internal_operation ({source; operation; nonce} as op) @@ -2864,7 +2864,7 @@ let apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode | Partial_construction _ -> true | Full_construction _ | Application _ -> false in - match contents_list with + match contents_list with | Single (Preendorsement consensus_content) -> validate_consensus_contents ctxt diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index 0559065ddff7b..296461999608a 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -274,7 +274,7 @@ module Manager_result = struct in MCase {op_case; encoding; kind; select; proj; inj; t} - let reveal_case = + let reveal_case = make ~op_case:Operation.Encoding.Manager_operations.reveal_case ~encoding: @@ -287,7 +287,7 @@ module Manager_result = struct ~proj:(function Reveal_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Reveal_result {consumed_gas}) - let transaction_contract_variant_cases = + let transaction_contract_variant_cases = union [ case @@ -400,7 +400,7 @@ module Manager_result = struct (fun consumed_gas -> Transaction_to_event_result {consumed_gas}); ] - let transaction_case = + let transaction_case = make ~op_case:Operation.Encoding.Manager_operations.transaction_case ~encoding:transaction_contract_variant_cases @@ -411,7 +411,7 @@ module Manager_result = struct ~proj:(function Transaction_result x -> x) ~inj:(fun x -> Transaction_result x) - let origination_case = + let origination_case = make ~op_case:Operation.Encoding.Manager_operations.origination_case ~encoding: @@ -464,7 +464,7 @@ module Manager_result = struct paid_storage_size_diff; }) - let register_global_constant_case = + let register_global_constant_case = make ~op_case: Operation.Encoding.Manager_operations.register_global_constant_case @@ -498,8 +498,7 @@ module Manager_result = struct | Successful_manager_result (Delegation_result _ as op) -> Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function - | Delegation_result {consumed_gas} -> consumed_gas) + ~proj:(function Delegation_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Delegation_result {consumed_gas}) let set_deposits_limit_case = @@ -517,7 +516,7 @@ module Manager_result = struct | Set_deposits_limit_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> Set_deposits_limit_result {consumed_gas}) - let tx_rollup_origination_case = + let tx_rollup_origination_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_origination_case ~encoding: @@ -539,7 +538,7 @@ module Manager_result = struct Tx_rollup_origination_result {balance_updates; consumed_gas; originated_tx_rollup}) - let tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_submit_batch_case ~encoding: @@ -561,7 +560,7 @@ module Manager_result = struct Tx_rollup_submit_batch_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let tx_rollup_commit_case = + let tx_rollup_commit_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_commit_case ~encoding: @@ -579,7 +578,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_commit_result {balance_updates; consumed_gas}) - let tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_return_bond_case ~encoding: @@ -598,7 +597,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_return_bond_result {balance_updates; consumed_gas}) - let tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_finalize_commitment_case @@ -622,7 +621,7 @@ module Manager_result = struct Tx_rollup_finalize_commitment_result {balance_updates; consumed_gas; level}) - let tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_remove_commitment_case @@ -646,7 +645,7 @@ module Manager_result = struct Tx_rollup_remove_commitment_result {balance_updates; consumed_gas; level}) - let tx_rollup_rejection_case = + let tx_rollup_rejection_case = make ~op_case:Operation.Encoding.Manager_operations.tx_rollup_rejection_case ~encoding: @@ -665,7 +664,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Tx_rollup_rejection_result {balance_updates; consumed_gas}) - let tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make ~op_case: Operation.Encoding.Manager_operations.tx_rollup_dispatch_tickets_case @@ -689,7 +688,7 @@ module Manager_result = struct Tx_rollup_dispatch_tickets_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let transfer_ticket_case = + let transfer_ticket_case = make ~op_case:Operation.Encoding.Manager_operations.transfer_ticket_case ~encoding: @@ -710,7 +709,7 @@ module Manager_result = struct Transfer_ticket_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let dal_publish_slot_header_case = + let dal_publish_slot_header_case = make ~op_case: Operation.Encoding.Manager_operations.dal_publish_slot_header_case @@ -725,7 +724,7 @@ module Manager_result = struct ~kind:Kind.Dal_publish_slot_header_manager_kind ~inj:(fun consumed_gas -> Dal_publish_slot_header_result {consumed_gas}) - let sc_rollup_originate_case = + let sc_rollup_originate_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_originate_case ~encoding: @@ -863,7 +862,7 @@ module Manager_result = struct Sc_rollup_execute_outbox_message_result {balance_updates; consumed_gas; paid_storage_size_diff}) - let sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = make ~op_case:Operation.Encoding.Manager_operations.sc_rollup_recover_bond_case ~encoding: @@ -1101,7 +1100,7 @@ module Encoding = struct (fun x -> match proj x with None -> None | Some x -> Some ((), x)) (fun ((), x) -> inj x) - let preendorsement_case = + let preendorsement_case = Case { op_case = Operation.Encoding.preendorsement_case; @@ -1129,7 +1128,7 @@ module Encoding = struct {balance_updates; delegate; preendorsement_power}); } - let endorsement_case = + let endorsement_case = Case { op_case = Operation.Encoding.endorsement_case; @@ -1154,7 +1153,7 @@ module Encoding = struct Endorsement_result {balance_updates; delegate; endorsement_power}); } - let dal_slot_availability_case = + let dal_slot_availability_case = Case { op_case = Operation.Encoding.dal_slot_availability_case; @@ -1172,7 +1171,7 @@ module Encoding = struct inj = (fun delegate -> Dal_slot_availability_result {delegate}); } - let seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { op_case = Operation.Encoding.seed_nonce_revelation_case; @@ -1229,7 +1228,7 @@ module Encoding = struct inj = (fun bus -> Double_endorsement_evidence_result bus); } - let double_preendorsement_evidence_case = + let double_preendorsement_evidence_case = Case { op_case = Operation.Encoding.double_preendorsement_evidence_case; @@ -1250,7 +1249,7 @@ module Encoding = struct inj = (fun bus -> Double_preendorsement_evidence_result bus); } - let double_baking_evidence_case = + let double_baking_evidence_case = Case { op_case = Operation.Encoding.double_baking_evidence_case; @@ -1269,7 +1268,7 @@ module Encoding = struct inj = (fun bus -> Double_baking_evidence_result bus); } - let activate_account_case = + let activate_account_case = Case { op_case = Operation.Encoding.activate_account_case; @@ -1288,7 +1287,7 @@ module Encoding = struct inj = (fun bus -> Activate_account_result bus); } - let proposals_case = + let proposals_case = Case { op_case = Operation.Encoding.proposals_case; @@ -1304,7 +1303,7 @@ module Encoding = struct inj = (fun () -> Proposals_result); } - let ballot_case = + let ballot_case = Case { op_case = Operation.Encoding.ballot_case; @@ -1320,7 +1319,7 @@ module Encoding = struct inj = (fun () -> Ballot_result); } - let make_manager_case (type kind) + let make_manager_case (type kind) (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case) (Manager_result.MCase res_case : kind Manager_result.case) mselect = @@ -1403,7 +1402,7 @@ module Encoding = struct }); } - let reveal_case = + let reveal_case = make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case @@ -1413,7 +1412,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transaction_case = + let transaction_case = make_manager_case Operation.Encoding.transaction_case Manager_result.transaction_case @@ -1423,7 +1422,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let origination_case = + let origination_case = make_manager_case Operation.Encoding.origination_case Manager_result.origination_case @@ -1433,7 +1432,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let delegation_case = + let delegation_case = make_manager_case Operation.Encoding.delegation_case Manager_result.delegation_case @@ -1443,7 +1442,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let register_global_constant_case = + let register_global_constant_case = make_manager_case Operation.Encoding.register_global_constant_case Manager_result.register_global_constant_case @@ -1455,7 +1454,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let set_deposits_limit_case = + let set_deposits_limit_case = make_manager_case Operation.Encoding.set_deposits_limit_case Manager_result.set_deposits_limit_case @@ -1466,7 +1465,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_origination_case = + let tx_rollup_origination_case = make_manager_case Operation.Encoding.tx_rollup_origination_case Manager_result.tx_rollup_origination_case @@ -1477,7 +1476,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = make_manager_case Operation.Encoding.tx_rollup_submit_batch_case Manager_result.tx_rollup_submit_batch_case @@ -1488,7 +1487,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_commit_case = + let tx_rollup_commit_case = make_manager_case Operation.Encoding.tx_rollup_commit_case Manager_result.tx_rollup_commit_case @@ -1499,7 +1498,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = make_manager_case Operation.Encoding.tx_rollup_return_bond_case Manager_result.tx_rollup_return_bond_case @@ -1510,7 +1509,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = make_manager_case Operation.Encoding.tx_rollup_finalize_commitment_case Manager_result.tx_rollup_finalize_commitment_case @@ -1522,7 +1521,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = make_manager_case Operation.Encoding.tx_rollup_remove_commitment_case Manager_result.tx_rollup_remove_commitment_case @@ -1534,7 +1533,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_rejection_case = + let tx_rollup_rejection_case = make_manager_case Operation.Encoding.tx_rollup_rejection_case Manager_result.tx_rollup_rejection_case @@ -1545,7 +1544,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = make_manager_case Operation.Encoding.tx_rollup_dispatch_tickets_case Manager_result.tx_rollup_dispatch_tickets_case @@ -1557,7 +1556,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let transfer_ticket_case = + let transfer_ticket_case = make_manager_case Operation.Encoding.transfer_ticket_case Manager_result.transfer_ticket_case @@ -1568,7 +1567,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let dal_publish_slot_header_case = + let dal_publish_slot_header_case = make_manager_case Operation.Encoding.dal_publish_slot_header_case Manager_result.dal_publish_slot_header_case @@ -1580,7 +1579,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_originate_case = + let sc_rollup_originate_case = make_manager_case Operation.Encoding.sc_rollup_originate_case Manager_result.sc_rollup_originate_case @@ -1591,7 +1590,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = make_manager_case Operation.Encoding.sc_rollup_add_messages_case Manager_result.sc_rollup_add_messages_case @@ -1602,7 +1601,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_cement_case = + let sc_rollup_cement_case = make_manager_case Operation.Encoding.sc_rollup_cement_case Manager_result.sc_rollup_cement_case @@ -1613,7 +1612,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_publish_case = + let sc_rollup_publish_case = make_manager_case Operation.Encoding.sc_rollup_publish_case Manager_result.sc_rollup_publish_case @@ -1624,7 +1623,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_refute_case = + let sc_rollup_refute_case = make_manager_case Operation.Encoding.sc_rollup_refute_case Manager_result.sc_rollup_refute_case @@ -1635,7 +1634,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_timeout_case = + let sc_rollup_timeout_case = make_manager_case Operation.Encoding.sc_rollup_timeout_case Manager_result.sc_rollup_timeout_case @@ -1646,7 +1645,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_execute_outbox_message_case = + let sc_rollup_execute_outbox_message_case = make_manager_case Operation.Encoding.sc_rollup_execute_outbox_message_case Manager_result.sc_rollup_execute_outbox_message_case @@ -1658,7 +1657,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = make_manager_case Operation.Encoding.sc_rollup_recover_bond_case Manager_result.sc_rollup_recover_bond_case @@ -2618,7 +2617,7 @@ let rec kind_equal_list : | Some Eq -> Some Eq)) | _ -> None -let rec pack_contents_list : +let rec pack_contents_list : type kind. kind contents_list -> kind contents_result_list -> diff --git a/src/proto_alpha/lib_protocol/contract_repr.ml b/src/proto_alpha/lib_protocol/contract_repr.ml index 155115572d078..fd9fb7ca3f1bf 100644 --- a/src/proto_alpha/lib_protocol/contract_repr.ml +++ b/src/proto_alpha/lib_protocol/contract_repr.ml @@ -190,7 +190,7 @@ let originated_contracts (Origination_nonce.{origination_index = last; operation_hash = last_hash} as origination_nonce) = assert (Operation_hash.equal first_hash last_hash) ; - let rec contracts acc origination_index = + let rec contracts acc origination_index = if Compare.Int32.(origination_index < first) then acc else let origination_nonce = {origination_nonce with origination_index} in diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml index ab2f9660c8c3e..f067f3b48e3b4 100644 --- a/src/proto_alpha/lib_protocol/contract_services.ml +++ b/src/proto_alpha/lib_protocol/contract_services.ml @@ -290,7 +290,7 @@ module S = struct end end -let register () = +let register () = let open Services_registration in register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ; let register_field_gen ~filter_contract ~wrap_result ~chunked s f = diff --git a/src/proto_alpha/lib_protocol/level_storage.ml b/src/proto_alpha/lib_protocol/level_storage.ml index 952c50ec33759..e1838c9d99125 100644 --- a/src/proto_alpha/lib_protocol/level_storage.ml +++ b/src/proto_alpha/lib_protocol/level_storage.ml @@ -73,7 +73,7 @@ let last_level_in_cycle ctxt c = let levels_in_cycle ctxt cycle = let first = first_level_in_cycle ctxt cycle in - let rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc) else acc in @@ -89,7 +89,7 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () = let levels_with_commitments_in_cycle ctxt c = let first = first_level_in_cycle ctxt c in - let rec loop (n : Level_repr.t) acc = + let rec loop (n : Level_repr.t) acc = if Cycle_repr.(n.cycle = first.cycle) then if n.expected_commitment then loop (succ ctxt n) (n :: acc) else loop (succ ctxt n) acc diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml index 5ab45236477ae..100edf55a0e06 100644 --- a/src/proto_alpha/lib_protocol/main.ml +++ b/src/proto_alpha/lib_protocol/main.ml @@ -720,7 +720,7 @@ let relative_position_within_block op1 op2 = let open Alpha_context in let (Operation_data op1) = op1.protocol_data in let (Operation_data op2) = op2.protocol_data in - match (op1.contents, op2.contents) with + match (op1.contents, op2.contents) with | Single (Preendorsement _), Single (Preendorsement _) -> 0 | Single (Preendorsement _), _ -> -1 | _, Single (Preendorsement _) -> 1 diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index dafe0f448ee7f..eedb5c43d4db1 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -232,9 +232,7 @@ let namespace = function let valid_case name = let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in - let rec for_all a b f = - Compare.Int.(a > b) || (f a && for_all (a + 1) b f) - in + let rec for_all a b f = Compare.Int.(a > b) || (f a && for_all (a + 1) b f) in let len = String.length name in Compare.Int.(len <> 0) && Compare.Char.(name.[0] <> '_') diff --git a/src/proto_alpha/lib_protocol/misc.ml b/src/proto_alpha/lib_protocol/misc.ml index d7c95b87aa3c4..fd19a63ad4979 100644 --- a/src/proto_alpha/lib_protocol/misc.ml +++ b/src/proto_alpha/lib_protocol/misc.ml @@ -31,15 +31,15 @@ type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t -let rec ( --> ) i j = +let rec ( --> ) i j = (* [i; i+1; ...; j] *) if Compare.Int.(i > j) then [] else i :: (succ i --> j) -let rec ( <-- ) i j = +let rec ( <-- ) i j = (* [j; j-1; ...; i] *) if Compare.Int.(i > j) then [] else j :: (i <-- pred j) -let rec ( ---> ) i j = +let rec ( ---> ) i j = (* [i; i+1; ...; j] *) if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j) diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml index 0f2fad3891903..821764e1af1ca 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/operation_repr.ml @@ -601,7 +601,7 @@ module Encoding = struct -> 'kind case [@@coq_force_gadt] - let reveal_case = + let reveal_case = MCase { tag = 0; @@ -612,7 +612,7 @@ module Encoding = struct inj = (fun pkh -> Reveal pkh); } - let transaction_case = + let transaction_case = MCase { tag = 1; @@ -649,7 +649,7 @@ module Encoding = struct Transaction {amount; destination; parameters; entrypoint}); } - let origination_case = + let origination_case = MCase { tag = 2; @@ -670,7 +670,7 @@ module Encoding = struct Origination {credit; delegate; script}); } - let delegation_case = + let delegation_case = MCase { tag = 3; @@ -682,7 +682,7 @@ module Encoding = struct inj = (fun key -> Delegation key); } - let register_global_constant_case = + let register_global_constant_case = MCase { tag = 4; @@ -695,7 +695,7 @@ module Encoding = struct inj = (fun value -> Register_global_constant {value}); } - let set_deposits_limit_case = + let set_deposits_limit_case = MCase { tag = 5; @@ -708,7 +708,7 @@ module Encoding = struct inj = (fun key -> Set_deposits_limit key); } - let tx_rollup_origination_case = + let tx_rollup_origination_case = MCase { tag = tx_rollup_operation_origination_tag; @@ -727,7 +727,7 @@ module Encoding = struct encoding which is in hexadecimal for JSON. *) conv Bytes.of_string Bytes.to_string bytes - let tx_rollup_submit_batch_case = + let tx_rollup_submit_batch_case = MCase { tag = tx_rollup_operation_submit_batch_tag; @@ -749,7 +749,7 @@ module Encoding = struct Tx_rollup_submit_batch {tx_rollup; content; burn_limit}); } - let tx_rollup_commit_case = + let tx_rollup_commit_case = MCase { tag = tx_rollup_operation_commit_tag; @@ -769,7 +769,7 @@ module Encoding = struct Tx_rollup_commit {tx_rollup; commitment}); } - let tx_rollup_return_bond_case = + let tx_rollup_return_bond_case = MCase { tag = tx_rollup_operation_return_bond_tag; @@ -782,7 +782,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_return_bond {tx_rollup}); } - let tx_rollup_finalize_commitment_case = + let tx_rollup_finalize_commitment_case = MCase { tag = tx_rollup_operation_finalize_commitment_tag; @@ -797,7 +797,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_finalize_commitment {tx_rollup}); } - let tx_rollup_remove_commitment_case = + let tx_rollup_remove_commitment_case = MCase { tag = tx_rollup_operation_remove_commitment_tag; @@ -812,7 +812,7 @@ module Encoding = struct inj = (fun tx_rollup -> Tx_rollup_remove_commitment {tx_rollup}); } - let tx_rollup_rejection_case = + let tx_rollup_rejection_case = MCase { tag = tx_rollup_operation_rejection_tag; @@ -891,7 +891,7 @@ module Encoding = struct }); } - let tx_rollup_dispatch_tickets_case = + let tx_rollup_dispatch_tickets_case = MCase { tag = tx_rollup_operation_dispatch_tickets_tag; @@ -947,7 +947,7 @@ module Encoding = struct }); } - let transfer_ticket_case = + let transfer_ticket_case = MCase { tag = transfer_ticket_tag; @@ -974,7 +974,7 @@ module Encoding = struct {contents; ty; ticketer; amount; destination; entrypoint}); } - let sc_rollup_originate_case = + let sc_rollup_originate_case = MCase { tag = sc_rollup_operation_origination_tag; @@ -996,7 +996,7 @@ module Encoding = struct Sc_rollup_originate {kind; boot_sector; parameters_ty}); } - let dal_publish_slot_header_case = + let dal_publish_slot_header_case = MCase { tag = dal_publish_slot_header_tag; @@ -1009,7 +1009,7 @@ module Encoding = struct inj = (fun slot -> Dal_publish_slot_header {slot}); } - let sc_rollup_add_messages_case = + let sc_rollup_add_messages_case = MCase { tag = sc_rollup_operation_add_message_tag; @@ -1029,7 +1029,7 @@ module Encoding = struct Sc_rollup_add_messages {rollup; messages}); } - let sc_rollup_cement_case = + let sc_rollup_cement_case = MCase { tag = sc_rollup_operation_cement_tag; @@ -1048,7 +1048,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_cement {rollup; commitment}); } - let sc_rollup_publish_case = + let sc_rollup_publish_case = MCase { tag = sc_rollup_operation_publish_tag; @@ -1067,7 +1067,7 @@ module Encoding = struct (fun (rollup, commitment) -> Sc_rollup_publish {rollup; commitment}); } - let sc_rollup_refute_case = + let sc_rollup_refute_case = MCase { tag = sc_rollup_operation_refute_tag; @@ -1091,7 +1091,7 @@ module Encoding = struct Sc_rollup_refute {rollup; opponent; refutation}); } - let sc_rollup_timeout_case = + let sc_rollup_timeout_case = MCase { tag = sc_rollup_operation_timeout_tag; @@ -1109,7 +1109,7 @@ module Encoding = struct inj = (fun (rollup, stakers) -> Sc_rollup_timeout {rollup; stakers}); } - let sc_rollup_execute_outbox_message_case = + let sc_rollup_execute_outbox_message_case = MCase { tag = sc_rollup_execute_outbox_message_tag; @@ -1136,7 +1136,7 @@ module Encoding = struct {rollup; cemented_commitment; output_proof}); } - let sc_rollup_recover_bond_case = + let sc_rollup_recover_bond_case = MCase { tag = sc_rollup_operation_recover_bond_tag; @@ -1237,7 +1237,7 @@ module Encoding = struct select = (function Contents (Endorsement _ as op) -> Some op | _ -> None); proj = - (fun (Endorsement consensus_content) -> + (fun (Endorsement consensus_content) -> ( consensus_content.slot, consensus_content.level, consensus_content.round, @@ -1247,7 +1247,7 @@ module Encoding = struct Endorsement {slot; level; round; block_payload_hash}); } - let endorsement_encoding = + let endorsement_encoding = let make (Case {tag; name; encoding; select = _; proj; inj}) = case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x) in @@ -1284,15 +1284,14 @@ module Encoding = struct (function | Contents (Dal_slot_availability _ as op) -> Some op | _ -> None); proj = - (fun (Dal_slot_availability - (endorser, endorsement)) -> + (fun (Dal_slot_availability (endorser, endorsement)) -> (endorser, endorsement)); inj = (fun (endorser, endorsement) -> Dal_slot_availability (endorser, endorsement)); } - let seed_nonce_revelation_case = + let seed_nonce_revelation_case = Case { tag = 1; @@ -1338,8 +1337,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2}); } - let double_endorsement_evidence_case : - Kind.double_endorsement_evidence case = + let double_endorsement_evidence_case : Kind.double_endorsement_evidence case = Case { tag = 2; @@ -1356,7 +1354,7 @@ module Encoding = struct inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2}); } - let double_baking_evidence_case = + let double_baking_evidence_case = Case { tag = 3; @@ -1372,7 +1370,7 @@ module Encoding = struct inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2}); } - let activate_account_case = + let activate_account_case = Case { tag = 4; @@ -1391,7 +1389,7 @@ module Encoding = struct (fun (id, activation_code) -> Activate_account {id; activation_code}); } - let proposals_case = + let proposals_case = Case { tag = 5; @@ -1411,7 +1409,7 @@ module Encoding = struct Proposals {source; period; proposals}); } - let ballot_case = + let ballot_case = Case { tag = 6; @@ -1440,8 +1438,7 @@ module Encoding = struct encoding = obj1 (req "arbitrary" Data_encoding.string); select = (function Contents (Failing_noop _ as op) -> Some op | _ -> None); - proj = - (function Failing_noop message -> message); + proj = (function Failing_noop message -> message); inj = (function message -> Failing_noop message); } @@ -1453,8 +1450,7 @@ module Encoding = struct (req "gas_limit" (check_size 10 Gas_limit_repr.Arith.n_integral_encoding)) (req "storage_limit" (check_size 10 n)) - let extract : type kind. kind Kind.manager contents -> _ = - function + let extract : type kind. kind Kind.manager contents -> _ = function | Manager_operation {source; fee; counter; gas_limit; storage_limit; operation = _} -> (source, fee, counter, gas_limit, storage_limit) @@ -1463,7 +1459,7 @@ module Encoding = struct Manager_operation {source; fee; counter; gas_limit; storage_limit; operation} - let make_manager_case tag (type kind) + let make_manager_case tag (type kind) (Manager_operations.MCase mcase : kind Manager_operations.case) = Case { diff --git a/src/proto_alpha/lib_protocol/sapling_storage.ml b/src/proto_alpha/lib_protocol/sapling_storage.ml index 35ee7c2546a2c..e043a080a46f5 100644 --- a/src/proto_alpha/lib_protocol/sapling_storage.ml +++ b/src/proto_alpha/lib_protocol/sapling_storage.ml @@ -149,7 +149,7 @@ module Commitments : COMMITMENTS = struct pos = size tree /\ Post: incremental tree /\ to_list (insert tree height pos cms) = to_list t @ cms *) - let rec insert ctx id node height pos cms = + let rec insert ctx id node height pos cms = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -178,8 +178,7 @@ module Commitments : COMMITMENTS = struct Storage.Sapling.Commitments.add (ctx, id) node h >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h) - let rec fold_from_height ctx id node ~pos ~f ~acc height - = + let rec fold_from_height ctx id node ~pos ~f ~acc height = assert_node node height ; assert_height height ; assert_pos pos height ; @@ -279,7 +278,7 @@ module Nullifiers = struct (ctx, size) let get_from ctx id offset = - let rec aux acc pos = + let rec aux acc pos = Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function | None -> return @@ List.rev acc | Some c -> aux (c :: acc) (Int64.succ pos) @@ -306,7 +305,7 @@ module Roots = struct Storage.Sapling.Roots.get (ctx, id) pos let init ctx id = - let rec aux ctx pos = + let rec aux ctx pos = if Compare.Int32.(pos < 0l) then return ctx else Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index dc53f0ffa71e3..9fbfed805ad9f 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -291,7 +291,7 @@ let serialize_ty_for_error ty = *) unparse_ty_uncarbonated ~loc:() ty |> Micheline.strip_locations -let check_comparable : +let check_comparable : type a ac. Script.location -> (a, ac) ty -> (ac, Dependent_bool.yes) eq tzresult = fun loc ty -> @@ -521,7 +521,7 @@ let comb_witness2 : | Pair_t _ -> Comb_Pair Comb_Any | _ -> Comb_Any -let rec unparse_comparable_data : +let rec unparse_comparable_data : type a loc. loc:loc -> context -> @@ -938,7 +938,7 @@ let parse_memo_size (n : (location, _) Micheline.node) : match n with | Int (_, z) -> ( match Sapling.Memo_size.parse_z z with - | Ok _ as ok_memo_size -> ok_memo_size + | Ok _ as ok_memo_size -> ok_memo_size | Error msg -> error @@ Invalid_syntactic_constant (location n, strip_locations n, msg)) @@ -970,7 +970,7 @@ type ('ret, 'name) parse_ty_ret = | Parse_entrypoints : (ex_parameter_ty_and_entrypoints_node, Entrypoint.t option) parse_ty_ret -let rec parse_ty : +let rec parse_ty : type ret name. context -> stack_depth:int -> @@ -1310,8 +1310,7 @@ let rec parse_ty : T_unit; ] -and parse_comparable_ty - : +and parse_comparable_ty : context -> stack_depth:int -> Script.node -> @@ -1334,7 +1333,7 @@ and parse_comparable_ty error (Comparable_type_expected (location node, Micheline.strip_locations node)) -and parse_passable_ty : +and parse_passable_ty : type ret name. context -> stack_depth:int -> @@ -1352,8 +1351,7 @@ and parse_passable_ty : ~allow_contract:true ~allow_ticket:true -and parse_any_ty - : +and parse_any_ty : context -> stack_depth:int -> legacy:bool -> @@ -1370,8 +1368,7 @@ and parse_any_ty ~allow_ticket:true ~ret:Don't_parse_entrypoints -and parse_big_map_ty - ctxt ~stack_depth ~legacy big_map_loc args map_annot = +and parse_big_map_ty ctxt ~stack_depth ~legacy big_map_loc args map_annot = Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt -> match args with | [key_ty; value_ty] -> @@ -1388,8 +1385,7 @@ and parse_big_map_ty (Ex_ty big_map_ty, ctxt) | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args) -and parse_big_map_value_ty - ctxt ~stack_depth ~legacy value_ty = +and parse_big_map_value_ty ctxt ~stack_depth ~legacy value_ty = (parse_ty [@tailcall]) ctxt ~stack_depth @@ -2306,7 +2302,7 @@ let parse_toplevel : - storage after origination *) -let rec parse_data : +let rec parse_data : type a ac. ?type_logger:type_logger -> stack_depth:int -> @@ -2829,7 +2825,7 @@ and parse_views : in Script_map.map_es_in_context aux ctxt views -and parse_returning : +and parse_returning : type arg argc ret retc. ?type_logger:type_logger -> stack_depth:int -> @@ -2872,7 +2868,7 @@ and parse_returning : : (arg, ret) lambda), ctxt ) -and parse_instr : +and parse_instr : type a s. ?type_logger:type_logger -> stack_depth:int -> @@ -4854,7 +4850,7 @@ and parse_instr : I_XOR; ] -and parse_contract_data : +and parse_contract_data : type arg argc. stack_depth:int -> context -> @@ -4886,7 +4882,7 @@ and parse_contract_data : The inner [result] is turned into an [option] by [parse_contract_for_script]. Both [tzresult] are merged by [parse_contract_data]. *) -and parse_contract : +and parse_contract : type arg argc err. stack_depth:int -> context -> @@ -5128,7 +5124,7 @@ let parse_storage : storage_type (root storage)) -let parse_script : +let parse_script : ?type_logger:type_logger -> context -> legacy:bool -> @@ -5274,7 +5270,7 @@ let list_entrypoints_uncarbonated (type full fullc) (full : (full, fullc) ty) (* -- Unparsing data of any type -- *) -let rec unparse_data : +let rec unparse_data : type a ac. context -> stack_depth:int -> @@ -5478,7 +5474,7 @@ and unparse_items : ([], ctxt) items -and unparse_code ctxt ~stack_depth mode code = +and unparse_code ctxt ~stack_depth mode code = let legacy = true in Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt -> let non_terminal_recursion ctxt mode code = @@ -5797,8 +5793,7 @@ let rec has_lazy_storage : type t tc. (t, tc) ty -> t has_lazy_storage = storage diff to show on the receipt and apply on the storage. *) -let extract_lazy_storage_updates ctxt mode - ~temporary ids_to_copy acc ty x = +let extract_lazy_storage_updates ctxt mode ~temporary ids_to_copy acc ty x = let rec aux : type a ac. context -> @@ -5909,7 +5904,7 @@ end (** Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible. *) -let rec fold_lazy_storage : +let rec fold_lazy_storage : type a ac error. f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f -> init:'acc -> @@ -5968,7 +5963,7 @@ let rec fold_lazy_storage : m (ok (Fold_lazy_storage.Ok init, ctxt)) -let collect_lazy_storage ctxt ty x = +let collect_lazy_storage ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f kind id (acc : (_, never) Fold_lazy_storage.result) = let acc = match acc with Fold_lazy_storage.Ok acc -> acc in @@ -5978,8 +5973,8 @@ let collect_lazy_storage ctxt ty x = >>? fun (ids, ctxt) -> match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt) -let extract_lazy_storage_diff ctxt mode - ~temporary ~to_duplicate ~to_update ty v = +let extract_lazy_storage_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v + = (* Basically [to_duplicate] are ids from the argument and [to_update] are ids from the storage before execution (i.e. it is safe to reuse them since they @@ -6056,7 +6051,7 @@ let parse_ty = parse_ty ~stack_depth:0 ~ret:Don't_parse_entrypoints let parse_parameter_ty_and_entrypoints = parse_parameter_ty_and_entrypoints ~stack_depth:0 -let get_single_sapling_state ctxt ty x = +let get_single_sapling_state ctxt ty x = let has_lazy_storage = has_lazy_storage ty in let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i) single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result = diff --git a/src/proto_alpha/lib_protocol/script_repr.ml b/src/proto_alpha/lib_protocol/script_repr.ml index 81e8474d5fd6e..d47eee936e96f 100644 --- a/src/proto_alpha/lib_protocol/script_repr.ml +++ b/src/proto_alpha/lib_protocol/script_repr.ml @@ -117,7 +117,7 @@ module Micheline_size = struct let of_annots acc annots = List.fold_left (fun acc s -> add_string acc s) acc annots - let rec of_nodes acc nodes more_nodes = + let rec of_nodes acc nodes more_nodes = let open Micheline in match nodes with | [] -> ( @@ -312,7 +312,7 @@ let is_unit_parameter = ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes) ~fun_combine:(fun res _ -> res) -let rec strip_annotations node = +let rec strip_annotations node = let open Micheline in match node with | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf @@ -330,8 +330,7 @@ let rec micheline_fold_aux node f acc k = | Micheline.Seq (_, subterms) -> micheline_fold_nodes subterms f (f acc node) k -and micheline_fold_nodes - subterms f acc k = +and micheline_fold_nodes subterms f acc k = match subterms with | [] -> k acc | node :: nodes -> diff --git a/src/proto_alpha/lib_protocol/seed_repr.ml b/src/proto_alpha/lib_protocol/seed_repr.ml index e0a6df765893d..f06d2fe82dd35 100644 --- a/src/proto_alpha/lib_protocol/seed_repr.ml +++ b/src/proto_alpha/lib_protocol/seed_repr.ml @@ -215,7 +215,7 @@ let initial_nonce_hash_0 = hash initial_nonce_0 let deterministic_seed seed = update_seed seed zero_bytes let initial_seeds ?initial_seed n = - let rec loop acc elt i = + let rec loop acc elt i = if Compare.Int.(i = 1) then List.rev (elt :: acc) else loop (elt :: acc) (deterministic_seed elt) (i - 1) in diff --git a/src/proto_alpha/lib_protocol/storage_description.ml b/src/proto_alpha/lib_protocol/storage_description.ml index 7d5fc23ef679a..e659f6b82cecd 100644 --- a/src/proto_alpha/lib_protocol/storage_description.ml +++ b/src/proto_alpha/lib_protocol/storage_description.ml @@ -56,8 +56,7 @@ and 'key description = } -> 'key description -let rec pp : - type a. Format.formatter -> a t -> unit = +let rec pp : type a. Format.formatter -> a t -> unit = fun ppf {dir; _} -> match dir with | Empty -> Format.fprintf ppf "Empty" @@ -72,8 +71,7 @@ let rec pp : let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in pp_item ppf (name, subdir) -and pp_item : - type a. Format.formatter -> string * a t -> unit = +and pp_item : type a. Format.formatter -> string * a t -> unit = fun ppf (name, desc) -> Format.fprintf ppf "@[%s@ %a@]" name pp desc let pp_rev_path ppf path = diff --git a/src/proto_alpha/lib_protocol/tez_repr.ml b/src/proto_alpha/lib_protocol/tez_repr.ml index 2da8256338748..c8a8aa98b6997 100644 --- a/src/proto_alpha/lib_protocol/tez_repr.ml +++ b/src/proto_alpha/lib_protocol/tez_repr.ml @@ -97,7 +97,7 @@ let of_string s = let pp ppf (Tez_tag amount) = let mult_int = 1_000_000L in - let rec left ppf amount = + let rec left ppf amount = let d, r = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in if d > 0L then Format.fprintf ppf "%a%03Ld" left d r else Format.fprintf ppf "%Ld" r -- GitLab From ade7d5d30fd5091a6870dbd26dfb4f561d6e03ae Mon Sep 17 00:00:00 2001 From: Shubham Date: Wed, 29 Jun 2022 19:13:34 +0530 Subject: [PATCH 5/5] update the merge conflicts without coq attributes after rebasing with master --- src/proto_alpha/lib_protocol/apply.ml | 13 +++---------- .../lib_protocol/apply_internal_results.ml | 15 +++++++-------- src/proto_alpha/lib_protocol/apply_results.ml | 8 ++++---- src/proto_alpha/lib_protocol/operation_repr.ml | 6 +++--- 4 files changed, 17 insertions(+), 25 deletions(-) diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml index d14c330ea710b..09b24a16634fc 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml @@ -2146,14 +2146,7 @@ let apply_manager_contents (type kind) ctxt mode chain_id * kind manager_operation_result * packed_internal_manager_operation_result list) Lwt.t = - let (Manager_operation - { - source; - operation; - gas_limit; - storage_limit; - _; - }) = + let (Manager_operation {source; operation; gas_limit; storage_limit; _}) = op in (* We do not expose the internal scaling to the users. Instead, we multiply @@ -2239,7 +2232,7 @@ let rec mark_skipped : kind Kind.manager fees_updated_contents_list -> kind Kind.manager contents_result_list = fun ~payload_producer level fees_updated_contents_list -> - match[@coq_match_with_default] fees_updated_contents_list with + match fees_updated_contents_list with | FeesUpdatedSingle {contents = Manager_operation {operation; _}; balance_updates} -> Single_result @@ -2318,7 +2311,7 @@ let rec apply_manager_contents_list_rec : (success_or_failure * kind Kind.manager contents_result_list) Lwt.t = fun ctxt mode ~payload_producer chain_id fees_updated_contents_list -> let level = Level.current ctxt in - match[@coq_match_with_default] fees_updated_contents_list with + match fees_updated_contents_list with | FeesUpdatedSingle {contents = Manager_operation _ as op; balance_updates} -> apply_manager_contents ctxt mode chain_id op >|= fun (ctxt_result, operation_result, internal_operation_results) -> diff --git a/src/proto_alpha/lib_protocol/apply_internal_results.ml b/src/proto_alpha/lib_protocol/apply_internal_results.ml index 01dc7fd8a2daf..5c411a68cf55a 100644 --- a/src/proto_alpha/lib_protocol/apply_internal_results.ml +++ b/src/proto_alpha/lib_protocol/apply_internal_results.ml @@ -216,7 +216,7 @@ module Internal_result = struct -> 'kind case [@@coq_force_gadt] - let[@coq_axiom_with_reason "gadt"] transaction_contract_variant_cases = + let transaction_contract_variant_cases = union [ case @@ -329,7 +329,7 @@ module Internal_result = struct (fun consumed_gas -> Transaction_to_event_result {consumed_gas}); ] - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = MCase { (* This value should be changed with care: maybe receipts are read by @@ -374,7 +374,7 @@ module Internal_result = struct Transaction {amount; destination; parameters; entrypoint}); } - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = MCase { (* This value should be changed with care: maybe receipts are read by @@ -402,7 +402,7 @@ module Internal_result = struct Origination {credit; delegate; script}); } - let[@coq_axiom_with_reason "gadt"] delegation_case = + let delegation_case = MCase { (* This value should be changed with care: maybe receipts are read by @@ -523,7 +523,7 @@ module Internal_manager_result = struct in MCase {op_case; encoding; kind; select; proj; inj; t} - let[@coq_axiom_with_reason "gadt"] transaction_case = + let transaction_case = make ~op_case:Internal_result.transaction_case ~encoding:Internal_result.transaction_contract_variant_cases @@ -535,7 +535,7 @@ module Internal_manager_result = struct ~proj:(function ITransaction_result x -> x) ~inj:(fun x -> ITransaction_result x) - let[@coq_axiom_with_reason "gadt"] origination_case = + let origination_case = make ~op_case:Internal_result.origination_case ~encoding: @@ -600,8 +600,7 @@ module Internal_manager_result = struct Some op | _ -> None) ~kind:Kind.Delegation_manager_kind - ~proj:(function[@coq_match_with_default] - | IDelegation_result {consumed_gas} -> consumed_gas) + ~proj:(function IDelegation_result {consumed_gas} -> consumed_gas) ~inj:(fun consumed_gas -> IDelegation_result {consumed_gas}) end diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml index 296461999608a..d319a04c38985 100644 --- a/src/proto_alpha/lib_protocol/apply_results.ml +++ b/src/proto_alpha/lib_protocol/apply_results.ml @@ -881,7 +881,7 @@ module Manager_result = struct ~inj:(fun (balance_updates, consumed_gas) -> Sc_rollup_recover_bond_result {balance_updates; consumed_gas}) - let[@coq_axiom_with_reason "gadt"] sc_rollup_dal_slot_subscribe_case = + let sc_rollup_dal_slot_subscribe_case = make ~op_case: Operation.Encoding.Manager_operations.sc_rollup_dal_slot_subscribe_case @@ -1190,7 +1190,7 @@ module Encoding = struct inj = (fun bus -> Seed_nonce_revelation_result bus); } - let[@coq_axiom_with_reason "gadt"] vdf_revelation_case = + let vdf_revelation_case = Case { op_case = Operation.Encoding.vdf_revelation_case; @@ -1208,7 +1208,7 @@ module Encoding = struct inj = (fun bus -> Vdf_revelation_result bus); } - let[@coq_axiom_with_reason "gadt"] double_endorsement_evidence_case = + let double_endorsement_evidence_case = Case { op_case = Operation.Encoding.double_endorsement_evidence_case; @@ -1668,7 +1668,7 @@ module Encoding = struct Some (op, res) | _ -> None) - let[@coq_axiom_with_reason "gadt"] sc_rollup_dal_slot_subscribe_case = + let sc_rollup_dal_slot_subscribe_case = make_manager_case Operation.Encoding.sc_rollup_dal_slot_subscribe_case Manager_result.sc_rollup_dal_slot_subscribe_case diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml index 821764e1af1ca..5847eb1fed67f 100644 --- a/src/proto_alpha/lib_protocol/operation_repr.ml +++ b/src/proto_alpha/lib_protocol/operation_repr.ml @@ -1149,7 +1149,7 @@ module Encoding = struct inj = (fun sc_rollup -> Sc_rollup_recover_bond {sc_rollup}); } - let[@coq_axiom_with_reason "gadt"] sc_rollup_dal_slot_subscribe_case = + let sc_rollup_dal_slot_subscribe_case = MCase { tag = sc_rollup_operation_dal_slot_subscribe_tag; @@ -1307,7 +1307,7 @@ module Encoding = struct inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce}); } - let[@coq_axiom_with_reason "gadt"] vdf_revelation_case = + let vdf_revelation_case = Case { tag = 8; @@ -1319,7 +1319,7 @@ module Encoding = struct inj = (fun solution -> Vdf_revelation {solution}); } - let[@coq_axiom_with_reason "gadt"] double_preendorsement_evidence_case : + let double_preendorsement_evidence_case : Kind.double_preendorsement_evidence case = Case { -- GitLab