carthage: update tezos copy/pasted files

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.ml

@@ -25,80 +25,86 @@
 
 open Protocol
 
-let constants_mainnet = Constants_repr.{
+let constants_mainnet =
+  Constants_repr.
+    {
       preserved_cycles = 5;
       blocks_per_cycle = 4096l;
       blocks_per_commitment = 32l;
       blocks_per_roll_snapshot = 256l;
       blocks_per_voting_period = 32768l;
-    time_between_blocks =
+      time_between_blocks = List.map Period_repr.of_seconds_exn [60L; 40L];
-      List.map Period_repr.of_seconds_exn [ 60L ; 40L ] ;
       endorsers_per_block = 32;
-    hard_gas_limit_per_operation = Z.of_int 800_000 ;
+      hard_gas_limit_per_operation = Z.of_int 1_040_000;
-    hard_gas_limit_per_block = Z.of_int 8_000_000 ;
+      hard_gas_limit_per_block = Z.of_int 10_400_000;
-    proof_of_work_threshold =
+      proof_of_work_threshold = Int64.(sub (shift_left 1L 46) 1L);
-      Int64.(sub (shift_left 1L 46) 1L) ;
       tokens_per_roll = Tez_repr.(mul_exn one 8_000);
       michelson_maximum_type_size = 1000;
-    seed_nonce_revelation_tip = begin
+      seed_nonce_revelation_tip =
-      match Tez_repr.(one /? 8L) with
+        (match Tez_repr.(one /? 8L) with Ok c -> c | Error _ -> assert false);
-      | Ok c -> c
-      | Error _ -> assert false
-    end ;
       origination_size = 257;
       block_security_deposit = Tez_repr.(mul_exn one 512);
       endorsement_security_deposit = Tez_repr.(mul_exn one 64);
-    block_reward = Tez_repr.(mul_exn one 16) ;
+      baking_reward_per_endorsement =
-    endorsement_reward = Tez_repr.(mul_exn one 2) ;
+        Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 187_500L];
+      endorsement_reward =
+        Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 833_333L];
       hard_storage_limit_per_operation = Z.of_int 60_000;
       cost_per_byte = Tez_repr.of_mutez_exn 1_000L;
       test_chain_duration = Int64.mul 32768L 60L;
-    quorum_min = 20_00l ; (* quorum is in centile of a percentage *)
+      quorum_min = 20_00l;
+      (* quorum is in centile of a percentage *)
       quorum_max = 70_00l;
       min_proposal_quorum = 5_00l;
       initial_endorsers = 24;
       delay_per_missing_endorsement = Period_repr.of_seconds_exn 8L;
     }
 
-let constants_sandbox = Constants_repr.{
+let constants_sandbox =
+  Constants_repr.
+    {
       constants_mainnet with
       preserved_cycles = 2;
       blocks_per_cycle = 8l;
       blocks_per_commitment = 4l;
       blocks_per_roll_snapshot = 4l;
       blocks_per_voting_period = 64l;
-    time_between_blocks =
+      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
-      List.map Period_repr.of_seconds_exn [ 1L ; 0L ] ;
       proof_of_work_threshold = Int64.of_int (-1);
       initial_endorsers = 1;
       delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L;
     }
 
-let constants_test = Constants_repr.{
+let constants_test =
+  Constants_repr.
+    {
       constants_mainnet with
       blocks_per_cycle = 128l;
       blocks_per_commitment = 4l;
       blocks_per_roll_snapshot = 32l;
       blocks_per_voting_period = 256l;
-    time_between_blocks =
+      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
-      List.map Period_repr.of_seconds_exn [ 1L ; 0L ] ;
       proof_of_work_threshold = Int64.of_int (-1);
       initial_endorsers = 1;
       delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L;
     }
 
-let bootstrap_accounts_strings = [
+let bootstrap_accounts_strings =
-  "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" ;
+  [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav";
     "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9";
     "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV";
     "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU";
-  "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ;
+    "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ]
-]
+
 let boostrap_balance = Tez_repr.of_mutez_exn 4_000_000_000_000L
-let bootstrap_accounts = List.map (fun s ->
+
+let bootstrap_accounts =
+  List.map
+    (fun s ->
       let public_key = Signature.Public_key.of_b58check_exn s in
       let public_key_hash = Signature.Public_key.hash public_key in
-    Parameters_repr.{
+      Parameters_repr.
+        {
           public_key_hash;
           public_key = Some public_key;
           amount = boostrap_balance;
@@ -108,7 +114,9 @@ let bootstrap_accounts = List.map (fun s ->
 (* TODO this could be generated from OCaml together with the faucet
    for now these are harcoded values in the tests *)
 let commitments =
-  let json_result = Data_encoding.Json.from_string {json|
+  let json_result =
+    Data_encoding.Json.from_string
+      {json|
   [
     [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ],
     [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ],
@@ -123,20 +131,21 @@ let commitments =
   ]|json}
   in
   match json_result with
-  | Error err -> raise (Failure err)
+  | Error err ->
-  | Ok json -> Data_encoding.Json.destruct
+      raise (Failure err)
-                 (Data_encoding.list Commitment_repr.encoding) json
+  | Ok json ->
+      Data_encoding.Json.destruct
+        (Data_encoding.list Commitment_repr.encoding)
+        json
 
 let make_bootstrap_account (pkh, pk, amount) =
   Parameters_repr.{public_key_hash = pkh; public_key = Some pk; amount}
 
-let parameters_of_constants
+let parameters_of_constants ?(bootstrap_accounts = bootstrap_accounts)
-    ?(bootstrap_accounts = bootstrap_accounts)
+    ?(bootstrap_contracts = []) ?(with_commitments = false) constants =
-    ?(bootstrap_contracts = [])
-    ?(with_commitments = false)
-    constants =
   let commitments = if with_commitments then commitments else [] in
-  Parameters_repr.{
+  Parameters_repr.
+    {
       bootstrap_accounts;
       bootstrap_contracts;
       commitments;

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.mli

@@ -26,7 +26,9 @@
 open Protocol
 
 val constants_mainnet : Constants_repr.parametric
+
 val constants_sandbox : Constants_repr.parametric
+
 val constants_test : Constants_repr.parametric
 
 val make_bootstrap_account :
@@ -37,6 +39,7 @@ val parameters_of_constants:
   ?bootstrap_accounts:Parameters_repr.bootstrap_account list ->
   ?bootstrap_contracts:Parameters_repr.bootstrap_contract list ->
   ?with_commitments:bool ->
-  Constants_repr.parametric -> Parameters_repr.t
+  Constants_repr.parametric ->
+  Parameters_repr.t
 
 val json_of_parameters : Parameters_repr.t -> Data_encoding.json

vendors/ligo-utils/tezos-protocol-alpha-parameters/gen.ml

@@ -29,18 +29,19 @@
 
 let () =
   let print_usage_and_fail s =
-    Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]"
+    Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]" Sys.argv.(0) ;
-      Sys.argv.(0) ;
     raise (Invalid_argument s)
   in
   let dump parameters file =
-    let str = Data_encoding.Json.to_string
+    let str =
-        (Default_parameters.json_of_parameters parameters) in
+      Data_encoding.Json.to_string
-    let fd = open_out file in
+        (Default_parameters.json_of_parameters parameters)
-    output_string fd str ;
-    close_out fd
     in
-  if Array.length Sys.argv < 2 then print_usage_and_fail "" else
+    let fd = open_out file in
+    output_string fd str ; close_out fd
+  in
+  if Array.length Sys.argv < 2 then print_usage_and_fail ""
+  else
     match Sys.argv.(1) with
     | "--sandbox" ->
         dump
@@ -48,10 +49,13 @@ let () =
           "sandbox-parameters.json"
     | "--test" ->
         dump
-          Default_parameters.(parameters_of_constants ~with_commitments:true constants_sandbox)
+          Default_parameters.(
+            parameters_of_constants ~with_commitments:true constants_sandbox)
           "test-parameters.json"
     | "--mainnet" ->
         dump
-          Default_parameters.(parameters_of_constants ~with_commitments:true constants_mainnet)
+          Default_parameters.(
+            parameters_of_constants ~with_commitments:true constants_mainnet)
           "mainnet-parameters.json"
-    | s -> print_usage_and_fail s
+    | s ->
+        print_usage_and_fail s

vendors/ligo-utils/tezos-protocol-alpha/alpha_context.ml

@@ -24,12 +24,16 @@
 (*****************************************************************************)
 
 type t = Raw_context.t
+
 type context = t
 
 module type BASIC_DATA = sig
   type t
+
   include Compare.S with type t := t
+
   val encoding : t Data_encoding.t
+
   val pp : Format.formatter -> t -> unit
 end
 
@@ -38,60 +42,76 @@ module Period = Period_repr
 
 module Timestamp = struct
   include Time_repr
+
   let current = Raw_context.current_timestamp
 end
 
 include Operation_repr
+
 module Operation = struct
   type 'kind t = 'kind operation = {
     shell : Operation.shell_header;
     protocol_data : 'kind protocol_data;
   }
+
   type packed = packed_operation
+
   let unsigned_encoding = unsigned_operation_encoding
+
   include Operation_repr
 end
+
 module Block_header = Block_header_repr
+
 module Vote = struct
   include Vote_repr
   include Vote_storage
 end
+
 module Raw_level = Raw_level_repr
 module Cycle = Cycle_repr
 module Script_int = Script_int_repr
+
 module Script_timestamp = struct
   include Script_timestamp_repr
+
   let now ctxt =
-    let { Constants_repr.time_between_blocks ; _ } =
+    let {Constants_repr.time_between_blocks; _} = Raw_context.constants ctxt in
-      Raw_context.constants ctxt in
     match time_between_blocks with
-    | [] -> failwith "Internal error: 'time_between_block' constants \
+    | [] ->
-                      is an empty list."
+        failwith
+          "Internal error: 'time_between_block' constants is an empty list."
     | first_delay :: _ ->
         let current_timestamp = Raw_context.predecessor_timestamp ctxt in
         Time.add current_timestamp (Period_repr.to_seconds first_delay)
-        |> Timestamp.to_seconds
+        |> Timestamp.to_seconds |> of_int64
-        |> of_int64
 end
+
 module Script = struct
   include Michelson_v1_primitives
   include Script_repr
+
   let force_decode ctxt lexpr =
     Lwt.return
-      (Script_repr.force_decode lexpr >>? fun (v, cost) ->
+      ( Script_repr.force_decode lexpr
-       Raw_context.consume_gas ctxt cost >|? fun ctxt ->
+      >>? fun (v, cost) ->
-       (v, ctxt))
+      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (v, ctxt) )
+
   let force_bytes ctxt lexpr =
     Lwt.return
-      (Script_repr.force_bytes lexpr >>? fun (b, cost) ->
+      ( Script_repr.force_bytes lexpr
-       Raw_context.consume_gas ctxt cost >|? fun ctxt ->
+      >>? fun (b, cost) ->
-       (b, ctxt))
+      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (b, ctxt) )
+
   module Legacy_support = Legacy_script_support_repr
 end
+
 module Fees = Fees_storage
 
 type public_key = Signature.Public_key.t
+
 type public_key_hash = Signature.Public_key_hash.t
+
 type signature = Signature.t
 
 module Constants = struct
@@ -103,66 +123,95 @@ module Voting_period = Voting_period_repr
 
 module Gas = struct
   include Gas_limit_repr
+
   type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high
+
   let check_limit = Raw_context.check_gas_limit
+
   let set_limit = Raw_context.set_gas_limit
+
   let set_unlimited = Raw_context.set_gas_unlimited
+
   let consume = Raw_context.consume_gas
+
   let check_enough = Raw_context.check_enough_gas
+
   let level = Raw_context.gas_level
+
   let consumed = Raw_context.gas_consumed
+
   let block_level = Raw_context.block_gas_level
 end
+
 module Level = struct
   include Level_repr
   include Level_storage
 end
+
 module Contract = struct
   include Contract_repr
   include Contract_storage
 
   let originate c contract ~balance ~script ~delegate =
     originate c contract ~balance ~script ~delegate
+
   let init_origination_nonce = Raw_context.init_origination_nonce
+
   let unset_origination_nonce = Raw_context.unset_origination_nonce
 end
+
 module Big_map = struct
   type id = Z.t
+
   let fresh = Storage.Big_map.Next.incr
+
   let fresh_temporary = Raw_context.fresh_temporary_big_map
+
   let mem c m k = Storage.Big_map.Contents.mem (c, m) k
+
   let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k
+
   let rpc_arg = Storage.Big_map.rpc_arg
+
   let cleanup_temporary c =
-    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c >>= fun c ->
+    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c
-    Lwt.return (Raw_context.reset_temporary_big_map c)
+    >>= fun c -> Lwt.return (Raw_context.reset_temporary_big_map c)
+
   let exists c id =
-    Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) >>=? fun c ->
+    Lwt.return
-    Storage.Big_map.Key_type.get_option c id >>=? fun kt ->
+      (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
+    >>=? fun c ->
+    Storage.Big_map.Key_type.get_option c id
+    >>=? fun kt ->
     match kt with
-    | None -> return (c, None)
+    | None ->
+        return (c, None)
     | Some kt ->
-        Storage.Big_map.Value_type.get c id >>=? fun kv ->
+        Storage.Big_map.Value_type.get c id
-        return (c, Some (kt, kv))
+        >>=? fun kv -> return (c, Some (kt, kv))
 end
+
 module Delegate = Delegate_storage
+
 module Roll = struct
   include Roll_repr
   include Roll_storage
 end
+
 module Nonce = Nonce_storage
+
 module Seed = struct
   include Seed_repr
   include Seed_storage
 end
 
 module Fitness = struct
-
   include Fitness_repr
   include Fitness
-  type fitness = t
-  include Fitness_storage
 
+  type fitness = t
+
+  include Fitness_storage
 end
 
 module Bootstrap = Bootstrap_storage
@@ -174,39 +223,57 @@ end
 
 module Global = struct
   let get_block_priority = Storage.Block_priority.get
+
   let set_block_priority = Storage.Block_priority.set
 end
 
 let prepare_first_block = Init_storage.prepare_first_block
+
 let prepare = Init_storage.prepare
 
 let finalize ?commit_message:message c =
   let fitness = Fitness.from_int64 (Fitness.current c) in
   let context = Raw_context.recover c in
-  { Updater.context ; fitness ; message ; max_operations_ttl = 60 ;
+  {
+    Updater.context;
+    fitness;
+    message;
+    max_operations_ttl = 60;
     last_allowed_fork_level =
       Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
   }
 
 let activate = Raw_context.activate
+
 let fork_test_chain = Raw_context.fork_test_chain
 
 let record_endorsement = Raw_context.record_endorsement
+
 let allowed_endorsements = Raw_context.allowed_endorsements
+
 let init_endorsements = Raw_context.init_endorsements
+
 let included_endorsements = Raw_context.included_endorsements
 
 let reset_internal_nonce = Raw_context.reset_internal_nonce
+
 let fresh_internal_nonce = Raw_context.fresh_internal_nonce
+
 let record_internal_nonce = Raw_context.record_internal_nonce
-let internal_nonce_already_recorded = Raw_context.internal_nonce_already_recorded
+
+let internal_nonce_already_recorded =
+  Raw_context.internal_nonce_already_recorded
 
 let add_deposit = Raw_context.add_deposit
+
 let add_fees = Raw_context.add_fees
+
 let add_rewards = Raw_context.add_rewards
 
 let get_deposits = Raw_context.get_deposits
+
 let get_fees = Raw_context.get_fees
+
 let get_rewards = Raw_context.get_rewards
 
 let description = Raw_context.description

vendors/ligo-utils/tezos-protocol-alpha/alpha_services.ml

@@ -28,9 +28,7 @@ open Alpha_context
 let custom_root = RPC_path.open_root
 
 module Seed = struct
-
   module S = struct
-
     open Data_encoding
 
     let seed =
@@ -40,74 +38,66 @@ module Seed = struct
         ~input:empty
         ~output:Seed.seed_encoding
         RPC_path.(custom_root / "context" / "seed")
-
   end
 
   let () =
     let open Services_registration in
-    register0 S.seed begin fun ctxt () () ->
+    register0 S.seed (fun ctxt () () ->
         let l = Level.current ctxt in
-      Seed.for_cycle ctxt l.cycle
+        Seed.for_cycle ctxt l.cycle)
-    end
-
-
-  let get ctxt block =
-    RPC_context.make_call0 S.seed ctxt block () ()
 
+  let get ctxt block = RPC_context.make_call0 S.seed ctxt block () ()
 end
 
 module Nonce = struct
-
+  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten
-  type info =
-    | Revealed of Nonce.t
-    | Missing of Nonce_hash.t
-    | Forgotten
 
   let info_encoding =
     let open Data_encoding in
-    union [
+    union
-      case (Tag 0)
+      [ case
+          (Tag 0)
           ~title:"Revealed"
           (obj1 (req "nonce" Nonce.encoding))
           (function Revealed nonce -> Some nonce | _ -> None)
           (fun nonce -> Revealed nonce);
-      case (Tag 1)
+        case
+          (Tag 1)
           ~title:"Missing"
           (obj1 (req "hash" Nonce_hash.encoding))
           (function Missing nonce -> Some nonce | _ -> None)
           (fun nonce -> Missing nonce);
-      case (Tag 2)
+        case
+          (Tag 2)
           ~title:"Forgotten"
           empty
           (function Forgotten -> Some () | _ -> None)
-        (fun () -> Forgotten) ;
+          (fun () -> Forgotten) ]
-    ]
 
   module S = struct
-
     let get =
       RPC_service.get_service
         ~description:"Info about the nonce of a previous block."
         ~query:RPC_query.empty
         ~output:info_encoding
         RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg)
-
   end
 
   let register () =
     let open Services_registration in
-    register1 S.get begin fun ctxt raw_level () () ->
+    register1 S.get (fun ctxt raw_level () () ->
         let level = Level.from_raw ctxt raw_level in
-      Nonce.get ctxt level >>= function
+        Nonce.get ctxt level
-      | Ok (Revealed nonce) -> return (Revealed nonce)
+        >>= function
+        | Ok (Revealed nonce) ->
+            return (Revealed nonce)
         | Ok (Unrevealed {nonce_hash; _}) ->
             return (Missing nonce_hash)
-      | Error _ -> return Forgotten
+        | Error _ ->
-    end
+            return Forgotten)
 
   let get ctxt block level =
     RPC_context.make_call1 S.get ctxt block level () ()
-
 end
 
 module Contract = Contract_services

vendors/ligo-utils/tezos-protocol-alpha/alpha_services.mli

@@ -26,22 +26,14 @@
 open Alpha_context
 
 module Seed : sig
-
   val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
-
 end
 
 module Nonce : sig
-
+  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten
-  type info =
-    | Revealed of Nonce.t
-    | Missing of Nonce_hash.t
-    | Forgotten
 
   val get :
-    'a #RPC_context.simple ->
+    'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t
-    'a -> Raw_level.t -> info shell_tzresult Lwt.t
-
 end
 
 module Contract = Contract_services

vendors/ligo-utils/tezos-protocol-alpha/amendment.ml

@@ -29,29 +29,32 @@ open Alpha_context
     Returns None in case of a tie, if proposal quorum is below required
     minimum or if there are no proposals. *)
 let select_winning_proposal ctxt =
-  Vote.get_proposals ctxt >>=? fun proposals ->
+  Vote.get_proposals ctxt
+  >>=? fun proposals ->
   let merge proposal vote winners =
     match winners with
-    | None -> Some ([proposal], vote)
+    | None ->
+        Some ([proposal], vote)
     | Some (winners, winners_vote) as previous ->
         if Compare.Int32.(vote = winners_vote) then
           Some (proposal :: winners, winners_vote)
-        else if Compare.Int32.(vote > winners_vote) then
+        else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote)
-          Some ([proposal], vote)
+        else previous
-        else
+  in
-          previous in
   match Protocol_hash.Map.fold merge proposals None with
   | Some ([proposal], vote) ->
-      Vote.listing_size ctxt >>=? fun max_vote ->
+      Vote.listing_size ctxt
+      >>=? fun max_vote ->
       let min_proposal_quorum = Constants.min_proposal_quorum ctxt in
       let min_vote_to_pass =
-        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l in
+        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l
-      if Compare.Int32.(vote >= min_vote_to_pass) then
+      in
-        return_some proposal
+      if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal
-      else
+      else return_none
-        return_none
   | _ ->
-      return_none (* in case of a tie, let's do nothing. *)
+      return_none
+
+(* in case of a tie, let's do nothing. *)
 
 (** A proposal is approved if it has supermajority and the participation reaches
     the current quorum.
@@ -63,10 +66,14 @@ let select_winning_proposal ctxt =
     The expected quorum is calculated using the last participation EMA, capped
     by the min/max quorum protocol constants. *)
 let check_approval_and_update_participation_ema ctxt =
-  Vote.get_ballots ctxt >>=? fun ballots ->
+  Vote.get_ballots ctxt
-  Vote.listing_size ctxt >>=? fun maximum_vote ->
+  >>=? fun ballots ->
-  Vote.get_participation_ema ctxt >>=? fun participation_ema ->
+  Vote.listing_size ctxt
-  Vote.get_current_quorum ctxt >>=? fun expected_quorum ->
+  >>=? fun maximum_vote ->
+  Vote.get_participation_ema ctxt
+  >>=? fun participation_ema ->
+  Vote.get_current_quorum ctxt
+  >>=? fun expected_quorum ->
   (* Note overflows: considering a maximum of 8e8 tokens, with roll size as
      small as 1e3, there is a maximum of 8e5 rolls and thus votes.
      In 'participation' an Int64 is used because in the worst case 'all_votes is
@@ -75,80 +82,96 @@ let check_approval_and_update_participation_ema ctxt =
   let casted_votes = Int32.add ballots.yay ballots.nay in
   let all_votes = Int32.add casted_votes ballots.pass in
   let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
-  let participation = (* in centile of percentage *)
+  let participation =
-    Int64.(to_int32
+    (* in centile of percentage *)
-             (div
+    Int64.(
-                (mul (of_int32 all_votes) 100_00L)
+      to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote)))
-                (of_int32 maximum_vote))) in
+  in
-  let outcome = Compare.Int32.(participation >= expected_quorum &&
+  let outcome =
-                               ballots.yay >= supermajority) in
+    Compare.Int32.(
+      participation >= expected_quorum && ballots.yay >= supermajority)
+  in
   let new_participation_ema =
-    Int32.(div (add
+    Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l)
-                  (mul 8l participation_ema)
+  in
-                  (mul 2l participation))
+  Vote.set_participation_ema ctxt new_participation_ema
-             10l) in
+  >>=? fun ctxt -> return (ctxt, outcome)
-  Vote.set_participation_ema ctxt new_participation_ema >>=? fun ctxt ->
-  return (ctxt, outcome)
 
 (** Implements the state machine of the amendment procedure.
     Note that [freeze_listings], that computes the vote weight of each delegate,
     is run at the beginning of each voting period.
 *)
 let start_new_voting_period ctxt =
-  Vote.get_current_period_kind ctxt >>=? function
+  Vote.get_current_period_kind ctxt
-  | Proposal -> begin
+  >>=? function
-      select_winning_proposal ctxt >>=? fun proposal ->
+  | Proposal -> (
-      Vote.clear_proposals ctxt >>= fun ctxt ->
+      select_winning_proposal ctxt
-      Vote.clear_listings ctxt >>=? fun ctxt ->
+      >>=? fun proposal ->
+      Vote.clear_proposals ctxt
+      >>= fun ctxt ->
+      Vote.clear_listings ctxt
+      >>=? fun ctxt ->
       match proposal with
       | None ->
-          Vote.freeze_listings ctxt >>=? fun ctxt ->
+          Vote.freeze_listings ctxt >>=? fun ctxt -> return ctxt
-          return ctxt
       | Some proposal ->
-          Vote.init_current_proposal ctxt proposal >>=? fun ctxt ->
+          Vote.init_current_proposal ctxt proposal
-          Vote.freeze_listings ctxt >>=? fun ctxt ->
+          >>=? fun ctxt ->
-          Vote.set_current_period_kind ctxt Testing_vote >>=? fun ctxt ->
+          Vote.freeze_listings ctxt
-          return ctxt
+          >>=? fun ctxt ->
-    end
+          Vote.set_current_period_kind ctxt Testing_vote
+          >>=? fun ctxt -> return ctxt )
   | Testing_vote ->
-      check_approval_and_update_participation_ema ctxt >>=? fun (ctxt, approved) ->
+      check_approval_and_update_participation_ema ctxt
-      Vote.clear_ballots ctxt >>= fun ctxt ->
+      >>=? fun (ctxt, approved) ->
-      Vote.clear_listings ctxt >>=? fun ctxt ->
+      Vote.clear_ballots ctxt
+      >>= fun ctxt ->
+      Vote.clear_listings ctxt
+      >>=? fun ctxt ->
       if approved then
-        let expiration = (* in two days maximum... *)
+        let expiration =
-          Time.add (Timestamp.current ctxt) (Constants.test_chain_duration ctxt) in
+          (* in two days maximum... *)
-        Vote.get_current_proposal ctxt >>=? fun proposal ->
+          Time.add
-        fork_test_chain ctxt proposal expiration >>= fun ctxt ->
+            (Timestamp.current ctxt)
-        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt ->
+            (Constants.test_chain_duration ctxt)
-        return ctxt
+        in
+        Vote.get_current_proposal ctxt
+        >>=? fun proposal ->
+        fork_test_chain ctxt proposal expiration
+        >>= fun ctxt ->
+        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt -> return ctxt
       else
-        Vote.clear_current_proposal ctxt >>=? fun ctxt ->
+        Vote.clear_current_proposal ctxt
-        Vote.freeze_listings ctxt >>=? fun ctxt ->
+        >>=? fun ctxt ->
-        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->
+        Vote.freeze_listings ctxt
-        return ctxt
+        >>=? fun ctxt ->
+        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
   | Testing ->
-      Vote.freeze_listings ctxt >>=? fun ctxt ->
+      Vote.freeze_listings ctxt
-      Vote.set_current_period_kind ctxt Promotion_vote >>=? fun ctxt ->
+      >>=? fun ctxt ->
-      return ctxt
+      Vote.set_current_period_kind ctxt Promotion_vote
+      >>=? fun ctxt -> return ctxt
   | Promotion_vote ->
-      check_approval_and_update_participation_ema ctxt >>=? fun (ctxt, approved) ->
+      check_approval_and_update_participation_ema ctxt
-      begin
+      >>=? fun (ctxt, approved) ->
-        if approved then
+      ( if approved then
-          Vote.get_current_proposal ctxt >>=? fun proposal ->
+        Vote.get_current_proposal ctxt
-          activate ctxt proposal >>= fun ctxt ->
+        >>=? fun proposal -> activate ctxt proposal >>= fun ctxt -> return ctxt
-          return ctxt
+      else return ctxt )
-        else
+      >>=? fun ctxt ->
-          return ctxt
+      Vote.clear_ballots ctxt
-      end >>=? fun ctxt ->
+      >>= fun ctxt ->
-      Vote.clear_ballots ctxt >>= fun ctxt ->
+      Vote.clear_listings ctxt
-      Vote.clear_listings ctxt >>=? fun ctxt ->
+      >>=? fun ctxt ->
-      Vote.clear_current_proposal ctxt >>=? fun ctxt ->
+      Vote.clear_current_proposal ctxt
-      Vote.freeze_listings ctxt >>=? fun ctxt ->
+      >>=? fun ctxt ->
-      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->
+      Vote.freeze_listings ctxt
-      return ctxt
+      >>=? fun ctxt ->
+      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
 
-type error += (* `Branch *)
+type error +=
-  | Invalid_proposal
+  | (* `Branch *)
+      Invalid_proposal
   | Unexpected_proposal
   | Unauthorized_proposal
   | Too_many_proposals
@@ -183,7 +206,8 @@ let () =
     `Branch
     ~id:"unauthorized_proposal"
     ~title:"Unauthorized proposal"
-    ~description:"The delegate provided for the proposal is not in the voting listings."
+    ~description:
+      "The delegate provided for the proposal is not in the voting listings."
     ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
     empty
     (function Unauthorized_proposal -> Some () | _ -> None)
@@ -203,7 +227,8 @@ let () =
     `Branch
     ~id:"unauthorized_ballot"
     ~title:"Unauthorized ballot"
-    ~description:"The delegate provided for the ballot is not in the voting listings."
+    ~description:
+      "The delegate provided for the ballot is not in the voting listings."
     ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
     empty
     (function Unauthorized_ballot -> Some () | _ -> None)
@@ -213,7 +238,8 @@ let () =
     `Branch
     ~id:"too_many_proposals"
     ~title:"Too many proposals"
-    ~description:"The delegate reached the maximum number of allowed proposals."
+    ~description:
+      "The delegate reached the maximum number of allowed proposals."
     ~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals")
     empty
     (function Too_many_proposals -> Some () | _ -> None)
@@ -231,60 +257,67 @@ let () =
 
 (* @return [true] if [List.length l] > [n] w/o computing length *)
 let rec longer_than l n =
-  if Compare.Int.(n < 0) then assert false else
+  if Compare.Int.(n < 0) then assert false
+  else
     match l with
-    | [] -> false
+    | [] ->
+        false
     | _ :: rest ->
         if Compare.Int.(n = 0) then true
         else (* n > 0 *)
           longer_than rest (n - 1)
 
 let record_proposals ctxt delegate proposals =
-  begin match proposals with
+  (match proposals with [] -> fail Empty_proposal | _ :: _ -> return_unit)
-    | [] -> fail Empty_proposal
+  >>=? fun () ->
-    | _ :: _ -> return_unit
+  Vote.get_current_period_kind ctxt
-  end >>=? fun () ->
+  >>=? function
-  Vote.get_current_period_kind ctxt >>=? function
   | Proposal ->
-      Vote.in_listings ctxt delegate >>= fun in_listings ->
+      Vote.in_listings ctxt delegate
+      >>= fun in_listings ->
       if in_listings then
-        Vote.recorded_proposal_count_for_delegate ctxt delegate >>=? fun count ->
+        Vote.recorded_proposal_count_for_delegate ctxt delegate
+        >>=? fun count ->
         fail_when
           (longer_than proposals (Constants.max_proposals_per_delegate - count))
-          Too_many_proposals >>=? fun () ->
+          Too_many_proposals
+        >>=? fun () ->
         fold_left_s
-          (fun ctxt proposal ->
+          (fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate)
-             Vote.record_proposal ctxt proposal delegate)
+          ctxt
-          ctxt proposals >>=? fun ctxt ->
+          proposals
-        return ctxt
+        >>=? fun ctxt -> return ctxt
-      else
+      else fail Unauthorized_proposal
-        fail Unauthorized_proposal
   | Testing_vote | Testing | Promotion_vote ->
       fail Unexpected_proposal
 
 let record_ballot ctxt delegate proposal ballot =
-  Vote.get_current_period_kind ctxt >>=? function
+  Vote.get_current_period_kind ctxt
+  >>=? function
   | Testing_vote | Promotion_vote ->
-      Vote.get_current_proposal ctxt >>=? fun current_proposal ->
+      Vote.get_current_proposal ctxt
-      fail_unless (Protocol_hash.equal proposal current_proposal)
+      >>=? fun current_proposal ->
-        Invalid_proposal >>=? fun () ->
+      fail_unless
-      Vote.has_recorded_ballot ctxt delegate >>= fun has_ballot ->
+        (Protocol_hash.equal proposal current_proposal)
-      fail_when has_ballot Unauthorized_ballot >>=? fun () ->
+        Invalid_proposal
-      Vote.in_listings ctxt delegate >>= fun in_listings ->
+      >>=? fun () ->
-      if in_listings then
+      Vote.has_recorded_ballot ctxt delegate
-        Vote.record_ballot ctxt delegate ballot
+      >>= fun has_ballot ->
-      else
+      fail_when has_ballot Unauthorized_ballot
-        fail Unauthorized_ballot
+      >>=? fun () ->
+      Vote.in_listings ctxt delegate
+      >>= fun in_listings ->
+      if in_listings then Vote.record_ballot ctxt delegate ballot
+      else fail Unauthorized_ballot
   | Testing | Proposal ->
       fail Unexpected_ballot
 
 let last_of_a_voting_period ctxt l =
-  Compare.Int32.(Int32.succ l.Level.voting_period_position =
+  Compare.Int32.(
-                 Constants.blocks_per_voting_period ctxt )
+    Int32.succ l.Level.voting_period_position
+    = Constants.blocks_per_voting_period ctxt)
 
 let may_start_new_voting_period ctxt =
   let level = Level.current ctxt in
-  if last_of_a_voting_period ctxt level then
+  if last_of_a_voting_period ctxt level then start_new_voting_period ctxt
-    start_new_voting_period ctxt
+  else return ctxt
-  else
-    return ctxt

vendors/ligo-utils/tezos-protocol-alpha/amendment.mli

@@ -51,8 +51,7 @@ open Alpha_context
 
 (** If at the end of a voting period, moves to the next one following
     the state machine of the amendment procedure. *)
-val may_start_new_voting_period:
+val may_start_new_voting_period : context -> context tzresult Lwt.t
-  context -> context tzresult Lwt.t
 
 type error +=
   | Unexpected_proposal
@@ -64,16 +63,13 @@ type error +=
     @raise Unexpected_proposal if [ctxt] is not in a proposal period.
     @raise Unauthorized_proposal if [delegate] is not in the listing. *)
 val record_proposals :
-  context ->
+  context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t
-  public_key_hash -> Protocol_hash.t list ->
-  context tzresult Lwt.t
 
-type error +=
+type error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot
-  | Invalid_proposal
-  | Unexpected_ballot
-  | Unauthorized_ballot
 
 val record_ballot :
   context ->
-  public_key_hash -> Protocol_hash.t -> Vote.ballot ->
+  public_key_hash ->
+  Protocol_hash.t ->
+  Vote.ballot ->
   context tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/apply_results.mli

@@ -31,9 +31,7 @@
 open Alpha_context
 
 (** Result of applying a {!Operation.t}. Follows the same structure. *)
-type 'kind operation_metadata = {
+type 'kind operation_metadata = {contents : 'kind contents_result_list}
-  contents: 'kind contents_result_list ;
-}
 
 and packed_operation_metadata =
   | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
@@ -43,34 +41,43 @@ and packed_operation_metadata =
 and 'kind contents_result_list =
   | Single_result : 'kind contents_result -> 'kind contents_result_list
   | Cons_result :
-      'kind Kind.manager contents_result * 'rest Kind.manager contents_result_list ->
+      'kind Kind.manager contents_result
-    (('kind * 'rest) Kind.manager ) contents_result_list
+      * 'rest Kind.manager contents_result_list
+      -> ('kind * 'rest) Kind.manager contents_result_list
 
 and packed_contents_result_list =
-  | Contents_result_list : 'kind contents_result_list -> packed_contents_result_list
+  | Contents_result_list :
+      'kind contents_result_list
+      -> packed_contents_result_list
 
 (** Result of applying an {!Operation.contents}. Follows the same structure. *)
 and 'kind contents_result =
-  | Endorsement_result :
+  | Endorsement_result : {
-      { balance_updates : Delegate.balance_updates ;
+      balance_updates : Delegate.balance_updates;
       delegate : Signature.Public_key_hash.t;
       slots : int list;
-      } -> Kind.endorsement contents_result
+    }
+      -> Kind.endorsement contents_result
   | Seed_nonce_revelation_result :
-      Delegate.balance_updates -> Kind.seed_nonce_revelation contents_result
+      Delegate.balance_updates
+      -> Kind.seed_nonce_revelation contents_result
   | Double_endorsement_evidence_result :
-      Delegate.balance_updates -> Kind.double_endorsement_evidence contents_result
+      Delegate.balance_updates
+      -> Kind.double_endorsement_evidence contents_result
   | Double_baking_evidence_result :
-      Delegate.balance_updates -> Kind.double_baking_evidence contents_result
+      Delegate.balance_updates
+      -> Kind.double_baking_evidence contents_result
   | Activate_account_result :
-      Delegate.balance_updates -> Kind.activate_account contents_result
+      Delegate.balance_updates
+      -> Kind.activate_account contents_result
   | Proposals_result : Kind.proposals contents_result
   | Ballot_result : Kind.ballot contents_result
-  | Manager_operation_result :
+  | Manager_operation_result : {
-      { balance_updates : Delegate.balance_updates ;
+      balance_updates : Delegate.balance_updates;
       operation_result : 'kind manager_operation_result;
       internal_operation_results : packed_internal_operation_result list;
-      } -> 'kind Kind.manager contents_result
+    }
+      -> 'kind Kind.manager contents_result
 
 and packed_contents_result =
   | Contents_result : 'kind contents_result -> packed_contents_result
@@ -79,18 +86,20 @@ and packed_contents_result =
     always be at the tail, and after a single [Failed]. *)
 and 'kind manager_operation_result =
   | Applied of 'kind successful_manager_operation_result
-  | Backtracked of 'kind successful_manager_operation_result * error list option
+  | Backtracked of
+      'kind successful_manager_operation_result * error list option
   | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
   | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
 
 (** Result of applying a {!manager_operation_content}, either internal
     or external. *)
 and _ successful_manager_operation_result =
-  | Reveal_result :
+  | Reveal_result : {
-      { consumed_gas : Z.t
+      consumed_gas : Z.t;
-      } -> Kind.reveal successful_manager_operation_result
+    }
-  | Transaction_result :
+      -> Kind.reveal successful_manager_operation_result
-      { storage : Script.expr option ;
+  | Transaction_result : {
+      storage : Script.expr option;
       big_map_diff : Contract.big_map_diff option;
       balance_updates : Delegate.balance_updates;
       originated_contracts : Contract.t list;
@@ -98,63 +107,75 @@ and _ successful_manager_operation_result =
       storage_size : Z.t;
       paid_storage_size_diff : Z.t;
       allocated_destination_contract : bool;
-      } -> Kind.transaction successful_manager_operation_result
+    }
-  | Origination_result :
+      -> Kind.transaction successful_manager_operation_result
-      { big_map_diff : Contract.big_map_diff option ;
+  | Origination_result : {
+      big_map_diff : Contract.big_map_diff option;
       balance_updates : Delegate.balance_updates;
       originated_contracts : Contract.t list;
       consumed_gas : Z.t;
       storage_size : Z.t;
       paid_storage_size_diff : Z.t;
-      } -> Kind.origination successful_manager_operation_result
+    }
-  | Delegation_result :
+      -> Kind.origination successful_manager_operation_result
-      { consumed_gas : Z.t
+  | Delegation_result : {
-      } -> Kind.delegation successful_manager_operation_result
+      consumed_gas : Z.t;
+    }
+      -> Kind.delegation successful_manager_operation_result
 
 and packed_successful_manager_operation_result =
   | Successful_manager_result :
-      'kind successful_manager_operation_result -> packed_successful_manager_operation_result
+      'kind successful_manager_operation_result
+      -> packed_successful_manager_operation_result
 
 and packed_internal_operation_result =
   | Internal_operation_result :
-      'kind internal_operation * 'kind manager_operation_result ->
+      'kind internal_operation * 'kind manager_operation_result
-    packed_internal_operation_result
+      -> packed_internal_operation_result
 
 (** Serializer for {!packed_operation_result}. *)
 val operation_metadata_encoding : packed_operation_metadata Data_encoding.t
 
-val operation_data_and_metadata_encoding
+val operation_data_and_metadata_encoding :
-  : (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t
+  (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t
-
-
 
 type 'kind contents_and_result_list =
-  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list
+  | Single_and_result :
-  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list
+      'kind Alpha_context.contents * 'kind contents_result
+      -> 'kind contents_and_result_list
+  | Cons_and_result :
+      'kind Kind.manager Alpha_context.contents
+      * 'kind Kind.manager contents_result
+      * 'rest Kind.manager contents_and_result_list
+      -> ('kind * 'rest) Kind.manager contents_and_result_list
 
 type packed_contents_and_result_list =
-  | Contents_and_result_list : 'kind contents_and_result_list -> packed_contents_and_result_list
+  | Contents_and_result_list :
+      'kind contents_and_result_list
+      -> packed_contents_and_result_list
 
 val contents_and_result_list_encoding :
   packed_contents_and_result_list Data_encoding.t
 
 val pack_contents_list :
-  'kind contents_list -> 'kind contents_result_list ->
+  'kind contents_list ->
+  'kind contents_result_list ->
   'kind contents_and_result_list
 
 val unpack_contents_list :
   'kind contents_and_result_list ->
   'kind contents_list * 'kind contents_result_list
 
-val to_list :
+val to_list : packed_contents_result_list -> packed_contents_result list
-  packed_contents_result_list -> packed_contents_result list
 
-val of_list :
+val of_list : packed_contents_result list -> packed_contents_result_list
-  packed_contents_result list -> packed_contents_result_list
 
 type ('a, 'b) eq = Eq : ('a, 'a) eq
+
 val kind_equal_list :
-  'kind contents_list -> 'kind2 contents_result_list -> ('kind, 'kind2) eq option
+  'kind contents_list ->
+  'kind2 contents_result_list ->
+  ('kind, 'kind2) eq option
 
 type block_metadata = {
   baker : Signature.Public_key_hash.t;
@@ -165,4 +186,5 @@ type block_metadata = {
   deactivated : Signature.Public_key_hash.t list;
   balance_updates : Delegate.balance_updates;
 }
+
 val block_metadata_encoding : block_metadata Data_encoding.encoding

vendors/ligo-utils/tezos-protocol-alpha/baking.ml

@@ -23,15 +23,24 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-
 open Alpha_context
 open Misc
 
 type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
-type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
+
+type error += Timestamp_too_early of Timestamp.t * Timestamp.t
+
+(* `Permanent *)
+
 type error += Unexpected_endorsement (* `Permanent *)
-type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+
+type error +=
+  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t
+
+(* `Permanent *)
+
 type error += Invalid_signature (* `Permanent *)
+
 type error += Invalid_stamp (* `Permanent *)
 
 let () =
@@ -39,14 +48,19 @@ let () =
     `Permanent
     ~id:"baking.timestamp_too_early"
     ~title:"Block forged too early"
-    ~description:"The block timestamp is before the first slot \
+    ~description:
-                  for this baker at this level"
+      "The block timestamp is before the first slot for this baker at this \
+       level"
     ~pp:(fun ppf (r, p) ->
-        Format.fprintf ppf "Block forged too early (%a is before %a)"
+      Format.fprintf
-          Time.pp_hum p Time.pp_hum r)
+        ppf
-    Data_encoding.(obj2
+        "Block forged too early (%a is before %a)"
-                     (req "minimum" Time.encoding)
+        Time.pp_hum
-                     (req "provided" Time.encoding))
+        p
+        Time.pp_hum
+        r)
+    Data_encoding.(
+      obj2 (req "minimum" Time.encoding) (req "provided" Time.encoding))
     (function Timestamp_too_early (r, p) -> Some (r, p) | _ -> None)
     (fun (r, p) -> Timestamp_too_early (r, p)) ;
   register_error_kind
@@ -55,35 +69,36 @@ let () =
     ~title:"Invalid fitness gap"
     ~description:"The gap of fitness is out of bounds"
     ~pp:(fun ppf (m, g) ->
-        Format.fprintf ppf
+      Format.fprintf ppf "The gap of fitness %Ld is not between 0 and %Ld" g m)
-          "The gap of fitness %Ld is not between 0 and %Ld" g m)
+    Data_encoding.(obj2 (req "maximum" int64) (req "provided" int64))
-    Data_encoding.(obj2
-                     (req "maximum" int64)
-                     (req "provided" int64))
     (function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
     (fun (m, g) -> Invalid_fitness_gap (m, g)) ;
   register_error_kind
     `Permanent
     ~id:"baking.invalid_block_signature"
     ~title:"Invalid block signature"
-    ~description:
+    ~description:"A block was not signed with the expected private key."
-      "A block was not signed with the expected private key."
     ~pp:(fun ppf (block, pkh) ->
-        Format.fprintf ppf "Invalid signature for block %a. Expected: %a."
+      Format.fprintf
-          Block_hash.pp_short block
+        ppf
-          Signature.Public_key_hash.pp_short pkh)
+        "Invalid signature for block %a. Expected: %a."
-    Data_encoding.(obj2
+        Block_hash.pp_short
+        block
+        Signature.Public_key_hash.pp_short
+        pkh)
+    Data_encoding.(
+      obj2
         (req "block" Block_hash.encoding)
         (req "expected" Signature.Public_key_hash.encoding))
-    (function Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
+    (function
+      | Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
     (fun (block, pkh) -> Invalid_block_signature (block, pkh)) ;
   register_error_kind
     `Permanent
     ~id:"baking.invalid_signature"
     ~title:"Invalid block signature"
     ~description:"The block's signature is invalid"
-    ~pp:(fun ppf () ->
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid block signature")
-        Format.fprintf ppf "Invalid block signature")
     Data_encoding.empty
     (function Invalid_signature -> Some () | _ -> None)
     (fun () -> Invalid_signature) ;
@@ -92,8 +107,7 @@ let () =
     ~id:"baking.insufficient_proof_of_work"
     ~title:"Insufficient block proof-of-work stamp"
     ~description:"The block's proof-of-work stamp is insufficient"
-    ~pp:(fun ppf () ->
+    ~pp:(fun ppf () -> Format.fprintf ppf "Insufficient proof-of-work stamp")
-        Format.fprintf ppf "Insufficient proof-of-work stamp")
     Data_encoding.empty
     (function Invalid_stamp -> Some () | _ -> None)
     (fun () -> Invalid_stamp) ;
@@ -101,9 +115,11 @@ let () =
     `Permanent
     ~id:"baking.unexpected_endorsement"
     ~title:"Endorsement from unexpected delegate"
-    ~description:"The operation is signed by a delegate without endorsement rights."
+    ~description:
+      "The operation is signed by a delegate without endorsement rights."
     ~pp:(fun ppf () ->
-        Format.fprintf ppf
+      Format.fprintf
+        ppf
         "The endorsement is signed by a delegate without endorsement rights.")
     Data_encoding.unit
     (function Unexpected_endorsement -> Some () | _ -> None)
@@ -112,20 +128,24 @@ let () =
 let minimal_time c priority pred_timestamp =
   let priority = Int32.of_int priority in
   let rec cumsum_time_between_blocks acc durations p =
-    if Compare.Int32.(<=) p 0l then
+    if Compare.Int32.( <= ) p 0l then ok acc
-      ok acc
+    else
-    else match durations with
+      match durations with
-      | [] -> cumsum_time_between_blocks acc [ Period.one_minute ] p
+      | [] ->
+          cumsum_time_between_blocks acc [Period.one_minute] p
       | [last] ->
-          Period.mult p last >>? fun period ->
+          Period.mult p last >>? fun period -> Timestamp.(acc +? period)
-          Timestamp.(acc +? period)
       | first :: durations ->
-          Timestamp.(acc +? first) >>? fun acc ->
+          Timestamp.(acc +? first)
+          >>? fun acc ->
           let p = Int32.pred p in
-          cumsum_time_between_blocks acc durations p in
+          cumsum_time_between_blocks acc durations p
+  in
   Lwt.return
     (cumsum_time_between_blocks
-       pred_timestamp (Constants.time_between_blocks c) (Int32.succ priority))
+       pred_timestamp
+       (Constants.time_between_blocks c)
+       (Int32.succ priority))
 
 let earlier_predecessor_timestamp ctxt level =
   let current = Level.current ctxt in
@@ -135,25 +155,29 @@ let earlier_predecessor_timestamp ctxt level =
   if Compare.Int32.(gap < 1l) then
     failwith "Baking.earlier_block_timestamp: past block."
   else
-    Lwt.return (Period.mult (Int32.pred gap) step) >>=? fun delay ->
+    Lwt.return (Period.mult (Int32.pred gap) step)
-    Lwt.return Timestamp.(current_timestamp +? delay) >>=? fun result ->
+    >>=? fun delay ->
-    return result
+    Lwt.return Timestamp.(current_timestamp +? delay)
+    >>=? fun result -> return result
 
 let check_timestamp c priority pred_timestamp =
-  minimal_time c priority pred_timestamp >>=? fun minimal_time ->
+  minimal_time c priority pred_timestamp
+  >>=? fun minimal_time ->
   let timestamp = Alpha_context.Timestamp.current c in
   Lwt.return
-    (record_trace (Timestamp_too_early (minimal_time, timestamp))
+    (record_trace
+       (Timestamp_too_early (minimal_time, timestamp))
        Timestamp.(timestamp -? minimal_time))
 
-let check_baking_rights c { Block_header.priority ; _ }
+let check_baking_rights c {Block_header.priority; _} pred_timestamp =
-    pred_timestamp =
   let level = Level.current c in
-  Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
+  Roll.baking_rights_owner c level ~priority
-  check_timestamp c priority pred_timestamp >>=? fun block_delay ->
+  >>=? fun delegate ->
-  return (delegate, block_delay)
+  check_timestamp c priority pred_timestamp
+  >>=? fun block_delay -> return (delegate, block_delay)
 
 type error += Incorrect_priority (* `Permanent *)
+
 type error += Incorrect_number_of_endorsements (* `Permanent *)
 
 let () =
@@ -169,8 +193,10 @@ let () =
     (fun () -> Incorrect_priority)
 
 let () =
-  let description = "The number of endorsements must be non-negative and \
+  let description =
-                     at most the endosers_per_block constant." in
+    "The number of endorsements must be non-negative and at most the \
+     endosers_per_block constant."
+  in
   register_error_kind
     `Permanent
     ~id:"incorrect_number_of_endorsements"
@@ -181,89 +207,109 @@ let () =
     (function Incorrect_number_of_endorsements -> Some () | _ -> None)
     (fun () -> Incorrect_number_of_endorsements)
 
-let baking_reward ctxt ~block_priority:prio ~included_endorsements:num_endo =
+let rec reward_for_priority reward_per_prio prio =
-  fail_unless Compare.Int.(prio >= 0) Incorrect_priority >>=? fun () ->
+  match reward_per_prio with
-  let max_endorsements = Constants.endorsers_per_block ctxt in
+  | [] ->
-  fail_unless Compare.Int.(num_endo >= 0 && num_endo <= max_endorsements)
+      (* Empty reward list in parameters means no rewards *)
-    Incorrect_number_of_endorsements >>=? fun () ->
+      Tez.zero
-  let prio_factor_denominator = Int64.(succ (of_int prio)) in
+  | [last] ->
-  let endo_factor_numerator = Int64.of_int (8 + 2 * num_endo / max_endorsements) in
+      last
-  let endo_factor_denominator = 10L in
+  | first :: rest ->
-  Lwt.return
+      if Compare.Int.(prio <= 0) then first
-    Tez.(
+      else reward_for_priority rest (pred prio)
-      Constants.block_reward ctxt *? endo_factor_numerator >>? fun val1 ->
-      val1 /? endo_factor_denominator >>? fun val2 ->
-      val2 /? prio_factor_denominator)
 
-let endorsing_reward ctxt ~block_priority:prio n =
+let baking_reward ctxt ~block_priority ~included_endorsements =
-  if Compare.Int.(prio >= 0)
+  fail_unless Compare.Int.(block_priority >= 0) Incorrect_priority
-  then
+  >>=? fun () ->
-    Lwt.return
+  fail_unless
-      Tez.(Constants.endorsement_reward ctxt /? (Int64.(succ (of_int prio)))) >>=? fun tez ->
+    Compare.Int.(
-    Lwt.return Tez.(tez *? Int64.of_int n)
+      included_endorsements >= 0
-  else fail Incorrect_priority
+      && included_endorsements <= Constants.endorsers_per_block ctxt)
+    Incorrect_number_of_endorsements
+  >>=? fun () ->
+  let reward_per_endorsement =
+    reward_for_priority
+      (Constants.baking_reward_per_endorsement ctxt)
+      block_priority
+  in
+  Lwt.return Tez.(reward_per_endorsement *? Int64.of_int included_endorsements)
+
+let endorsing_reward ctxt ~block_priority num_slots =
+  fail_unless Compare.Int.(block_priority >= 0) Incorrect_priority
+  >>=? fun () ->
+  let reward_per_endorsement =
+    reward_for_priority (Constants.endorsement_reward ctxt) block_priority
+  in
+  Lwt.return Tez.(reward_per_endorsement *? Int64.of_int num_slots)
 
 let baking_priorities c level =
   let rec f priority =
-    Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
+    Roll.baking_rights_owner c level ~priority
-    return (LCons (delegate, (fun () -> f (succ priority))))
+    >>=? fun delegate -> return (LCons (delegate, fun () -> f (succ priority)))
   in
   f 0
 
-let endorsement_rights c level =
+let endorsement_rights ctxt level =
   fold_left_s
     (fun acc slot ->
-       Roll.endorsement_rights_owner c level ~slot >>=? fun pk ->
+      Roll.endorsement_rights_owner ctxt level ~slot
+      >>=? fun pk ->
       let pkh = Signature.Public_key.hash pk in
       let right =
         match Signature.Public_key_hash.Map.find_opt pkh acc with
-         | None -> (pk, [slot], false)
+        | None ->
-         | Some (pk, slots, used) -> (pk, slot :: slots, used) in
+            (pk, [slot], false)
+        | Some (pk, slots, used) ->
+            (pk, slot :: slots, used)
+      in
       return (Signature.Public_key_hash.Map.add pkh right acc))
     Signature.Public_key_hash.Map.empty
-    (0 --> (Constants.endorsers_per_block c - 1))
+    (0 --> (Constants.endorsers_per_block ctxt - 1))
 
-let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t) =
+let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t)
+    =
   let current_level = Level.current ctxt in
-  let Single (Endorsement { level ; _ }) = op.protocol_data.contents in
+  let (Single (Endorsement {level; _})) = op.protocol_data.contents in
-  begin
+  ( if Raw_level.(succ level = current_level.level) then
-    if Raw_level.(succ level = current_level.level) then
     return (Alpha_context.allowed_endorsements ctxt)
-    else
+  else endorsement_rights ctxt (Level.from_raw ctxt level) )
-      endorsement_rights ctxt (Level.from_raw ctxt level)
+  >>=? fun endorsements ->
-  end >>=? fun endorsements ->
   match
     Signature.Public_key_hash.Map.fold (* no find_first *)
       (fun pkh (pk, slots, used) acc ->
         match Operation.check_signature_sync pk chain_id op with
-         | Error _ -> acc
+        | Error _ ->
-         | Ok () -> Some (pkh, slots, used))
+            acc
-      endorsements None
+        | Ok () ->
+            Some (pkh, slots, used))
+      endorsements
+      None
   with
-  | None -> fail Unexpected_endorsement
+  | None ->
-  | Some v -> return v
+      fail Unexpected_endorsement
+  | Some v ->
+      return v
 
 let select_delegate delegate delegate_list max_priority =
   let rec loop acc l n =
-    if Compare.Int.(n >= max_priority)
+    if Compare.Int.(n >= max_priority) then return (List.rev acc)
-    then return (List.rev acc)
     else
-      let LCons (pk, t) = l in
+      let (LCons (pk, t)) = l in
       let acc =
-        if Signature.Public_key_hash.equal delegate (Signature.Public_key.hash pk)
+        if
+          Signature.Public_key_hash.equal
+            delegate
+            (Signature.Public_key.hash pk)
         then n :: acc
-        else acc in
+        else acc
-      t () >>=? fun t ->
+      in
-      loop acc t (succ n)
+      t () >>=? fun t -> loop acc t (succ n)
   in
   loop [] delegate_list 0
 
-let first_baking_priorities
+let first_baking_priorities ctxt ?(max_priority = 32) delegate level =
-    ctxt
+  baking_priorities ctxt level
-    ?(max_priority = 32)
+  >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority
-    delegate level =
-  baking_priorities ctxt level >>=? fun delegate_list ->
-  select_delegate delegate delegate_list max_priority
 
 let check_hash hash stamp_threshold =
   let bytes = Block_hash.to_bytes hash in
@@ -273,18 +319,19 @@ let check_hash hash stamp_threshold =
 let check_header_proof_of_work_stamp shell contents stamp_threshold =
   let hash =
     Block_header.hash
-      { shell ; protocol_data = { contents ; signature = Signature.zero } } in
+      {shell; protocol_data = {contents; signature = Signature.zero}}
+  in
   check_hash hash stamp_threshold
 
 let check_proof_of_work_stamp ctxt block =
   let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
-  if check_header_proof_of_work_stamp
+  if
+    check_header_proof_of_work_stamp
       block.Block_header.shell
       block.protocol_data.contents
-      proof_of_work_threshold then
+      proof_of_work_threshold
-    return_unit
+  then return_unit
-  else
+  else fail Invalid_stamp
-    fail Invalid_stamp
 
 let check_signature block chain_id key =
   let check_signature key
@@ -292,65 +339,69 @@ let check_signature block chain_id key =
     let unsigned_header =
       Data_encoding.Binary.to_bytes_exn
         Block_header.unsigned_encoding
-        (shell, contents) in
+        (shell, contents)
-    Signature.check ~watermark:(Block_header chain_id) key signature unsigned_header in
+    in
-  if check_signature key block then
+    Signature.check
-    return_unit
+      ~watermark:(Block_header chain_id)
+      key
+      signature
+      unsigned_header
+  in
+  if check_signature key block then return_unit
   else
-    fail (Invalid_block_signature (Block_header.hash block,
+    fail
-                                   Signature.Public_key.hash key))
+      (Invalid_block_signature
+         (Block_header.hash block, Signature.Public_key.hash key))
 
 let max_fitness_gap _ctxt = 1L
 
 let check_fitness_gap ctxt (block : Block_header.t) =
   let current_fitness = Fitness.current ctxt in
-  Lwt.return (Fitness.to_int64 block.shell.fitness) >>=? fun announced_fitness ->
+  Lwt.return (Fitness.to_int64 block.shell.fitness)
+  >>=? fun announced_fitness ->
   let gap = Int64.sub announced_fitness current_fitness in
   if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then
     fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap))
-  else
+  else return_unit
-    return_unit
 
 let last_of_a_cycle ctxt l =
-  Compare.Int32.(Int32.succ l.Level.cycle_position =
+  Compare.Int32.(
-                 Constants.blocks_per_cycle ctxt)
+    Int32.succ l.Level.cycle_position = Constants.blocks_per_cycle ctxt)
 
 let dawn_of_a_new_cycle ctxt =
   let level = Level.current ctxt in
-  if last_of_a_cycle ctxt level then
+  if last_of_a_cycle ctxt level then return_some level.cycle else return_none
-    return_some level.cycle
-  else
-    return_none
 
 let minimum_allowed_endorsements ctxt ~block_delay =
   let minimum = Constants.initial_endorsers ctxt in
   let delay_per_missing_endorsement =
     Int64.to_int
-      (Period.to_seconds
+      (Period.to_seconds (Constants.delay_per_missing_endorsement ctxt))
-         (Constants.delay_per_missing_endorsement ctxt))
   in
   let reduced_time_constraint =
     let delay = Int64.to_int (Period.to_seconds block_delay) in
-    if Compare.Int.(delay_per_missing_endorsement = 0) then
+    if Compare.Int.(delay_per_missing_endorsement = 0) then delay
-      delay
+    else delay / delay_per_missing_endorsement
-    else
-      delay / delay_per_missing_endorsement
   in
   Compare.Int.max 0 (minimum - reduced_time_constraint)
 
 let minimal_valid_time ctxt ~priority ~endorsing_power =
   let predecessor_timestamp = Timestamp.current ctxt in
-  minimal_time ctxt
+  minimal_time ctxt priority predecessor_timestamp
-    priority predecessor_timestamp >>=? fun minimal_time ->
+  >>=? fun minimal_time ->
   let minimal_required_endorsements = Constants.initial_endorsers ctxt in
   let delay_per_missing_endorsement =
     Constants.delay_per_missing_endorsement ctxt
   in
   let missing_endorsements =
-    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power) in
+    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power)
-  match Period.mult
+  in
+  match
+    Period.mult
       (Int32.of_int missing_endorsements)
-          delay_per_missing_endorsement with
+      delay_per_missing_endorsement
+  with
   | Ok delay ->
       return (Time.add minimal_time (Period.to_seconds delay))
-  | Error _ as err -> Lwt.return err
+  | Error _ as err ->
+      Lwt.return err

vendors/ligo-utils/tezos-protocol-alpha/baking.mli

@@ -23,15 +23,24 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-
 open Alpha_context
 open Misc
 
 type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
-type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
+
-type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+type error += Timestamp_too_early of Timestamp.t * Timestamp.t
+
+(* `Permanent *)
+
+type error +=
+  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t
+
+(* `Permanent *)
+
 type error += Unexpected_endorsement
+
 type error += Invalid_signature (* `Permanent *)
+
 type error += Invalid_stamp (* `Permanent *)
 
 (** [minimal_time ctxt priority pred_block_time] returns the minimal
@@ -46,7 +55,9 @@ val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t
     * the timestamp is coherent with the announced slot.
 *)
 val check_baking_rights :
-  context -> Block_header.contents -> Time.t ->
+  context ->
+  Block_header.contents ->
+  Time.t ->
   (public_key * Period.t) tzresult Lwt.t
 
 (** For a given level computes who has the right to
@@ -60,23 +71,26 @@ val endorsement_rights:
 (** Check that the operation was signed by a delegate allowed
     to endorse at the level specified by the endorsement. *)
 val check_endorsement_rights :
-  context -> Chain_id.t -> Kind.endorsement Operation.t ->
+  context ->
+  Chain_id.t ->
+  Kind.endorsement Operation.t ->
   (public_key_hash * int list * bool) tzresult Lwt.t
 
 (** Returns the baking reward calculated w.r.t a given priority [p] and a
-    number [e] of included endorsements as follows:
+    number [e] of included endorsements *)
-      (block_reward / (p+1)) * (0.8 + 0.2 * e / endorsers_per_block)
+val baking_reward :
-*)
+  context ->
-val baking_reward: context ->
+  block_priority:int ->
-  block_priority:int -> included_endorsements:int -> Tez.t tzresult Lwt.t
+  included_endorsements:int ->
+  Tez.t tzresult Lwt.t
 
 (** Returns the endorsing reward calculated w.r.t a given priority.  *)
-val endorsing_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
+val endorsing_reward :
+  context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
 
 (** [baking_priorities ctxt level] is the lazy list of contract's
     public key hashes that are allowed to bake for [level]. *)
-val baking_priorities:
+val baking_priorities : context -> Level.t -> public_key lazy_list
-  context -> Level.t -> public_key lazy_list
 
 (** [first_baking_priorities ctxt ?max_priority contract_hash level]
     is a list of priorities of max [?max_priority] elements, where the
@@ -92,7 +106,8 @@ val first_baking_priorities:
 
 (** [check_signature ctxt chain_id block id] check if the block is
     signed with the given key, and belongs to the given [chain_id] *)
-val check_signature: Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t
+val check_signature :
+  Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t
 
 (** Checks if the header that would be built from the given components
     is valid for the given diffculty. The signature is not passed as it
@@ -107,12 +122,12 @@ val check_proof_of_work_stamp:
 
 (** check if the gap between the fitness of the current context
     and the given block is within the protocol parameters *)
-val check_fitness_gap:
+val check_fitness_gap : context -> Block_header.t -> unit tzresult Lwt.t
-  context -> Block_header.t -> unit tzresult Lwt.t
 
 val dawn_of_a_new_cycle : context -> Cycle.t option tzresult Lwt.t
 
-val earlier_predecessor_timestamp: context -> Level.t -> Timestamp.t tzresult Lwt.t
+val earlier_predecessor_timestamp :
+  context -> Level.t -> Timestamp.t tzresult Lwt.t
 
 (** Since Emmy+
 
@@ -145,7 +160,4 @@ val minimum_allowed_endorsements: context -> block_delay:Period.t -> int
     `endorsing_power` argument), it returns the minimum time at which
     the next block can be baked. *)
 val minimal_valid_time :
-  context ->
+  context -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t
-  priority:int ->
-  endorsing_power: int ->
-  Time.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/blinded_public_key_hash.ml

@@ -23,17 +23,22 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-module H = Blake2B.Make(Base58)(struct
+module H =
+  Blake2B.Make
+    (Base58)
+    (struct
       let name = "Blinded public key hash"
+
       let title = "A blinded public key hash"
+
       let b58check_prefix = "\001\002\049\223"
+
       let size = Some Ed25519.Public_key_hash.size
     end)
 
 include H
 
-let () =
+let () = Base58.check_encoded_prefix b58check_encoding "btz1" 37
-  Base58.check_encoded_prefix b58check_encoding "btz1" 37
 
 let of_ed25519_pkh activation_code pkh =
   hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh]
@@ -41,6 +46,7 @@ let of_ed25519_pkh activation_code pkh =
 type activation_code = MBytes.t
 
 let activation_code_size = Ed25519.Public_key_hash.size
+
 let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size
 
 let activation_code_of_hex h =

vendors/ligo-utils/tezos-protocol-alpha/blinded_public_key_hash.mli

@@ -26,9 +26,11 @@
 include S.HASH
 
 val encoding : t Data_encoding.t
+
 val rpc_arg : t RPC_arg.t
 
 type activation_code
+
 val activation_code_encoding : activation_code Data_encoding.t
 
 val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t

vendors/ligo-utils/tezos-protocol-alpha/block_header_repr.ml

@@ -25,15 +25,9 @@
 
 (** Block header *)
 
-type t = {
+type t = {shell : Block_header.shell_header; protocol_data : protocol_data}
-  shell: Block_header.shell_header ;
-  protocol_data: protocol_data ;
-}
 
-and protocol_data = {
+and protocol_data = {contents : contents; signature : Signature.t}
-  contents: contents ;
-  signature: Signature.t ;
-}
 
 and contents = {
   priority : int;
@@ -44,64 +38,61 @@ and contents = {
 type block_header = t
 
 type raw = Block_header.t
+
 type shell_header = Block_header.shell_header
 
 let raw_encoding = Block_header.encoding
+
 let shell_header_encoding = Block_header.shell_header_encoding
 
 let contents_encoding =
   let open Data_encoding in
-  def "block_header.alpha.unsigned_contents" @@
+  def "block_header.alpha.unsigned_contents"
-  conv
+  @@ conv
        (fun {priority; seed_nonce_hash; proof_of_work_nonce} ->
          (priority, proof_of_work_nonce, seed_nonce_hash))
        (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
          {priority; seed_nonce_hash; proof_of_work_nonce})
        (obj3
           (req "priority" uint16)
-       (req "proof_of_work_nonce"
+          (req
+             "proof_of_work_nonce"
              (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
           (opt "seed_nonce_hash" Nonce_hash.encoding))
 
 let protocol_data_encoding =
   let open Data_encoding in
-  def "block_header.alpha.signed_contents" @@
+  def "block_header.alpha.signed_contents"
-  conv
+  @@ conv
        (fun {contents; signature} -> (contents, signature))
        (fun (contents, signature) -> {contents; signature})
        (merge_objs
           contents_encoding
           (obj1 (req "signature" Signature.encoding)))
 
-let raw { shell ; protocol_data ; } =
+let raw {shell; protocol_data} =
   let protocol_data =
-    Data_encoding.Binary.to_bytes_exn
+    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
-      protocol_data_encoding
+  in
-      protocol_data in
   {Block_header.shell; protocol_data}
 
 let unsigned_encoding =
   let open Data_encoding in
-  merge_objs
+  merge_objs Block_header.shell_header_encoding contents_encoding
-    Block_header.shell_header_encoding
-    contents_encoding
 
 let encoding =
   let open Data_encoding in
-  def "block_header.alpha.full_header" @@
+  def "block_header.alpha.full_header"
-  conv
+  @@ conv
-    (fun { shell ; protocol_data } ->
+       (fun {shell; protocol_data} -> (shell, protocol_data))
-       (shell, protocol_data))
+       (fun (shell, protocol_data) -> {shell; protocol_data})
-    (fun (shell, protocol_data) ->
+       (merge_objs Block_header.shell_header_encoding protocol_data_encoding)
-       { shell ; protocol_data })
-    (merge_objs
-       Block_header.shell_header_encoding
-       protocol_data_encoding)
 
 (** Constants *)
 
 let max_header_length =
-  let fake_shell = {
+  let fake_shell =
+    {
       Block_header.level = 0l;
       proto_level = 0;
       predecessor = Block_hash.zero;
@@ -112,27 +103,28 @@ let max_header_length =
       context = Context_hash.zero;
     }
   and fake_contents =
-    { priority = 0 ;
+    {
+      priority = 0;
       proof_of_work_nonce =
         MBytes.create Constants_repr.proof_of_work_nonce_size;
-      seed_nonce_hash = Some Nonce_hash.zero
+      seed_nonce_hash = Some Nonce_hash.zero;
-    } in
+    }
+  in
   Data_encoding.Binary.length
     encoding
-    { shell = fake_shell ;
+    {
-      protocol_data = {
+      shell = fake_shell;
-        contents = fake_contents ;
+      protocol_data = {contents = fake_contents; signature = Signature.zero};
-        signature = Signature.zero ;
-      }
     }
 
 (** Header parsing entry point  *)
 
 let hash_raw = Block_header.hash
+
 let hash {shell; protocol_data} =
   Block_header.hash
-    { shell ;
+    {
+      shell;
       protocol_data =
-        Data_encoding.Binary.to_bytes_exn
+        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data;
-          protocol_data_encoding
+    }
-          protocol_data }

vendors/ligo-utils/tezos-protocol-alpha/block_header_repr.mli

@@ -23,15 +23,9 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type t = {
+type t = {shell : Block_header.shell_header; protocol_data : protocol_data}
-  shell: Block_header.shell_header ;
-  protocol_data: protocol_data ;
-}
 
-and protocol_data = {
+and protocol_data = {contents : contents; signature : Signature.t}
-  contents: contents ;
-  signature: Signature.t ;
-}
 
 and contents = {
   priority : int;
@@ -42,19 +36,26 @@ and contents = {
 type block_header = t
 
 type raw = Block_header.t
+
 type shell_header = Block_header.shell_header
 
 val raw : block_header -> raw
 
 val encoding : block_header Data_encoding.encoding
+
 val raw_encoding : raw Data_encoding.t
+
 val contents_encoding : contents Data_encoding.t
+
 val unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t
+
 val protocol_data_encoding : protocol_data Data_encoding.encoding
+
 val shell_header_encoding : shell_header Data_encoding.encoding
 
-val max_header_length: int
 (** The maximum size of block headers in bytes *)
+val max_header_length : int
 
 val hash : block_header -> Block_hash.t
+
 val hash_raw : raw -> Block_hash.t

vendors/ligo-utils/tezos-protocol-alpha/bootstrap_storage.ml

@@ -26,100 +26,128 @@
 open Misc
 
 let init_account ctxt
-    ({ public_key_hash ; public_key ; amount }: Parameters_repr.bootstrap_account) =
+    ({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account)
+    =
   let contract = Contract_repr.implicit_contract public_key_hash in
-  Contract_storage.credit ctxt contract amount >>=? fun ctxt ->
+  Contract_storage.credit ctxt contract amount
+  >>=? fun ctxt ->
   match public_key with
   | Some public_key ->
-      Contract_storage.reveal_manager_key ctxt public_key_hash public_key >>=? fun ctxt ->
+      Contract_storage.reveal_manager_key ctxt public_key_hash public_key
-      Delegate_storage.set ctxt contract (Some public_key_hash) >>=? fun ctxt ->
+      >>=? fun ctxt ->
+      Delegate_storage.set ctxt contract (Some public_key_hash)
+      >>=? fun ctxt -> return ctxt
+  | None ->
       return ctxt
-  | None -> return ctxt
 
 let init_contract ~typecheck ctxt
     ({delegate; amount; script} : Parameters_repr.bootstrap_contract) =
-  Contract_storage.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
+  Contract_storage.fresh_contract_from_current_nonce ctxt
-  typecheck ctxt script >>=? fun (script, ctxt) ->
+  >>=? fun (ctxt, contract) ->
-  Contract_storage.originate ctxt contract
+  typecheck ctxt script
+  >>=? fun (script, ctxt) ->
+  Contract_storage.originate
+    ctxt
+    contract
     ~balance:amount
     ~prepaid_bootstrap_storage:true
     ~script
-    ~delegate:(Some delegate) >>=? fun ctxt ->
+    ~delegate:(Some delegate)
-  return ctxt
+  >>=? fun ctxt -> return ctxt
 
 let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =
   let nonce =
-    Operation_hash.hash_bytes
+    Operation_hash.hash_bytes [MBytes.of_string "Un festival de GADT."]
-      [ MBytes.of_string "Un festival de GADT." ] in
+  in
   let ctxt = Raw_context.init_origination_nonce ctxt nonce in
-  fold_left_s init_account ctxt accounts >>=? fun ctxt ->
+  fold_left_s init_account ctxt accounts
-  fold_left_s (init_contract ~typecheck) ctxt contracts >>=? fun ctxt ->
+  >>=? fun ctxt ->
-  begin
+  fold_left_s (init_contract ~typecheck) ctxt contracts
-    match no_reward_cycles with
+  >>=? fun ctxt ->
-    | None -> return ctxt
+  ( match no_reward_cycles with
+  | None ->
+      return ctxt
   | Some cycles ->
       (* Store pending ramp ups. *)
       let constants = Raw_context.constants ctxt in
-        (* Start without reward *)
+      (* Start without rewards *)
-        Raw_context.patch_constants ctxt
+      Raw_context.patch_constants ctxt (fun c ->
-          (fun c ->
+          {
-             { c with
+            c with
-               block_reward = Tez_repr.zero ;
+            baking_reward_per_endorsement = [Tez_repr.zero];
-               endorsement_reward = Tez_repr.zero  }) >>= fun ctxt ->
+            endorsement_reward = [Tez_repr.zero];
+          })
+      >>= fun ctxt ->
       (* Store the final reward. *)
-        Storage.Ramp_up.Rewards.init ctxt
+      Storage.Ramp_up.Rewards.init
+        ctxt
         (Cycle_repr.of_int32_exn (Int32.of_int cycles))
-          (constants.block_reward,
+        (constants.baking_reward_per_endorsement, constants.endorsement_reward)
-           constants.endorsement_reward)
+  )
-  end >>=? fun ctxt ->
+  >>=? fun ctxt ->
   match ramp_up_cycles with
-  | None -> return ctxt
+  | None ->
+      return ctxt
   | Some cycles ->
       (* Store pending ramp ups. *)
       let constants = Raw_context.constants ctxt in
-      Lwt.return Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles) >>=? fun block_step ->
+      Lwt.return
-      Lwt.return Tez_repr.(constants.endorsement_security_deposit /? Int64.of_int cycles) >>=? fun endorsement_step ->
+        Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles)
+      >>=? fun block_step ->
+      Lwt.return
+        Tez_repr.(
+          constants.endorsement_security_deposit /? Int64.of_int cycles)
+      >>=? fun endorsement_step ->
       (* Start without security_deposit *)
-      Raw_context.patch_constants ctxt
+      Raw_context.patch_constants ctxt (fun c ->
-        (fun c ->
+          {
-           { c with
+            c with
             block_security_deposit = Tez_repr.zero;
-             endorsement_security_deposit = Tez_repr.zero  }) >>= fun ctxt ->
+            endorsement_security_deposit = Tez_repr.zero;
+          })
+      >>= fun ctxt ->
       fold_left_s
         (fun ctxt cycle ->
-           Lwt.return Tez_repr.(block_step *? Int64.of_int cycle) >>=? fun block_security_deposit ->
+          Lwt.return Tez_repr.(block_step *? Int64.of_int cycle)
-           Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle) >>=? fun endorsement_security_deposit ->
+          >>=? fun block_security_deposit ->
+          Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle)
+          >>=? fun endorsement_security_deposit ->
           let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
-           Storage.Ramp_up.Security_deposits.init ctxt cycle
+          Storage.Ramp_up.Security_deposits.init
+            ctxt
+            cycle
             (block_security_deposit, endorsement_security_deposit))
         ctxt
-        (1 --> (cycles - 1)) >>=? fun ctxt ->
+        (1 --> (cycles - 1))
+      >>=? fun ctxt ->
       (* Store the final security deposits. *)
-      Storage.Ramp_up.Security_deposits.init ctxt
+      Storage.Ramp_up.Security_deposits.init
+        ctxt
         (Cycle_repr.of_int32_exn (Int32.of_int cycles))
         ( constants.block_security_deposit,
-         constants.endorsement_security_deposit) >>=? fun ctxt ->
+          constants.endorsement_security_deposit )
-      return ctxt
+      >>=? fun ctxt -> return ctxt
 
 let cycle_end ctxt last_cycle =
   let next_cycle = Cycle_repr.succ last_cycle in
-  begin
+  Storage.Ramp_up.Rewards.get_option ctxt next_cycle
-    Storage.Ramp_up.Rewards.get_option ctxt next_cycle >>=? function
+  >>=? (function
-    | None -> return ctxt
+         | None ->
-    | Some (block_reward, endorsement_reward) ->
+             return ctxt
-        Storage.Ramp_up.Rewards.delete ctxt next_cycle >>=? fun ctxt ->
+         | Some (baking_reward_per_endorsement, endorsement_reward) ->
-        Raw_context.patch_constants ctxt
+             Storage.Ramp_up.Rewards.delete ctxt next_cycle
-          (fun c ->
+             >>=? fun ctxt ->
-             { c with block_reward ;
+             Raw_context.patch_constants ctxt (fun c ->
-                      endorsement_reward }) >>= fun ctxt ->
+                 {c with baking_reward_per_endorsement; endorsement_reward})
+             >>= fun ctxt -> return ctxt)
+  >>=? fun ctxt ->
+  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle
+  >>=? function
+  | None ->
       return ctxt
-  end >>=? fun ctxt ->
-  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle >>=? function
-  | None -> return ctxt
   | Some (block_security_deposit, endorsement_security_deposit) ->
-      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle >>=? fun ctxt ->
+      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle
-      Raw_context.patch_constants ctxt
+      >>=? fun ctxt ->
-        (fun c ->
+      Raw_context.patch_constants ctxt (fun c ->
-           { c with block_security_deposit ;
+          {c with block_security_deposit; endorsement_security_deposit})
-                    endorsement_security_deposit }) >>= fun ctxt ->
+      >>= fun ctxt -> return ctxt
-      return ctxt

vendors/ligo-utils/tezos-protocol-alpha/bootstrap_storage.mli

@@ -25,16 +25,16 @@
 
 val init :
   Raw_context.t ->
-  typecheck:(Raw_context.t -> Script_repr.t ->
+  typecheck:(Raw_context.t ->
-             ((Script_repr.t * Contract_storage.big_map_diff option) * Raw_context.t)
+            Script_repr.t ->
-               tzresult Lwt.t) ->
+            ( (Script_repr.t * Contract_storage.big_map_diff option)
+            * Raw_context.t )
+            tzresult
+            Lwt.t) ->
   ?ramp_up_cycles:int ->
   ?no_reward_cycles:int ->
   Parameters_repr.bootstrap_account list ->
   Parameters_repr.bootstrap_contract list ->
   Raw_context.t tzresult Lwt.t
 
-val cycle_end:
+val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
-  Raw_context.t ->
-  Cycle_repr.t ->
-  Raw_context.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/commitment_repr.ml

@@ -25,7 +25,7 @@
 
 type t = {
   blinded_public_key_hash : Blinded_public_key_hash.t;
-  amount : Tez_repr.t
+  amount : Tez_repr.t;
 }
 
 let encoding =
@@ -35,6 +35,4 @@ let encoding =
       (blinded_public_key_hash, amount))
     (fun (blinded_public_key_hash, amount) ->
       {blinded_public_key_hash; amount})
-    (tup2
+    (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding)
-       Blinded_public_key_hash.encoding
-       Tez_repr.encoding)

vendors/ligo-utils/tezos-protocol-alpha/commitment_storage.ml

@@ -24,10 +24,11 @@
 (*****************************************************************************)
 
 let get_opt = Storage.Commitments.get_option
+
 let delete = Storage.Commitments.delete
 
 let init ctxt commitments =
   let init_commitment ctxt Commitment_repr.{blinded_public_key_hash; amount} =
-    Storage.Commitments.init ctxt blinded_public_key_hash amount in
+    Storage.Commitments.init ctxt blinded_public_key_hash amount
-  fold_left_s init_commitment ctxt commitments >>=? fun ctxt ->
+  in
-  return ctxt
+  fold_left_s init_commitment ctxt commitments >>=? fun ctxt -> return ctxt

vendors/ligo-utils/tezos-protocol-alpha/commitment_storage.mli

@@ -24,14 +24,12 @@
 (*****************************************************************************)
 
 val init :
-  Raw_context.t ->
+  Raw_context.t -> Commitment_repr.t list -> Raw_context.t tzresult Lwt.t
-  Commitment_repr.t list ->
-  Raw_context.t tzresult Lwt.t
 
 val get_opt :
-  Raw_context.t -> Blinded_public_key_hash.t ->
+  Raw_context.t ->
+  Blinded_public_key_hash.t ->
   Tez_repr.t option tzresult Lwt.t
 
 val delete :
-  Raw_context.t -> Blinded_public_key_hash.t ->
+  Raw_context.t -> Blinded_public_key_hash.t -> Raw_context.t tzresult Lwt.t
-  Raw_context.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/constants_repr.ml

@@ -24,11 +24,17 @@
 (*****************************************************************************)
 
 let version_number_004 = "\000"
+
 let version_number = "\001"
+
 let proof_of_work_nonce_size = 8
+
 let nonce_length = 32
+
 let max_revelations_per_block = 32
+
 let max_proposals_per_delegate = 20
+
 let max_operation_data_length = 16 * 1024 (* 16kB *)
 
 type fixed = {
@@ -53,7 +59,8 @@ let fixed_encoding =
            max_revelations_per_block,
            max_operation_data_length,
            max_proposals_per_delegate ) ->
-      { proof_of_work_nonce_size ;
+      {
+        proof_of_work_nonce_size;
         nonce_length;
         max_revelations_per_block;
         max_operation_data_length;
@@ -66,7 +73,8 @@ let fixed_encoding =
        (req "max_operation_data_length" int31)
        (req "max_proposals_per_delegate" uint8))
 
-let fixed = {
+let fixed =
+  {
     proof_of_work_nonce_size;
     nonce_length;
     max_revelations_per_block;
@@ -74,6 +82,162 @@ let fixed = {
     max_proposals_per_delegate;
   }
 
+type parametric = {
+  preserved_cycles : int;
+  blocks_per_cycle : int32;
+  blocks_per_commitment : int32;
+  blocks_per_roll_snapshot : int32;
+  blocks_per_voting_period : int32;
+  time_between_blocks : Period_repr.t list;
+  endorsers_per_block : int;
+  hard_gas_limit_per_operation : Z.t;
+  hard_gas_limit_per_block : Z.t;
+  proof_of_work_threshold : int64;
+  tokens_per_roll : Tez_repr.t;
+  michelson_maximum_type_size : int;
+  seed_nonce_revelation_tip : Tez_repr.t;
+  origination_size : int;
+  block_security_deposit : Tez_repr.t;
+  endorsement_security_deposit : Tez_repr.t;
+  baking_reward_per_endorsement : Tez_repr.t list;
+  endorsement_reward : Tez_repr.t list;
+  cost_per_byte : Tez_repr.t;
+  hard_storage_limit_per_operation : Z.t;
+  test_chain_duration : int64;
+  (* in seconds *)
+  quorum_min : int32;
+  quorum_max : int32;
+  min_proposal_quorum : int32;
+  initial_endorsers : int;
+  delay_per_missing_endorsement : Period_repr.t;
+}
+
+let parametric_encoding =
+  let open Data_encoding in
+  conv
+    (fun c ->
+      ( ( c.preserved_cycles,
+          c.blocks_per_cycle,
+          c.blocks_per_commitment,
+          c.blocks_per_roll_snapshot,
+          c.blocks_per_voting_period,
+          c.time_between_blocks,
+          c.endorsers_per_block,
+          c.hard_gas_limit_per_operation,
+          c.hard_gas_limit_per_block ),
+        ( ( c.proof_of_work_threshold,
+            c.tokens_per_roll,
+            c.michelson_maximum_type_size,
+            c.seed_nonce_revelation_tip,
+            c.origination_size,
+            c.block_security_deposit,
+            c.endorsement_security_deposit,
+            c.baking_reward_per_endorsement ),
+          ( c.endorsement_reward,
+            c.cost_per_byte,
+            c.hard_storage_limit_per_operation,
+            c.test_chain_duration,
+            c.quorum_min,
+            c.quorum_max,
+            c.min_proposal_quorum,
+            c.initial_endorsers,
+            c.delay_per_missing_endorsement ) ) ))
+    (fun ( ( preserved_cycles,
+             blocks_per_cycle,
+             blocks_per_commitment,
+             blocks_per_roll_snapshot,
+             blocks_per_voting_period,
+             time_between_blocks,
+             endorsers_per_block,
+             hard_gas_limit_per_operation,
+             hard_gas_limit_per_block ),
+           ( ( proof_of_work_threshold,
+               tokens_per_roll,
+               michelson_maximum_type_size,
+               seed_nonce_revelation_tip,
+               origination_size,
+               block_security_deposit,
+               endorsement_security_deposit,
+               baking_reward_per_endorsement ),
+             ( endorsement_reward,
+               cost_per_byte,
+               hard_storage_limit_per_operation,
+               test_chain_duration,
+               quorum_min,
+               quorum_max,
+               min_proposal_quorum,
+               initial_endorsers,
+               delay_per_missing_endorsement ) ) ) ->
+      {
+        preserved_cycles;
+        blocks_per_cycle;
+        blocks_per_commitment;
+        blocks_per_roll_snapshot;
+        blocks_per_voting_period;
+        time_between_blocks;
+        endorsers_per_block;
+        hard_gas_limit_per_operation;
+        hard_gas_limit_per_block;
+        proof_of_work_threshold;
+        tokens_per_roll;
+        michelson_maximum_type_size;
+        seed_nonce_revelation_tip;
+        origination_size;
+        block_security_deposit;
+        endorsement_security_deposit;
+        baking_reward_per_endorsement;
+        endorsement_reward;
+        cost_per_byte;
+        hard_storage_limit_per_operation;
+        test_chain_duration;
+        quorum_min;
+        quorum_max;
+        min_proposal_quorum;
+        initial_endorsers;
+        delay_per_missing_endorsement;
+      })
+    (merge_objs
+       (obj9
+          (req "preserved_cycles" uint8)
+          (req "blocks_per_cycle" int32)
+          (req "blocks_per_commitment" int32)
+          (req "blocks_per_roll_snapshot" int32)
+          (req "blocks_per_voting_period" int32)
+          (req "time_between_blocks" (list Period_repr.encoding))
+          (req "endorsers_per_block" uint16)
+          (req "hard_gas_limit_per_operation" z)
+          (req "hard_gas_limit_per_block" z))
+       (merge_objs
+          (obj8
+             (req "proof_of_work_threshold" int64)
+             (req "tokens_per_roll" Tez_repr.encoding)
+             (req "michelson_maximum_type_size" uint16)
+             (req "seed_nonce_revelation_tip" Tez_repr.encoding)
+             (req "origination_size" int31)
+             (req "block_security_deposit" Tez_repr.encoding)
+             (req "endorsement_security_deposit" Tez_repr.encoding)
+             (req "baking_reward_per_endorsement" (list Tez_repr.encoding)))
+          (obj9
+             (req "endorsement_reward" (list Tez_repr.encoding))
+             (req "cost_per_byte" Tez_repr.encoding)
+             (req "hard_storage_limit_per_operation" z)
+             (req "test_chain_duration" int64)
+             (req "quorum_min" int32)
+             (req "quorum_max" int32)
+             (req "min_proposal_quorum" int32)
+             (req "initial_endorsers" uint16)
+             (req "delay_per_missing_endorsement" Period_repr.encoding))))
+
+type t = {fixed : fixed; parametric : parametric}
+
+let encoding =
+  let open Data_encoding in
+  conv
+    (fun {fixed; parametric} -> (fixed, parametric))
+    (fun (fixed, parametric) -> {fixed; parametric})
+    (merge_objs fixed_encoding parametric_encoding)
+
+module Proto_005 = struct
   type parametric = {
     preserved_cycles : int;
     blocks_per_cycle : int32;
@@ -95,7 +259,8 @@ type parametric = {
     endorsement_reward : Tez_repr.t;
     cost_per_byte : Tez_repr.t;
     hard_storage_limit_per_operation : Z.t;
-  test_chain_duration: int64 ;  (* in seconds *)
+    test_chain_duration : int64;
+    (* in seconds *)
     quorum_min : int32;
     quorum_max : int32;
     min_proposal_quorum : int32;
@@ -132,8 +297,7 @@ let parametric_encoding =
               c.quorum_max,
               c.min_proposal_quorum,
               c.initial_endorsers,
-          c.delay_per_missing_endorsement
+              c.delay_per_missing_endorsement ) ) ))
-         ))) )
       (fun ( ( preserved_cycles,
                blocks_per_cycle,
                blocks_per_commitment,
@@ -160,7 +324,8 @@ let parametric_encoding =
                  min_proposal_quorum,
                  initial_endorsers,
                  delay_per_missing_endorsement ) ) ) ->
-      { preserved_cycles ;
+        {
+          preserved_cycles;
           blocks_per_cycle;
           blocks_per_commitment;
           blocks_per_roll_snapshot;
@@ -217,17 +382,5 @@ let parametric_encoding =
                (req "quorum_max" int32)
                (req "min_proposal_quorum" int32)
                (req "initial_endorsers" uint16)
-             (req "delay_per_missing_endorsement" Period_repr.encoding)
+               (req "delay_per_missing_endorsement" Period_repr.encoding))))
-          )))
+end
-
-type t = {
-  fixed : fixed ;
-  parametric : parametric ;
-}
-
-let encoding =
-  let open Data_encoding in
-  conv
-    (fun { fixed ; parametric } -> (fixed, parametric))
-    (fun (fixed , parametric) -> { fixed ; parametric })
-    (merge_objs fixed_encoding parametric_encoding)

vendors/ligo-utils/tezos-protocol-alpha/constants_services.ml

@@ -26,10 +26,10 @@
 open Alpha_context
 
 let custom_root =
-  (RPC_path.(open_root / "context" / "constants") : RPC_context.t RPC_path.context)
+  ( RPC_path.(open_root / "context" / "constants")
+    : RPC_context.t RPC_path.context )
 
 module S = struct
-
   open Data_encoding
 
   let errors =
@@ -45,21 +45,16 @@ module S = struct
       ~query:RPC_query.empty
       ~output:Alpha_context.Constants.encoding
       custom_root
-
 end
 
 let register () =
   let open Services_registration in
-  register0_noctxt S.errors begin fun () () ->
+  register0_noctxt S.errors (fun () () ->
-    return (Data_encoding.Json.(schema error_encoding))
+      return Data_encoding.Json.(schema error_encoding)) ;
-  end ;
+  register0 S.all (fun ctxt () () ->
-  register0 S.all begin fun ctxt () () ->
       let open Constants in
-    return { fixed = fixed ;
+      return {fixed; parametric = parametric ctxt})
-             parametric = parametric ctxt }
-  end
 
-let errors ctxt block =
+let errors ctxt block = RPC_context.make_call0 S.errors ctxt block () ()
-  RPC_context.make_call0 S.errors ctxt block () ()
+
-let all ctxt block =
+let all ctxt block = RPC_context.make_call0 S.all ctxt block () ()
-  RPC_context.make_call0 S.all ctxt block () ()

vendors/ligo-utils/tezos-protocol-alpha/constants_services.mli

@@ -26,10 +26,11 @@
 open Alpha_context
 
 val errors :
-  'a #RPC_context.simple -> 'a -> Data_encoding.json_schema shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Data_encoding.json_schema shell_tzresult Lwt.t
 
 (** Returns all the constants of the protocol *)
-val all:
+val all : 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t
-  'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t
 
 val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/constants_storage.ml

@@ -26,80 +26,105 @@
 let preserved_cycles c =
   let constants = Raw_context.constants c in
   constants.preserved_cycles
+
 let blocks_per_cycle c =
   let constants = Raw_context.constants c in
   constants.blocks_per_cycle
+
 let blocks_per_commitment c =
   let constants = Raw_context.constants c in
   constants.blocks_per_commitment
+
 let blocks_per_roll_snapshot c =
   let constants = Raw_context.constants c in
   constants.blocks_per_roll_snapshot
+
 let blocks_per_voting_period c =
   let constants = Raw_context.constants c in
   constants.blocks_per_voting_period
+
 let time_between_blocks c =
   let constants = Raw_context.constants c in
   constants.time_between_blocks
+
 let endorsers_per_block c =
   let constants = Raw_context.constants c in
   constants.endorsers_per_block
+
 let initial_endorsers c =
   let constants = Raw_context.constants c in
   constants.initial_endorsers
+
 let delay_per_missing_endorsement c =
   let constants = Raw_context.constants c in
   constants.delay_per_missing_endorsement
+
 let hard_gas_limit_per_operation c =
   let constants = Raw_context.constants c in
   constants.hard_gas_limit_per_operation
+
 let hard_gas_limit_per_block c =
   let constants = Raw_context.constants c in
   constants.hard_gas_limit_per_block
+
 let cost_per_byte c =
   let constants = Raw_context.constants c in
   constants.cost_per_byte
+
 let hard_storage_limit_per_operation c =
   let constants = Raw_context.constants c in
   constants.hard_storage_limit_per_operation
+
 let proof_of_work_threshold c =
   let constants = Raw_context.constants c in
   constants.proof_of_work_threshold
+
 let tokens_per_roll c =
   let constants = Raw_context.constants c in
   constants.tokens_per_roll
+
 let michelson_maximum_type_size c =
   let constants = Raw_context.constants c in
   constants.michelson_maximum_type_size
+
 let seed_nonce_revelation_tip c =
   let constants = Raw_context.constants c in
   constants.seed_nonce_revelation_tip
+
 let origination_size c =
   let constants = Raw_context.constants c in
   constants.origination_size
+
 let block_security_deposit c =
   let constants = Raw_context.constants c in
   constants.block_security_deposit
+
 let endorsement_security_deposit c =
   let constants = Raw_context.constants c in
   constants.endorsement_security_deposit
-let block_reward c =
+
+let baking_reward_per_endorsement c =
   let constants = Raw_context.constants c in
-  constants.block_reward
+  constants.baking_reward_per_endorsement
+
 let endorsement_reward c =
   let constants = Raw_context.constants c in
   constants.endorsement_reward
+
 let test_chain_duration c =
   let constants = Raw_context.constants c in
   constants.test_chain_duration
+
 let quorum_min c =
   let constants = Raw_context.constants c in
   constants.quorum_min
+
 let quorum_max c =
   let constants = Raw_context.constants c in
   constants.quorum_max
+
 let min_proposal_quorum c =
   let constants = Raw_context.constants c in
   constants.min_proposal_quorum
-let parametric c =
+
-  Raw_context.constants c
+let parametric c = Raw_context.constants c

vendors/ligo-utils/tezos-protocol-alpha/contract_hash.ml

@@ -26,12 +26,16 @@
 (* 20 *)
 let contract_hash = "\002\090\121" (* KT1(36) *)
 
-include Blake2B.Make(Base58)(struct
+include Blake2B.Make
+          (Base58)
+          (struct
             let name = "Contract_hash"
+
             let title = "A contract ID"
+
             let b58check_prefix = contract_hash
+
             let size = Some 20
           end)
 
-let () =
+let () = Base58.check_encoded_prefix b58check_encoding "KT1" 36
-  Base58.check_encoded_prefix b58check_encoding "KT1" 36

vendors/ligo-utils/tezos-protocol-alpha/contract_repr.ml

@@ -29,14 +29,17 @@ type t =
 
 include Compare.Make (struct
   type nonrec t = t
+
   let compare l1 l2 =
-      match l1, l2 with
+    match (l1, l2) with
-      | Implicit pkh1, Implicit pkh2 ->
+    | (Implicit pkh1, Implicit pkh2) ->
         Signature.Public_key_hash.compare pkh1 pkh2
-      | Originated h1, Originated h2 ->
+    | (Originated h1, Originated h2) ->
         Contract_hash.compare h1 h2
-      | Implicit _, Originated _ -> -1
+    | (Implicit _, Originated _) ->
-      | Originated _, Implicit _ -> 1
+        -1
+    | (Originated _, Implicit _) ->
+        1
 end)
 
 type contract = t
@@ -44,54 +47,69 @@ type contract = t
 type error += Invalid_contract_notation of string (* `Permanent *)
 
 let to_b58check = function
-  | Implicit pbk -> Signature.Public_key_hash.to_b58check pbk
+  | Implicit pbk ->
-  | Originated h -> Contract_hash.to_b58check h
+      Signature.Public_key_hash.to_b58check pbk
+  | Originated h ->
+      Contract_hash.to_b58check h
 
 let of_b58check s =
   match Base58.decode s with
-  | Some (Ed25519.Public_key_hash.Data h) -> ok (Implicit (Signature.Ed25519 h))
+  | Some (Ed25519.Public_key_hash.Data h) ->
-  | Some (Secp256k1.Public_key_hash.Data h) -> ok (Implicit (Signature.Secp256k1 h))
+      ok (Implicit (Signature.Ed25519 h))
-  | Some (P256.Public_key_hash.Data h) -> ok (Implicit (Signature.P256 h))
+  | Some (Secp256k1.Public_key_hash.Data h) ->
-  | Some (Contract_hash.Data h) -> ok (Originated h)
+      ok (Implicit (Signature.Secp256k1 h))
-  | _ -> error (Invalid_contract_notation s)
+  | Some (P256.Public_key_hash.Data h) ->
+      ok (Implicit (Signature.P256 h))
+  | Some (Contract_hash.Data h) ->
+      ok (Originated h)
+  | _ ->
+      error (Invalid_contract_notation s)
 
 let pp ppf = function
-  | Implicit pbk -> Signature.Public_key_hash.pp ppf pbk
+  | Implicit pbk ->
-  | Originated h -> Contract_hash.pp ppf h
+      Signature.Public_key_hash.pp ppf pbk
+  | Originated h ->
+      Contract_hash.pp ppf h
 
 let pp_short ppf = function
-  | Implicit pbk -> Signature.Public_key_hash.pp_short ppf pbk
+  | Implicit pbk ->
-  | Originated h -> Contract_hash.pp_short ppf h
+      Signature.Public_key_hash.pp_short ppf pbk
+  | Originated h ->
+      Contract_hash.pp_short ppf h
 
 let encoding =
   let open Data_encoding in
-  def "contract_id"
+  def
-    ~title:
+    "contract_id"
-      "A contract handle"
+    ~title:"A contract handle"
     ~description:
-      "A contract notation as given to an RPC or inside scripts. \
+      "A contract notation as given to an RPC or inside scripts. Can be a \
-       Can be a base58 implicit contract hash \
+       base58 implicit contract hash or a base58 originated contract hash."
-       or a base58 originated contract hash." @@
+  @@ splitted
-  splitted
        ~binary:
-      (union ~tag_size:`Uint8 [
+         (union
-          case (Tag 0)
+            ~tag_size:`Uint8
+            [ case
+                (Tag 0)
                 ~title:"Implicit"
                 Signature.Public_key_hash.encoding
                 (function Implicit k -> Some k | _ -> None)
                 (fun k -> Implicit k);
-          case (Tag 1) (Fixed.add_padding Contract_hash.encoding 1)
+              case
+                (Tag 1)
+                (Fixed.add_padding Contract_hash.encoding 1)
                 ~title:"Originated"
                 (function Originated k -> Some k | _ -> None)
-            (fun k -> Originated k) ;
+                (fun k -> Originated k) ])
-        ])
        ~json:
          (conv
             to_b58check
             (fun s ->
               match of_b58check s with
-            | Ok s -> s
+              | Ok s ->
-            | Error _ -> Json.cannot_destruct "Invalid contract notation.")
+                  s
+              | Error _ ->
+                  Json.cannot_destruct "Invalid contract notation.")
             string)
 
 let () =
@@ -109,19 +127,14 @@ let () =
 
 let implicit_contract id = Implicit id
 
-let originated_contract_004 id = Originated id
+let is_implicit = function Implicit m -> Some m | Originated _ -> None
 
-let is_implicit = function
+let is_originated = function Implicit _ -> None | Originated h -> Some h
-  | Implicit m -> Some m
-  | Originated _ -> None
 
-let is_originated = function
+type origination_nonce = {
-  | Implicit _ -> None
+  operation_hash : Operation_hash.t;
-  | Originated h -> Some h
+  origination_index : int32;
-
+}
-type origination_nonce =
-  { operation_hash: Operation_hash.t ;
-    origination_index: int32 }
 
 let origination_nonce_encoding =
   let open Data_encoding in
@@ -129,28 +142,27 @@ let origination_nonce_encoding =
     (fun {operation_hash; origination_index} ->
       (operation_hash, origination_index))
     (fun (operation_hash, origination_index) ->
-       { operation_hash ; origination_index }) @@
+      {operation_hash; origination_index})
-  obj2
+  @@ obj2 (req "operation" Operation_hash.encoding) (dft "index" int32 0l)
-    (req "operation" Operation_hash.encoding)
-    (dft "index" int32 0l)
 
 let originated_contract nonce =
   let data =
-    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce in
+    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce
+  in
   Originated (Contract_hash.hash_bytes [data])
 
 let originated_contracts
     ~since:{origination_index = first; operation_hash = first_hash}
-    ~until: ({ origination_index = last ; operation_hash = last_hash } as origination_nonce) =
+    ~until:( {origination_index = last; operation_hash = last_hash} as
+           origination_nonce ) =
   assert (Operation_hash.equal first_hash last_hash) ;
   let rec contracts acc origination_index =
-    if Compare.Int32.(origination_index < first) then
+    if Compare.Int32.(origination_index < first) then acc
-      acc
     else
-      let origination_nonce =
+      let origination_nonce = {origination_nonce with origination_index} in
-        { origination_nonce with origination_index } in
       let acc = originated_contract origination_nonce :: acc in
-      contracts acc (Int32.pred origination_index) in
+      contracts acc (Int32.pred origination_index)
+  in
   contracts [] (Int32.pred last)
 
 let initial_origination_nonce operation_hash =
@@ -164,8 +176,11 @@ let rpc_arg =
   let construct = to_b58check in
   let destruct hash =
     match of_b58check hash with
-    | Error _ -> Error "Cannot parse contract id"
+    | Error _ ->
-    | Ok contract -> Ok contract in
+        Error "Cannot parse contract id"
+    | Ok contract ->
+        Ok contract
+  in
   RPC_arg.make
     ~descr:"A contract identifier encoded in b58check."
     ~name:"contract_id"
@@ -174,41 +189,42 @@ let rpc_arg =
     ()
 
 module Index = struct
-
   type t = contract
 
   let path_length = 7
 
   let to_path c l =
     let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
-    let `Hex key = MBytes.to_hex raw_key in
+    let (`Hex key) = MBytes.to_hex raw_key in
-    let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
+    let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
-    String.sub index_key 0 2 ::
+    String.sub index_key 0 2 :: String.sub index_key 2 2
-    String.sub index_key 2 2 ::
+    :: String.sub index_key 4 2 :: String.sub index_key 6 2
-    String.sub index_key 4 2 ::
+    :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: key :: l
-    String.sub index_key 6 2 ::
-    String.sub index_key 8 2 ::
-    String.sub index_key 10 2 ::
-    key ::
-    l
 
   let of_path = function
-    | [] | [_] | [_;_] | [_;_;_] | [_;_;_;_] | [_;_;_;_;_] | [_;_;_;_;_;_]
+    | []
+    | [_]
+    | [_; _]
+    | [_; _; _]
+    | [_; _; _; _]
+    | [_; _; _; _; _]
+    | [_; _; _; _; _; _]
     | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ ->
         None
     | [index1; index2; index3; index4; index5; index6; key] ->
         let raw_key = MBytes.of_hex (`Hex key) in
-        let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
+        let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
-        assert Compare.String.(String.sub index_key 0 2 = index1) ;
+        assert (Compare.String.(String.sub index_key 0 2 = index1)) ;
-        assert Compare.String.(String.sub index_key 2 2 = index2) ;
+        assert (Compare.String.(String.sub index_key 2 2 = index2)) ;
-        assert Compare.String.(String.sub index_key 4 2 = index3) ;
+        assert (Compare.String.(String.sub index_key 4 2 = index3)) ;
-        assert Compare.String.(String.sub index_key 6 2 = index4) ;
+        assert (Compare.String.(String.sub index_key 6 2 = index4)) ;
-        assert Compare.String.(String.sub index_key 8 2 = index5) ;
+        assert (Compare.String.(String.sub index_key 8 2 = index5)) ;
-        assert Compare.String.(String.sub index_key 10 2 = index6) ;
+        assert (Compare.String.(String.sub index_key 10 2 = index6)) ;
         Data_encoding.Binary.of_bytes encoding raw_key
 
   let rpc_arg = rpc_arg
-  let encoding = encoding
-  let compare = compare
 
+  let encoding = encoding
+
+  let compare = compare
 end

vendors/ligo-utils/tezos-protocol-alpha/contract_repr.mli

@@ -26,6 +26,7 @@
 type t = private
   | Implicit of Signature.Public_key_hash.t
   | Originated of Contract_hash.t
+
 type contract = t
 
 include Compare.S with type t := contract
@@ -34,9 +35,6 @@ include Compare.S with type t := contract
 
 val implicit_contract : Signature.Public_key_hash.t -> contract
 
-(** Only for migration from proto_004  *)
-val originated_contract_004 : Contract_hash.t -> contract
-
 val is_implicit : contract -> Signature.Public_key_hash.t option
 
 (** {2 Originated contracts} *)
@@ -50,7 +48,8 @@ type origination_nonce
 
 val originated_contract : origination_nonce -> contract
 
-val originated_contracts : since: origination_nonce -> until: origination_nonce -> contract list
+val originated_contracts :
+  since:origination_nonce -> until:origination_nonce -> contract list
 
 val initial_origination_nonce : Operation_hash.t -> origination_nonce
 
@@ -58,7 +57,6 @@ val incr_origination_nonce : origination_nonce -> origination_nonce
 
 val is_originated : contract -> Contract_hash.t option
 
-
 (** {2 Human readable notation} *)
 
 type error += Invalid_contract_notation of string (* `Permanent *)

vendors/ligo-utils/tezos-protocol-alpha/contract_services.ml

@@ -26,10 +26,12 @@
 open Alpha_context
 
 let custom_root =
-  (RPC_path.(open_root / "context" / "contracts") : RPC_context.t RPC_path.context)
+  ( RPC_path.(open_root / "context" / "contracts")
+    : RPC_context.t RPC_path.context )
 
 let big_map_root =
-  (RPC_path.(open_root / "context" / "big_maps") : RPC_context.t RPC_path.context)
+  ( RPC_path.(open_root / "context" / "big_maps")
+    : RPC_context.t RPC_path.context )
 
 type info = {
   balance : Tez.t;
@@ -44,15 +46,14 @@ let info_encoding =
     (fun {balance; delegate; script; counter} ->
       (balance, delegate, script, counter))
     (fun (balance, delegate, script, counter) ->
-      {balance ; delegate ; script ; counter}) @@
+      {balance; delegate; script; counter})
-  obj4
+  @@ obj4
        (req "balance" Tez.encoding)
        (opt "delegate" Signature.Public_key_hash.encoding)
        (opt "script" Script.encoding)
        (opt "counter" n)
 
 module S = struct
-
   open Data_encoding
 
   let balance =
@@ -102,27 +103,35 @@ module S = struct
       ~description:"Return the type of the given entrypoint of the contract"
       ~query:RPC_query.empty
       ~output:Script.expr_encoding
-      RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)
+      RPC_path.(
-
+        custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)
 
   let list_entrypoints =
     RPC_service.get_service
       ~description:"Return the list of entrypoints of the contract"
       ~query:RPC_query.empty
-      ~output: (obj2
+      ~output:
-                  (dft "unreachable"
+        (obj2
+           (dft
+              "unreachable"
               (Data_encoding.list
-                        (obj1 (req "path" (Data_encoding.list Michelson_v1_primitives.prim_encoding))))
+                 (obj1
+                    (req
+                       "path"
+                       (Data_encoding.list
+                          Michelson_v1_primitives.prim_encoding))))
               [])
-                  (req "entrypoints"
+           (req "entrypoints" (assoc Script.expr_encoding)))
-                     (assoc Script.expr_encoding)))
       RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints")
 
   let contract_big_map_get_opt =
     RPC_service.post_service
-       ~description: "Access the value associated with a key in a big map of the contract (deprecated)."
+      ~description:
+        "Access the value associated with a key in a big map of the contract \
+         (deprecated)."
       ~query:RPC_query.empty
-       ~input: (obj2
+      ~input:
+        (obj2
            (req "key" Script.expr_encoding)
            (req "type" Script.expr_encoding))
       ~output:(option Script.expr_encoding)
@@ -149,159 +158,217 @@ module S = struct
       ~query:RPC_query.empty
       ~output:(list Contract.encoding)
       custom_root
-
 end
 
 let register () =
   let open Services_registration in
-  register0 S.list begin fun ctxt () () ->
+  register0 S.list (fun ctxt () () -> Contract.list ctxt >>= return) ;
-    Contract.list ctxt >>= return
-  end ;
   let register_field s f =
     register1 s (fun ctxt contract () () ->
-        Contract.exists ctxt contract >>=? function
+        Contract.exists ctxt contract
-        | true -> f ctxt contract
+        >>=? function true -> f ctxt contract | false -> raise Not_found)
-        | false -> raise Not_found) in
+  in
   let register_opt_field s f =
-    register_field s
+    register_field s (fun ctxt a1 ->
-      (fun ctxt a1 ->
+        f ctxt a1 >>=? function None -> raise Not_found | Some v -> return v)
-         f ctxt a1 >>=? function
+  in
-         | None -> raise Not_found
-         | Some v -> return v) in
   let do_big_map_get ctxt id key =
     let open Script_ir_translator in
     let ctxt = Gas.set_unlimited ctxt in
-    Big_map.exists ctxt id >>=? fun (ctxt, types) ->
+    Big_map.exists ctxt id
+    >>=? fun (ctxt, types) ->
     match types with
-    | None -> raise Not_found
+    | None ->
-    | Some (_, value_type) ->
+        raise Not_found
-        Lwt.return (parse_ty ctxt
+    | Some (_, value_type) -> (
-                      ~legacy:true ~allow_big_map:false ~allow_operation:false ~allow_contract:true
+        Lwt.return
+          (parse_ty
+             ctxt
+             ~legacy:true
+             ~allow_big_map:false
+             ~allow_operation:false
+             ~allow_contract:true
              (Micheline.root value_type))
         >>=? fun (Ex_ty value_type, ctxt) ->
-        Big_map.get_opt ctxt id key >>=? fun (_ctxt, value) ->
+        Big_map.get_opt ctxt id key
+        >>=? fun (_ctxt, value) ->
         match value with
-        | None -> raise Not_found
+        | None ->
+            raise Not_found
         | Some value ->
-            parse_data ctxt ~legacy:true value_type (Micheline.root value) >>=? fun (value, ctxt) ->
+            parse_data ctxt ~legacy:true value_type (Micheline.root value)
-            unparse_data ctxt Readable value_type value >>=? fun (value, _ctxt) ->
+            >>=? fun (value, ctxt) ->
-            return (Micheline.strip_locations value) in
+            unparse_data ctxt Readable value_type value
+            >>=? fun (value, _ctxt) -> return (Micheline.strip_locations value)
+        )
+  in
   register_field S.balance Contract.get_balance ;
-  register1 S.manager_key
+  register1 S.manager_key (fun ctxt contract () () ->
-    (fun ctxt contract () () ->
       match Contract.is_implicit contract with
-       | None -> raise Not_found
+      | None ->
-       | Some mgr ->
+          raise Not_found
-           Contract.is_manager_key_revealed ctxt mgr >>=? function
+      | Some mgr -> (
-           | false -> return_none
+          Contract.is_manager_key_revealed ctxt mgr
-           | true -> Contract.get_manager_key ctxt mgr >>=? return_some) ;
+          >>=? function
+          | false ->
+              return_none
+          | true ->
+              Contract.get_manager_key ctxt mgr >>=? return_some )) ;
   register_opt_field S.delegate Delegate.get ;
-  register1 S.counter
+  register1 S.counter (fun ctxt contract () () ->
-    (fun ctxt contract () () ->
       match Contract.is_implicit contract with
-       | None -> raise Not_found
+      | None ->
-       | Some mgr -> Contract.get_counter ctxt mgr) ;
+          raise Not_found
-  register_opt_field S.script
+      | Some mgr ->
-    (fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;
+          Contract.get_counter ctxt mgr) ;
+  register_opt_field S.script (fun c v ->
+      Contract.get_script c v >>=? fun (_, v) -> return v) ;
   register_opt_field S.storage (fun ctxt contract ->
-      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      Contract.get_script ctxt contract
+      >>=? fun (ctxt, script) ->
       match script with
-      | None -> return_none
+      | None ->
+          return_none
       | Some script ->
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
-          parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
+          parse_script ctxt ~legacy:true script
-          unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
+          >>=? fun (Ex_script script, ctxt) ->
-          Script.force_decode ctxt script.storage >>=? fun (storage, _ctxt) ->
+          unparse_script ctxt Readable script
-          return_some storage) ;
+          >>=? fun (script, ctxt) ->
-  register2 S.entrypoint_type
+          Script.force_decode ctxt script.storage
-    (fun ctxt v entrypoint () () -> Contract.get_script_code ctxt v >>=? fun (_, expr) ->
+          >>=? fun (storage, _ctxt) -> return_some storage) ;
+  register2 S.entrypoint_type (fun ctxt v entrypoint () () ->
+      Contract.get_script_code ctxt v
+      >>=? fun (_, expr) ->
       match expr with
-      | None -> raise Not_found
+      | None ->
-      | Some expr ->
+          raise Not_found
+      | Some expr -> (
           let ctxt = Gas.set_unlimited ctxt in
           let legacy = true in
           let open Script_ir_translator in
-          Script.force_decode ctxt expr >>=? fun (expr, _) ->
+          Script.force_decode ctxt expr
+          >>=? fun (expr, _) ->
           Lwt.return
-            begin
+            ( parse_toplevel ~legacy expr
-              parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
+            >>? fun (arg_type, _, _, root_name) ->
-              parse_ty ctxt ~legacy
+            parse_ty
-                ~allow_big_map:true ~allow_operation:false
+              ctxt
-                ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
+              ~legacy
-              Script_ir_translator.find_entrypoint ~root_name arg_type
+              ~allow_big_map:true
-                entrypoint
+              ~allow_operation:false
-            end >>= function
+              ~allow_contract:true
-            Ok (_f , Ex_ty ty)->
+              arg_type
-              unparse_ty ctxt ty >>=? fun (ty_node, _) ->
+            >>? fun (Ex_ty arg_type, _) ->
+            Script_ir_translator.find_entrypoint ~root_name arg_type entrypoint
+            )
+          >>= function
+          | Ok (_f, Ex_ty ty) ->
+              unparse_ty ctxt ty
+              >>=? fun (ty_node, _) ->
               return (Micheline.strip_locations ty_node)
-          | Error _ -> raise Not_found) ;
+          | Error _ ->
-  register1 S.list_entrypoints
+              raise Not_found )) ;
-    (fun ctxt v () () -> Contract.get_script_code ctxt v >>=? fun (_, expr) ->
+  register1 S.list_entrypoints (fun ctxt v () () ->
+      Contract.get_script_code ctxt v
+      >>=? fun (_, expr) ->
       match expr with
-      | None -> raise Not_found
+      | None ->
+          raise Not_found
       | Some expr ->
           let ctxt = Gas.set_unlimited ctxt in
           let legacy = true in
           let open Script_ir_translator in
-          Script.force_decode ctxt expr >>=? fun (expr, _) ->
+          Script.force_decode ctxt expr
+          >>=? fun (expr, _) ->
           Lwt.return
-            begin
+            ( parse_toplevel ~legacy expr
-              parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
+            >>? fun (arg_type, _, _, root_name) ->
-              parse_ty ctxt ~legacy
+            parse_ty
-                ~allow_big_map:true ~allow_operation:false
+              ctxt
-                ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
+              ~legacy
-              Script_ir_translator.list_entrypoints ~root_name arg_type ctxt
+              ~allow_big_map:true
-            end >>=? fun (unreachable_entrypoint,map) ->
+              ~allow_operation:false
+              ~allow_contract:true
+              arg_type
+            >>? fun (Ex_ty arg_type, _) ->
+            Script_ir_translator.list_entrypoints ~root_name arg_type ctxt )
+          >>=? fun (unreachable_entrypoint, map) ->
           return
             ( unreachable_entrypoint,
               Entrypoints_map.fold
-               begin fun entry (_,ty) acc ->
+                (fun entry (_, ty) acc ->
-                 (entry , Micheline.strip_locations ty) ::acc end
+                  (entry, Micheline.strip_locations ty) :: acc)
-               map [])
+                map
-    ) ;
+                [] )) ;
   register1 S.contract_big_map_get_opt (fun ctxt contract () (key, key_type) ->
-      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      Contract.get_script ctxt contract
-      Lwt.return (Script_ir_translator.parse_packable_ty ctxt ~legacy:true (Micheline.root key_type)) >>=? fun (Ex_ty key_type, ctxt) ->
+      >>=? fun (ctxt, script) ->
-      Script_ir_translator.parse_data ctxt ~legacy:true key_type (Micheline.root key) >>=? fun (key, ctxt) ->
+      Lwt.return
-      Script_ir_translator.hash_data ctxt key_type key >>=? fun (key, ctxt) ->
+        (Script_ir_translator.parse_packable_ty
+           ctxt
+           ~legacy:true
+           (Micheline.root key_type))
+      >>=? fun (Ex_ty key_type, ctxt) ->
+      Script_ir_translator.parse_data
+        ctxt
+        ~legacy:true
+        key_type
+        (Micheline.root key)
+      >>=? fun (key, ctxt) ->
+      Script_ir_translator.hash_data ctxt key_type key
+      >>=? fun (key, ctxt) ->
       match script with
-      | None -> raise Not_found
+      | None ->
+          raise Not_found
       | Some script ->
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
-          parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
+          parse_script ctxt ~legacy:true script
-          Script_ir_translator.collect_big_maps ctxt script.storage_type script.storage >>=? fun (ids, _ctxt) ->
+          >>=? fun (Ex_script script, ctxt) ->
+          Script_ir_translator.collect_big_maps
+            ctxt
+            script.storage_type
+            script.storage
+          >>=? fun (ids, _ctxt) ->
           let ids = Script_ir_translator.list_of_big_map_ids ids in
           let rec find = function
-            | [] -> return_none
+            | [] ->
-            | (id : Z.t) :: ids -> try do_big_map_get ctxt id key >>=? return_some with Not_found -> find ids in
+                return_none
+            | (id : Z.t) :: ids -> (
+              try do_big_map_get ctxt id key >>=? return_some
+              with Not_found -> find ids )
+          in
           find ids) ;
-  register2 S.big_map_get (fun ctxt id key () () ->
+  register2 S.big_map_get (fun ctxt id key () () -> do_big_map_get ctxt id key) ;
-      do_big_map_get ctxt id key) ;
   register_field S.info (fun ctxt contract ->
-      Contract.get_balance ctxt contract >>=? fun balance ->
+      Contract.get_balance ctxt contract
-      Delegate.get ctxt contract >>=? fun delegate ->
+      >>=? fun balance ->
-      begin match Contract.is_implicit contract with
+      Delegate.get ctxt contract
+      >>=? fun delegate ->
+      ( match Contract.is_implicit contract with
       | Some manager ->
-            Contract.get_counter ctxt manager >>=? fun counter ->
+          Contract.get_counter ctxt manager
-            return_some counter
+          >>=? fun counter -> return_some counter
-        | None -> return None
+      | None ->
-      end >>=? fun counter ->
+          return None )
-      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      >>=? fun counter ->
-      begin match script with
+      Contract.get_script ctxt contract
-        | None -> return (None, ctxt)
+      >>=? fun (ctxt, script) ->
+      ( match script with
+      | None ->
+          return (None, ctxt)
       | Some script ->
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
-            parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
+          parse_script ctxt ~legacy:true script
-            unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
+          >>=? fun (Ex_script script, ctxt) ->
-            return (Some script, ctxt)
+          unparse_script ctxt Readable script
-      end >>=? fun (script, _ctxt) ->
+          >>=? fun (script, ctxt) -> return (Some script, ctxt) )
-      return { balance ; delegate ; script ; counter })
+      >>=? fun (script, _ctxt) -> return {balance; delegate; script; counter})
 
-let list ctxt block =
+let list ctxt block = RPC_context.make_call0 S.list ctxt block () ()
-  RPC_context.make_call0 S.list ctxt block () ()
 
 let info ctxt block contract =
   RPC_context.make_call1 S.info ctxt block contract () ()
@@ -310,7 +377,13 @@ let balance ctxt block contract =
   RPC_context.make_call1 S.balance ctxt block contract () ()
 
 let manager_key ctxt block mgr =
-  RPC_context.make_call1 S.manager_key ctxt block (Contract.implicit_contract mgr) () ()
+  RPC_context.make_call1
+    S.manager_key
+    ctxt
+    block
+    (Contract.implicit_contract mgr)
+    ()
+    ()
 
 let delegate ctxt block contract =
   RPC_context.make_call1 S.delegate ctxt block contract () ()
@@ -319,7 +392,13 @@ let delegate_opt ctxt block contract =
   RPC_context.make_opt_call1 S.delegate ctxt block contract () ()
 
 let counter ctxt block mgr =
-  RPC_context.make_call1 S.counter ctxt block (Contract.implicit_contract mgr) () ()
+  RPC_context.make_call1
+    S.counter
+    ctxt
+    block
+    (Contract.implicit_contract mgr)
+    ()
+    ()
 
 let script ctxt block contract =
   RPC_context.make_call1 S.script ctxt block contract () ()

vendors/ligo-utils/tezos-protocol-alpha/contract_services.mli

@@ -25,8 +25,7 @@
 
 open Alpha_context
 
-val list:
+val list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
-  'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
 
 type info = {
   balance : Tez.t;
@@ -44,42 +43,77 @@ val balance:
   'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t
 
 val manager_key :
-  'a #RPC_context.simple -> 'a -> public_key_hash -> public_key option shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  public_key_hash ->
+  public_key option shell_tzresult Lwt.t
 
 val delegate :
-  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  public_key_hash shell_tzresult Lwt.t
 
 val delegate_opt :
-  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash option shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  public_key_hash option shell_tzresult Lwt.t
 
 val counter :
-  'a #RPC_context.simple -> 'a -> public_key_hash -> counter shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  public_key_hash ->
+  counter shell_tzresult Lwt.t
 
 val script :
   'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t
 
 val script_opt :
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t option shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  Script.t option shell_tzresult Lwt.t
 
 val storage :
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  Script.expr shell_tzresult Lwt.t
 
 val entrypoint_type :
-  'a #RPC_context.simple -> 'a -> Contract.t -> string -> Script.expr shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  string ->
+  Script.expr shell_tzresult Lwt.t
 
 val list_entrypoints :
-  'a #RPC_context.simple -> 'a -> Contract.t ->
+  'a #RPC_context.simple ->
-  (Michelson_v1_primitives.prim list list *
+  'a ->
-   (string * Script.expr) list) shell_tzresult Lwt.t
+  Contract.t ->
+  (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
+  shell_tzresult
+  Lwt.t
 
 val storage_opt :
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr option shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  Script.expr option shell_tzresult Lwt.t
 
 val big_map_get :
-  'a #RPC_context.simple -> 'a -> Z.t -> Script_expr_hash.t ->
+  'a #RPC_context.simple ->
+  'a ->
+  Z.t ->
+  Script_expr_hash.t ->
   Script.expr shell_tzresult Lwt.t
 
 val contract_big_map_get_opt :
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr * Script.expr -> Script.expr option shell_tzresult Lwt.t
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  Script.expr * Script.expr ->
+  Script.expr option shell_tzresult Lwt.t
 
 val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/contract_storage.ml

@@ -24,28 +24,49 @@
 (*****************************************************************************)
 
 type error +=
-  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
+  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
-  | Counter_in_the_past of Contract_repr.contract * Z.t * Z.t (* `Branch *)
+  | (* `Temporary *)
-  | Counter_in_the_future of Contract_repr.contract * Z.t * Z.t (* `Temporary *)
+      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
-  | Unspendable_contract of Contract_repr.contract (* `Permanent *)
+  | (* `Branch *)
-  | Non_existing_contract of Contract_repr.contract (* `Temporary *)
+      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
-  | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *)
+  | (* `Temporary *)
-  | Empty_transaction of Contract_repr.t (* `Temporary *)
+      Unspendable_contract of Contract_repr.contract
-  | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+  | (* `Permanent *)
-  | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *)
+      Non_existing_contract of Contract_repr.contract
-  | Failure of string (* `Permanent *)
+  | (* `Temporary *)
+      Empty_implicit_contract of Signature.Public_key_hash.t
+  | (* `Temporary *)
+      Empty_implicit_delegated_contract of
+      Signature.Public_key_hash.t
+  | (* `Temporary *)
+      Empty_transaction of Contract_repr.t (* `Temporary *)
+  | Inconsistent_hash of
+      Signature.Public_key.t
+      * Signature.Public_key_hash.t
+      * Signature.Public_key_hash.t
+  | (* `Permanent *)
+      Inconsistent_public_key of
+      Signature.Public_key.t * Signature.Public_key.t
+  | (* `Permanent *)
+      Failure of string (* `Permanent *)
   | Previously_revealed_key of Contract_repr.t (* `Permanent *)
-  | Unrevealed_manager_key of Contract_repr.t (* `Permanent *)
+  | Unrevealed_manager_key of Contract_repr.t
+
+(* `Permanent *)
 
 let () =
   register_error_kind
     `Permanent
     ~id:"contract.unspendable_contract"
     ~title:"Unspendable contract"
-    ~description:"An operation tried to spend tokens from an unspendable contract"
+    ~description:
+      "An operation tried to spend tokens from an unspendable contract"
     ~pp:(fun ppf c ->
-        Format.fprintf ppf "The tokens of contract %a can only be spent by its script"
+      Format.fprintf
-          Contract_repr.pp c)
+        ppf
+        "The tokens of contract %a can only be spent by its script"
+        Contract_repr.pp
+        c)
     Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
     (function Unspendable_contract c -> Some c | _ -> None)
     (fun c -> Unspendable_contract c) ;
@@ -53,11 +74,20 @@ let () =
     `Temporary
     ~id:"contract.balance_too_low"
     ~title:"Balance too low"
-    ~description:"An operation tried to spend more tokens than the contract has"
+    ~description:
+      "An operation tried to spend more tokens than the contract has"
     ~pp:(fun ppf (c, b, a) ->
-        Format.fprintf ppf "Balance of contract %a too low (%a) to spend %a"
+      Format.fprintf
-          Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a)
+        ppf
-    Data_encoding.(obj3
+        "Balance of contract %a too low (%a) to spend %a"
+        Contract_repr.pp
+        c
+        Tez_repr.pp
+        b
+        Tez_repr.pp
+        a)
+    Data_encoding.(
+      obj3
         (req "contract" Contract_repr.encoding)
         (req "balance" Tez_repr.encoding)
         (req "amount" Tez_repr.encoding))
@@ -69,13 +99,15 @@ let () =
     ~title:"Invalid counter (not yet reached) in a manager operation"
     ~description:"An operation assumed a contract counter in the future"
     ~pp:(fun ppf (contract, exp, found) ->
-        Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Counter %s not yet reached for contract %a (expected %s)"
         (Z.to_string found)
-          Contract_repr.pp contract
+        Contract_repr.pp
+        contract
         (Z.to_string exp))
-    Data_encoding.
+    Data_encoding.(
-      (obj3
+      obj3
         (req "contract" Contract_repr.encoding)
         (req "expected" z)
         (req "found" z))
@@ -87,13 +119,15 @@ let () =
     ~title:"Invalid counter (already used) in a manager operation"
     ~description:"An operation assumed a contract counter in the past"
     ~pp:(fun ppf (contract, exp, found) ->
-        Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Counter %s already used for contract %a (expected %s)"
         (Z.to_string found)
-          Contract_repr.pp contract
+        Contract_repr.pp
+        contract
         (Z.to_string exp))
-    Data_encoding.
+    Data_encoding.(
-      (obj3
+      obj3
         (req "contract" Contract_repr.encoding)
         (req "expected" z)
         (req "found" z))
@@ -103,11 +137,11 @@ let () =
     `Temporary
     ~id:"contract.non_existing_contract"
     ~title:"Non existing contract"
-    ~description:"A contract handle is not present in the context \
+    ~description:
-                  (either it never was or it has been destroyed)"
+      "A contract handle is not present in the context (either it never was \
+       or it has been destroyed)"
     ~pp:(fun ppf contract ->
-        Format.fprintf ppf "Contract %a does not exist"
+      Format.fprintf ppf "Contract %a does not exist" Contract_repr.pp contract)
-          Contract_repr.pp contract)
     Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
     (function Non_existing_contract c -> Some c | _ -> None)
     (fun c -> Non_existing_contract c) ;
@@ -115,13 +149,19 @@ let () =
     `Permanent
     ~id:"contract.manager.inconsistent_hash"
     ~title:"Inconsistent public key hash"
-    ~description:"A revealed manager public key is inconsistent with the announced hash"
+    ~description:
+      "A revealed manager public key is inconsistent with the announced hash"
     ~pp:(fun ppf (k, eh, ph) ->
-        Format.fprintf ppf "The hash of the manager public key %s is not %a as announced but %a"
+      Format.fprintf
+        ppf
+        "The hash of the manager public key %s is not %a as announced but %a"
         (Signature.Public_key.to_b58check k)
-          Signature.Public_key_hash.pp ph
+        Signature.Public_key_hash.pp
-          Signature.Public_key_hash.pp eh)
+        ph
-    Data_encoding.(obj3
+        Signature.Public_key_hash.pp
+        eh)
+    Data_encoding.(
+      obj3
         (req "public_key" Signature.Public_key.encoding)
         (req "expected_hash" Signature.Public_key_hash.encoding)
         (req "provided_hash" Signature.Public_key_hash.encoding))
@@ -131,12 +171,17 @@ let () =
     `Permanent
     ~id:"contract.manager.inconsistent_public_key"
     ~title:"Inconsistent public key"
-    ~description:"A provided manager public key is different with the public key stored in the contract"
+    ~description:
+      "A provided manager public key is different with the public key stored \
+       in the contract"
     ~pp:(fun ppf (eh, ph) ->
-        Format.fprintf ppf "Expected manager public key %s but %s was provided"
+      Format.fprintf
+        ppf
+        "Expected manager public key %s but %s was provided"
         (Signature.Public_key.to_b58check ph)
         (Signature.Public_key.to_b58check eh))
-    Data_encoding.(obj2
+    Data_encoding.(
+      obj2
         (req "public_key" Signature.Public_key.encoding)
         (req "expected_public_key" Signature.Public_key.encoding))
     (function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None)
@@ -155,11 +200,14 @@ let () =
     ~id:"contract.unrevealed_key"
     ~title:"Manager operation precedes key revelation"
     ~description:
-      "One tried to apply a manager operation \
+      "One tried to apply a manager operation without revealing the manager \
-       without revealing the manager public key"
+       public key"
     ~pp:(fun ppf s ->
-        Format.fprintf ppf "Unrevealed manager key for contract %a."
+      Format.fprintf
-          Contract_repr.pp s)
+        ppf
+        "Unrevealed manager key for contract %a."
+        Contract_repr.pp
+        s)
     Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
     (function Unrevealed_manager_key s -> Some s | _ -> None)
     (fun s -> Unrevealed_manager_key s) ;
@@ -167,11 +215,13 @@ let () =
     `Branch
     ~id:"contract.previously_revealed_key"
     ~title:"Manager operation already revealed"
-    ~description:
+    ~description:"One tried to revealed twice a manager public key"
-      "One tried to revealed twice a manager public key"
     ~pp:(fun ppf s ->
-        Format.fprintf ppf "Previously revealed manager key for contract %a."
+      Format.fprintf
-          Contract_repr.pp s)
+        ppf
+        "Previously revealed manager key for contract %a."
+        Contract_repr.pp
+        s)
     Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
     (function Previously_revealed_key s -> Some s | _ -> None)
     (fun s -> Previously_revealed_key s) ;
@@ -179,23 +229,43 @@ let () =
     `Branch
     ~id:"implicit.empty_implicit_contract"
     ~title:"Empty implicit contract"
-    ~description:"No manager operations are allowed on an empty implicit contract."
+    ~description:
+      "No manager operations are allowed on an empty implicit contract."
     ~pp:(fun ppf implicit ->
-        Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Empty implicit contract (%a)"
-          Signature.Public_key_hash.pp implicit)
+        Signature.Public_key_hash.pp
+        implicit)
     Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
     (function Empty_implicit_contract c -> Some c | _ -> None)
     (fun c -> Empty_implicit_contract c) ;
+  register_error_kind
+    `Branch
+    ~id:"implicit.empty_implicit_delegated_contract"
+    ~title:"Empty implicit delegated contract"
+    ~description:"Emptying an implicit delegated account is not allowed."
+    ~pp:(fun ppf implicit ->
+      Format.fprintf
+        ppf
+        "Emptying implicit delegated contract (%a)"
+        Signature.Public_key_hash.pp
+        implicit)
+    Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
+    (function Empty_implicit_delegated_contract c -> Some c | _ -> None)
+    (fun c -> Empty_implicit_delegated_contract c) ;
   register_error_kind
     `Branch
     ~id:"contract.empty_transaction"
     ~title:"Empty transaction"
     ~description:"Forbidden to credit 0ꜩ to a contract without code."
     ~pp:(fun ppf contract ->
-        Format.fprintf ppf
+      Format.fprintf
-          "Transaction of 0ꜩ towards a contract without code are forbidden (%a)."
+        ppf
-          Contract_repr.pp contract)
+        "Transaction of 0ꜩ towards a contract without code are forbidden \
+         (%a)."
+        Contract_repr.pp
+        contract)
     Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
     (function Empty_transaction c -> Some c | _ -> None)
     (fun c -> Empty_transaction c)
@@ -222,7 +292,9 @@ type big_map_diff = big_map_diff_item list
 let big_map_diff_item_encoding =
   let open Data_encoding in
   union
-    [ case (Tag 0) ~title:"update"
+    [ case
+        (Tag 0)
+        ~title:"update"
         (obj5
            (req "action" (constant "update"))
            (req "big_map" z)
@@ -232,31 +304,28 @@ let big_map_diff_item_encoding =
         (function
           | Update {big_map; diff_key_hash; diff_key; diff_value} ->
               Some ((), big_map, diff_key_hash, diff_key, diff_value)
-          | _ -> None )
+          | _ ->
+              None)
         (fun ((), big_map, diff_key_hash, diff_key, diff_value) ->
           Update {big_map; diff_key_hash; diff_key; diff_value});
-      case (Tag 1) ~title:"remove"
+      case
-        (obj2
+        (Tag 1)
-           (req "action" (constant "remove"))
+        ~title:"remove"
-           (req "big_map" z))
+        (obj2 (req "action" (constant "remove")) (req "big_map" z))
-        (function
+        (function Clear big_map -> Some ((), big_map) | _ -> None)
-          | Clear big_map ->
+        (fun ((), big_map) -> Clear big_map);
-              Some ((), big_map)
+      case
-          | _ -> None )
+        (Tag 2)
-        (fun ((), big_map) ->
+        ~title:"copy"
-           Clear big_map) ;
-      case (Tag 2) ~title:"copy"
         (obj3
            (req "action" (constant "copy"))
            (req "source_big_map" z)
            (req "destination_big_map" z))
-        (function
+        (function Copy (src, dst) -> Some ((), src, dst) | _ -> None)
-          | Copy (src, dst) ->
+        (fun ((), src, dst) -> Copy (src, dst));
-              Some ((), src, dst)
+      case
-          | _ -> None )
+        (Tag 3)
-        (fun ((), src, dst) ->
+        ~title:"alloc"
-           Copy (src, dst)) ;
-      case (Tag 3) ~title:"alloc"
         (obj4
            (req "action" (constant "alloc"))
            (req "big_map" z)
@@ -265,122 +334,164 @@ let big_map_diff_item_encoding =
         (function
           | Alloc {big_map; key_type; value_type} ->
               Some ((), big_map, key_type, value_type)
-          | _ -> None )
+          | _ ->
+              None)
         (fun ((), big_map, key_type, value_type) ->
           Alloc {big_map; key_type; value_type}) ]
 
 let big_map_diff_encoding =
   let open Data_encoding in
-  def "contract.big_map_diff" @@
+  def "contract.big_map_diff" @@ list big_map_diff_item_encoding
-  list big_map_diff_item_encoding
 
 let big_map_key_cost = 65
+
 let big_map_cost = 33
 
 let update_script_big_map c = function
-  | None -> return (c, Z.zero)
+  | None ->
+      return (c, Z.zero)
   | Some diff ->
-      fold_left_s (fun (c, total) -> function
+      fold_left_s
-          | Clear id ->
+        (fun (c, total) -> function Clear id ->
-              Storage.Big_map.Total_bytes.get c id >>=? fun size ->
+              Storage.Big_map.Total_bytes.get c id
-              Storage.Big_map.remove_rec c id >>= fun c ->
+              >>=? fun size ->
-              if Compare.Z.(id < Z.zero) then
+              Storage.Big_map.remove_rec c id
-                return (c, total)
+              >>= fun c ->
-              else
+              if Compare.Z.(id < Z.zero) then return (c, total)
-                return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost))
+              else return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost))
           | Copy (from, to_) ->
-              Storage.Big_map.copy c ~from ~to_ >>=? fun c ->
+              Storage.Big_map.copy c ~from ~to_
-              if Compare.Z.(to_ < Z.zero) then
+              >>=? fun c ->
-                return (c, total)
+              if Compare.Z.(to_ < Z.zero) then return (c, total)
               else
-                Storage.Big_map.Total_bytes.get c from >>=? fun size ->
+                Storage.Big_map.Total_bytes.get c from
+                >>=? fun size ->
                 return (c, Z.add (Z.add total size) (Z.of_int big_map_cost))
           | Alloc {big_map; key_type; value_type} ->
-              Storage.Big_map.Total_bytes.init c big_map Z.zero >>=? fun c ->
+              Storage.Big_map.Total_bytes.init c big_map Z.zero
+              >>=? fun c ->
               (* Annotations are erased to allow sharing on
                  [Copy]. The types from the contract code are used,
                  these ones are only used to make sure they are
                  compatible during transmissions between contracts,
                  and only need to be compatible, annotations
                  nonwhistanding. *)
-              let key_type = Micheline.strip_locations (Script_repr.strip_annotations (Micheline.root key_type)) in
+              let key_type =
-              let value_type = Micheline.strip_locations (Script_repr.strip_annotations (Micheline.root value_type)) in
+                Micheline.strip_locations
-              Storage.Big_map.Key_type.init c big_map key_type >>=? fun c ->
+                  (Script_repr.strip_annotations (Micheline.root key_type))
-              Storage.Big_map.Value_type.init c big_map value_type >>=? fun c ->
+              in
-              if Compare.Z.(big_map < Z.zero) then
+              let value_type =
-                return (c, total)
+                Micheline.strip_locations
-              else
+                  (Script_repr.strip_annotations (Micheline.root value_type))
-                return (c, Z.add total (Z.of_int big_map_cost))
+              in
+              Storage.Big_map.Key_type.init c big_map key_type
+              >>=? fun c ->
+              Storage.Big_map.Value_type.init c big_map value_type
+              >>=? fun c ->
+              if Compare.Z.(big_map < Z.zero) then return (c, total)
+              else return (c, Z.add total (Z.of_int big_map_cost))
           | Update {big_map; diff_key_hash; diff_value = None} ->
               Storage.Big_map.Contents.remove (c, big_map) diff_key_hash
               >>=? fun (c, freed, existed) ->
-              let freed = if existed then freed + big_map_key_cost else freed in
+              let freed =
-              Storage.Big_map.Total_bytes.get c big_map >>=? fun size ->
+                if existed then freed + big_map_key_cost else freed
-              Storage.Big_map.Total_bytes.set c big_map (Z.sub size (Z.of_int freed)) >>=? fun c ->
+              in
-              if Compare.Z.(big_map < Z.zero) then
+              Storage.Big_map.Total_bytes.get c big_map
-                return (c, total)
+              >>=? fun size ->
-              else
+              Storage.Big_map.Total_bytes.set
-                return (c, Z.sub total (Z.of_int freed))
+                c
+                big_map
+                (Z.sub size (Z.of_int freed))
+              >>=? fun c ->
+              if Compare.Z.(big_map < Z.zero) then return (c, total)
+              else return (c, Z.sub total (Z.of_int freed))
           | Update {big_map; diff_key_hash; diff_value = Some v} ->
               Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v
               >>=? fun (c, size_diff, existed) ->
-              let size_diff = if existed then size_diff else size_diff + big_map_key_cost in
+              let size_diff =
-              Storage.Big_map.Total_bytes.get c big_map >>=? fun size ->
+                if existed then size_diff else size_diff + big_map_key_cost
-              Storage.Big_map.Total_bytes.set c big_map (Z.add size (Z.of_int size_diff)) >>=? fun c ->
+              in
-              if Compare.Z.(big_map < Z.zero) then
+              Storage.Big_map.Total_bytes.get c big_map
-                return (c, total)
+              >>=? fun size ->
-              else
+              Storage.Big_map.Total_bytes.set
-                return (c, Z.add total (Z.of_int size_diff)))
+                c
-        (c, Z.zero) diff
+                big_map
+                (Z.add size (Z.of_int size_diff))
+              >>=? fun c ->
+              if Compare.Z.(big_map < Z.zero) then return (c, total)
+              else return (c, Z.add total (Z.of_int size_diff)))
+        (c, Z.zero)
+        diff
 
-let create_base c
+let create_base c ?(prepaid_bootstrap_storage = false)
-    ?(prepaid_bootstrap_storage=false) (* Free space for bootstrap contracts *)
+    (* Free space for bootstrap contracts *)
-    contract
+    contract ~balance ~manager ~delegate ?script () =
-    ~balance ~manager ~delegate ?script () =
+  ( match Contract_repr.is_implicit contract with
-  begin match Contract_repr.is_implicit contract with
+  | None ->
-    | None -> return c
+      return c
   | Some _ ->
-        Storage.Contract.Global_counter.get c >>=? fun counter ->
+      Storage.Contract.Global_counter.get c
-        Storage.Contract.Counter.init c contract counter
+      >>=? fun counter -> Storage.Contract.Counter.init c contract counter )
-  end >>=? fun c ->
+  >>=? fun c ->
-  Storage.Contract.Balance.init c contract balance >>=? fun c ->
+  Storage.Contract.Balance.init c contract balance
-  begin match manager with
+  >>=? fun c ->
+  ( match manager with
   | Some manager ->
       Storage.Contract.Manager.init c contract (Manager_repr.Hash manager)
-    | None -> return c
+  | None ->
-  end >>=? fun c ->
+      return c )
-  begin
+  >>=? fun c ->
-    match delegate with
+  ( match delegate with
-    | None -> return c
+  | None ->
+      return c
   | Some delegate ->
-        Delegate_storage.init c contract delegate
+      Delegate_storage.init c contract delegate )
-  end >>=? fun c ->
+  >>=? fun c ->
   match script with
   | Some ({Script_repr.code; storage}, big_map_diff) ->
-      Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->
+      Storage.Contract.Code.init c contract code
-      Storage.Contract.Storage.init c contract storage >>=? fun (c, storage_size) ->
+      >>=? fun (c, code_size) ->
-      update_script_big_map c big_map_diff >>=? fun (c, big_map_size) ->
+      Storage.Contract.Storage.init c contract storage
-      let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in
+      >>=? fun (c, storage_size) ->
-      assert Compare.Z.(total_size >= Z.zero) ;
+      update_script_big_map c big_map_diff
-      let prepaid_bootstrap_storage =
+      >>=? fun (c, big_map_size) ->
-        if prepaid_bootstrap_storage then
+      let total_size =
-          total_size
+        Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size
-        else
-          Z.zero
       in
-      Storage.Contract.Paid_storage_space.init c contract prepaid_bootstrap_storage >>=? fun c ->
+      assert (Compare.Z.(total_size >= Z.zero)) ;
+      let prepaid_bootstrap_storage =
+        if prepaid_bootstrap_storage then total_size else Z.zero
+      in
+      Storage.Contract.Paid_storage_space.init
+        c
+        contract
+        prepaid_bootstrap_storage
+      >>=? fun c ->
       Storage.Contract.Used_storage_space.init c contract total_size
   | None ->
       return c
 
-let originate c ?prepaid_bootstrap_storage contract
+let originate c ?prepaid_bootstrap_storage contract ~balance ~script ~delegate
-    ~balance ~script ~delegate =
+    =
-  create_base c ?prepaid_bootstrap_storage contract ~balance
+  create_base
-    ~manager:None ~delegate ~script ()
+    c
+    ?prepaid_bootstrap_storage
+    contract
+    ~balance
+    ~manager:None
+    ~delegate
+    ~script
+    ()
 
 let create_implicit c manager ~balance =
-  create_base c (Contract_repr.implicit_contract manager)
+  create_base
-    ~balance ~manager:(Some manager) ?script:None ~delegate:None ()
+    c
+    (Contract_repr.implicit_contract manager)
+    ~balance
+    ~manager:(Some manager)
+    ?script:None
+    ~delegate:None
+    ()
 
 let delete c contract =
   match Contract_repr.is_implicit contract with
@@ -388,215 +499,255 @@ let delete c contract =
       (* For non implicit contract Big_map should be cleared *)
       failwith "Non implicit contracts cannot be removed"
   | Some _ ->
-      Delegate_storage.remove c contract >>=? fun c ->
+      Delegate_storage.remove c contract
-      Storage.Contract.Balance.delete c contract >>=? fun c ->
+      >>=? fun c ->
-      Storage.Contract.Manager.delete c contract >>=? fun c ->
+      Storage.Contract.Balance.delete c contract
-      Storage.Contract.Counter.delete c contract >>=? fun c ->
+      >>=? fun c ->
-      Storage.Contract.Code.remove c contract >>=? fun (c, _, _) ->
+      Storage.Contract.Manager.delete c contract
-      Storage.Contract.Storage.remove c contract >>=? fun (c, _, _) ->
+      >>=? fun c ->
-      Storage.Contract.Paid_storage_space.remove c contract >>= fun c ->
+      Storage.Contract.Counter.delete c contract
-      Storage.Contract.Used_storage_space.remove c contract >>= fun c ->
+      >>=? fun c ->
-      return c
+      Storage.Contract.Code.remove c contract
+      >>=? fun (c, _, _) ->
+      Storage.Contract.Storage.remove c contract
+      >>=? fun (c, _, _) ->
+      Storage.Contract.Paid_storage_space.remove c contract
+      >>= fun c ->
+      Storage.Contract.Used_storage_space.remove c contract
+      >>= fun c -> return c
 
 let allocated c contract =
-  Storage.Contract.Balance.get_option c contract >>=? function
+  Storage.Contract.Balance.get_option c contract
-  | None -> return_false
+  >>=? function None -> return_false | Some _ -> return_true
-  | Some _ -> return_true
 
 let exists c contract =
   match Contract_repr.is_implicit contract with
-  | Some _ -> return_true
+  | Some _ ->
-  | None -> allocated c contract
+      return_true
+  | None ->
+      allocated c contract
 
 let must_exist c contract =
-  exists c contract >>=? function
+  exists c contract
-  | true -> return_unit
+  >>=? function
-  | false -> fail (Non_existing_contract contract)
+  | true -> return_unit | false -> fail (Non_existing_contract contract)
 
 let must_be_allocated c contract =
-  allocated c contract >>=? function
+  allocated c contract
-  | true -> return_unit
+  >>=? function
-  | false ->
+  | true ->
+      return_unit
+  | false -> (
     match Contract_repr.is_implicit contract with
-      | Some pkh -> fail (Empty_implicit_contract pkh)
+    | Some pkh ->
-      | None -> fail (Non_existing_contract contract)
+        fail (Empty_implicit_contract pkh)
+    | None ->
+        fail (Non_existing_contract contract) )
 
 let list c = Storage.Contract.list c
 
 let fresh_contract_from_current_nonce c =
-  Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->
+  Lwt.return (Raw_context.increment_origination_nonce c)
-  return (c, Contract_repr.originated_contract nonce)
+  >>=? fun (c, nonce) -> return (c, Contract_repr.originated_contract nonce)
 
 let originated_from_current_nonce ~since:ctxt_since ~until:ctxt_until =
-  Lwt.return (Raw_context.origination_nonce ctxt_since) >>=? fun since ->
+  Lwt.return (Raw_context.origination_nonce ctxt_since)
-  Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until ->
+  >>=? fun since ->
+  Lwt.return (Raw_context.origination_nonce ctxt_until)
+  >>=? fun until ->
   filter_map_s
-    (fun contract -> exists ctxt_until contract >>=? function
+    (fun contract ->
-       | true -> return_some contract
+      exists ctxt_until contract
-       | false -> return_none)
+      >>=? function true -> return_some contract | false -> return_none)
     (Contract_repr.originated_contracts ~since ~until)
 
 let check_counter_increment c manager counter =
   let contract = Contract_repr.implicit_contract manager in
-  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
+  Storage.Contract.Counter.get c contract
+  >>=? fun contract_counter ->
   let expected = Z.succ contract_counter in
-  if Compare.Z.(expected = counter)
+  if Compare.Z.(expected = counter) then return_unit
-  then return_unit
   else if Compare.Z.(expected > counter) then
     fail (Counter_in_the_past (contract, expected, counter))
-  else
+  else fail (Counter_in_the_future (contract, expected, counter))
-    fail (Counter_in_the_future (contract, expected, counter))
 
 let increment_counter c manager =
   let contract = Contract_repr.implicit_contract manager in
-  Storage.Contract.Global_counter.get c >>=? fun global_counter ->
+  Storage.Contract.Global_counter.get c
-  Storage.Contract.Global_counter.set c (Z.succ global_counter) >>=? fun c ->
+  >>=? fun global_counter ->
-  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
+  Storage.Contract.Global_counter.set c (Z.succ global_counter)
+  >>=? fun c ->
+  Storage.Contract.Counter.get c contract
+  >>=? fun contract_counter ->
   Storage.Contract.Counter.set c contract (Z.succ contract_counter)
 
-let get_script_code c contract =
+let get_script_code c contract = Storage.Contract.Code.get_option c contract
-  Storage.Contract.Code.get_option c contract
 
 let get_script c contract =
-  Storage.Contract.Code.get_option c contract >>=? fun (c, code) ->
+  Storage.Contract.Code.get_option c contract
-  Storage.Contract.Storage.get_option c contract >>=? fun (c, storage) ->
+  >>=? fun (c, code) ->
-  match code, storage with
+  Storage.Contract.Storage.get_option c contract
-  | None, None -> return (c, None)
+  >>=? fun (c, storage) ->
-  | Some code, Some storage -> return (c, Some { Script_repr.code ; storage })
+  match (code, storage) with
-  | None, Some _ | Some _, None -> failwith "get_script"
+  | (None, None) ->
+      return (c, None)
+  | (Some code, Some storage) ->
+      return (c, Some {Script_repr.code; storage})
+  | (None, Some _) | (Some _, None) ->
+      failwith "get_script"
 
 let get_storage ctxt contract =
-  Storage.Contract.Storage.get_option ctxt contract >>=? function
+  Storage.Contract.Storage.get_option ctxt contract
-  | (ctxt, None) -> return (ctxt, None)
+  >>=? function
+  | (ctxt, None) ->
+      return (ctxt, None)
   | (ctxt, Some storage) ->
-      Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, cost) ->
+      Lwt.return (Script_repr.force_decode storage)
-      Lwt.return (Raw_context.consume_gas ctxt cost) >>=? fun ctxt ->
+      >>=? fun (storage, cost) ->
-      return (ctxt, Some storage)
+      Lwt.return (Raw_context.consume_gas ctxt cost)
+      >>=? fun ctxt -> return (ctxt, Some storage)
 
 let get_counter c manager =
   let contract = Contract_repr.implicit_contract manager in
-  Storage.Contract.Counter.get_option c contract >>=? function
+  Storage.Contract.Counter.get_option c contract
-  | None -> begin
+  >>=? function
+  | None -> (
     match Contract_repr.is_implicit contract with
-      | Some _ -> Storage.Contract.Global_counter.get c
+    | Some _ ->
-      | None -> failwith "get_counter"
+        Storage.Contract.Global_counter.get c
-    end
+    | None ->
-  | Some v -> return v
+        failwith "get_counter" )
-
+  | Some v ->
-let get_manager_004 c contract =
+      return v
-  Storage.Contract.Manager.get_option c contract >>=? function
-  | None -> begin
-      match Contract_repr.is_implicit contract with
-      | Some manager -> return manager
-      | None -> failwith "get_manager"
-    end
-  | Some (Manager_repr.Hash v) -> return v
-  | Some (Manager_repr.Public_key v) -> return (Signature.Public_key.hash v)
 
 let get_manager_key c manager =
   let contract = Contract_repr.implicit_contract manager in
-  Storage.Contract.Manager.get_option c contract >>=? function
+  Storage.Contract.Manager.get_option c contract
-  | None -> failwith "get_manager_key"
+  >>=? function
-  | Some (Manager_repr.Hash _) -> fail (Unrevealed_manager_key contract)
+  | None ->
-  | Some (Manager_repr.Public_key v) -> return v
+      failwith "get_manager_key"
+  | Some (Manager_repr.Hash _) ->
+      fail (Unrevealed_manager_key contract)
+  | Some (Manager_repr.Public_key v) ->
+      return v
 
 let is_manager_key_revealed c manager =
   let contract = Contract_repr.implicit_contract manager in
-  Storage.Contract.Manager.get_option c contract >>=? function
+  Storage.Contract.Manager.get_option c contract
-  | None -> return_false
+  >>=? function
-  | Some (Manager_repr.Hash _) -> return_false
+  | None ->
-  | Some (Manager_repr.Public_key _) -> return_true
+      return_false
+  | Some (Manager_repr.Hash _) ->
+      return_false
+  | Some (Manager_repr.Public_key _) ->
+      return_true
 
 let reveal_manager_key c manager public_key =
   let contract = Contract_repr.implicit_contract manager in
-  Storage.Contract.Manager.get c contract >>=? function
+  Storage.Contract.Manager.get c contract
-  | Public_key _ -> fail (Previously_revealed_key contract)
+  >>=? function
+  | Public_key _ ->
+      fail (Previously_revealed_key contract)
   | Hash v ->
       let actual_hash = Signature.Public_key.hash public_key in
-      if (Signature.Public_key_hash.equal actual_hash v) then
+      if Signature.Public_key_hash.equal actual_hash v then
-        let v = (Manager_repr.Public_key public_key) in
+        let v = Manager_repr.Public_key public_key in
-        Storage.Contract.Manager.set c contract v >>=? fun c ->
+        Storage.Contract.Manager.set c contract v >>=? fun c -> return c
-        return c
       else fail (Inconsistent_hash (public_key, v, actual_hash))
 
 let get_balance c contract =
-  Storage.Contract.Balance.get_option c contract >>=? function
+  Storage.Contract.Balance.get_option c contract
-  | None -> begin
+  >>=? function
+  | None -> (
     match Contract_repr.is_implicit contract with
-      | Some _ -> return Tez_repr.zero
+    | Some _ ->
-      | None -> failwith "get_balance"
+        return Tez_repr.zero
-    end
+    | None ->
-  | Some v -> return v
+        failwith "get_balance" )
+  | Some v ->
+      return v
 
 let update_script_storage c contract storage big_map_diff =
   let storage = Script_repr.lazy_expr storage in
-  update_script_big_map c big_map_diff >>=? fun (c, big_map_size_diff) ->
+  update_script_big_map c big_map_diff
-  Storage.Contract.Storage.set c contract storage >>=? fun (c, size_diff) ->
+  >>=? fun (c, big_map_size_diff) ->
-  Storage.Contract.Used_storage_space.get c contract >>=? fun previous_size ->
+  Storage.Contract.Storage.set c contract storage
-  let new_size = Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff)) in
+  >>=? fun (c, size_diff) ->
+  Storage.Contract.Used_storage_space.get c contract
+  >>=? fun previous_size ->
+  let new_size =
+    Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff))
+  in
   Storage.Contract.Used_storage_space.set c contract new_size
 
 let spend c contract amount =
-  Storage.Contract.Balance.get c contract >>=? fun balance ->
+  Storage.Contract.Balance.get c contract
+  >>=? fun balance ->
   match Tez_repr.(balance -? amount) with
   | Error _ ->
       fail (Balance_too_low (contract, balance, amount))
-  | Ok new_balance ->
+  | Ok new_balance -> (
-      Storage.Contract.Balance.set c contract new_balance >>=? fun c ->
+      Storage.Contract.Balance.set c contract new_balance
-      Roll_storage.Contract.remove_amount c contract amount >>=? fun c ->
+      >>=? fun c ->
-      if Tez_repr.(new_balance > Tez_repr.zero) then
+      Roll_storage.Contract.remove_amount c contract amount
-        return c
+      >>=? fun c ->
-      else match Contract_repr.is_implicit contract with
+      if Tez_repr.(new_balance > Tez_repr.zero) then return c
-        | None -> return c (* Never delete originated contracts *)
+      else
-        | Some pkh ->
+        match Contract_repr.is_implicit contract with
-            Delegate_storage.get c contract >>=? function
+        | None ->
+            return c (* Never delete originated contracts *)
+        | Some pkh -> (
+            Delegate_storage.get c contract
+            >>=? function
             | Some pkh' ->
-                (* Don't delete "delegate" contract *)
+                if Signature.Public_key_hash.equal pkh pkh' then return c
-                assert (Signature.Public_key_hash.equal pkh pkh') ;
+                else
-                return c
+                  (* Delegated implicit accounts cannot be emptied *)
+                  fail (Empty_implicit_delegated_contract pkh)
             | None ->
                 (* Delete empty implicit contract *)
-                delete c contract
+                delete c contract ) )
 
 let credit c contract amount =
-  begin
+  ( if Tez_repr.(amount <> Tez_repr.zero) then return c
-    if Tez_repr.(amount <> Tez_repr.zero) then
-      return c
   else
-      Storage.Contract.Code.mem c contract >>=? fun (c, target_has_code) ->
+    Storage.Contract.Code.mem c contract
-      fail_unless target_has_code (Empty_transaction contract) >>=? fun () ->
+    >>=? fun (c, target_has_code) ->
-      return c
+    fail_unless target_has_code (Empty_transaction contract)
-  end >>=? fun c ->
+    >>=? fun () -> return c )
-  Storage.Contract.Balance.get_option c contract >>=? function
+  >>=? fun c ->
-  | None -> begin
+  Storage.Contract.Balance.get_option c contract
+  >>=? function
+  | None -> (
     match Contract_repr.is_implicit contract with
-      | None -> fail (Non_existing_contract contract)
+    | None ->
+        fail (Non_existing_contract contract)
     | Some manager ->
-          create_implicit c manager ~balance:amount
+        create_implicit c manager ~balance:amount )
-    end
   | Some balance ->
-      Lwt.return Tez_repr.(amount +? balance) >>=? fun balance ->
+      Lwt.return Tez_repr.(amount +? balance)
-      Storage.Contract.Balance.set c contract balance >>=? fun c ->
+      >>=? fun balance ->
-      Roll_storage.Contract.add_amount c contract amount
+      Storage.Contract.Balance.set c contract balance
+      >>=? fun c -> Roll_storage.Contract.add_amount c contract amount
 
 let init c =
   Storage.Contract.Global_counter.init c Z.zero
+  >>=? fun c -> Storage.Big_map.Next.init c
 
 let used_storage_space c contract =
-  Storage.Contract.Used_storage_space.get_option c contract >>=? function
+  Storage.Contract.Used_storage_space.get_option c contract
-  | None -> return Z.zero
+  >>=? function None -> return Z.zero | Some fees -> return fees
-  | Some fees -> return fees
 
 let paid_storage_space c contract =
-  Storage.Contract.Paid_storage_space.get_option c contract >>=? function
+  Storage.Contract.Paid_storage_space.get_option c contract
-  | None -> return Z.zero
+  >>=? function None -> return Z.zero | Some paid_space -> return paid_space
-  | Some paid_space -> return paid_space
 
-let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space =
+let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space
-  Storage.Contract.Paid_storage_space.get c contract >>=? fun already_paid_space ->
+    =
-  if Compare.Z.(already_paid_space >= new_storage_space) then
+  Storage.Contract.Paid_storage_space.get c contract
-    return (Z.zero, c)
+  >>=? fun already_paid_space ->
+  if Compare.Z.(already_paid_space >= new_storage_space) then return (Z.zero, c)
   else
     let to_pay = Z.sub new_storage_space already_paid_space in
-    Storage.Contract.Paid_storage_space.set c contract new_storage_space >>=? fun c ->
+    Storage.Contract.Paid_storage_space.set c contract new_storage_space
-    return (to_pay, c)
+    >>=? fun c -> return (to_pay, c)

vendors/ligo-utils/tezos-protocol-alpha/contract_storage.mli

@@ -24,25 +24,43 @@
 (*****************************************************************************)
 
 type error +=
-  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
+  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
-  | Counter_in_the_past of Contract_repr.contract * Z.t * Z.t (* `Branch *)
+  | (* `Temporary *)
-  | Counter_in_the_future of Contract_repr.contract * Z.t * Z.t (* `Temporary *)
+      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
-  | Unspendable_contract of Contract_repr.contract (* `Permanent *)
+  | (* `Branch *)
-  | Non_existing_contract of Contract_repr.contract (* `Temporary *)
+      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
-  | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *)
+  | (* `Temporary *)
-  | Empty_transaction of Contract_repr.t (* `Temporary *)
+      Unspendable_contract of Contract_repr.contract
-  | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+  | (* `Permanent *)
-  | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *)
+      Non_existing_contract of Contract_repr.contract
-  | Failure of string (* `Permanent *)
+  | (* `Temporary *)
+      Empty_implicit_contract of Signature.Public_key_hash.t
+  | (* `Temporary *)
+      Empty_implicit_delegated_contract of
+      Signature.Public_key_hash.t
+  | (* `Temporary *)
+      Empty_transaction of Contract_repr.t (* `Temporary *)
+  | Inconsistent_hash of
+      Signature.Public_key.t
+      * Signature.Public_key_hash.t
+      * Signature.Public_key_hash.t
+  | (* `Permanent *)
+      Inconsistent_public_key of
+      Signature.Public_key.t * Signature.Public_key.t
+  | (* `Permanent *)
+      Failure of string (* `Permanent *)
   | Previously_revealed_key of Contract_repr.t (* `Permanent *)
-  | Unrevealed_manager_key of Contract_repr.t (* `Permanent *)
+  | Unrevealed_manager_key of Contract_repr.t
+
+(* `Permanent *)
 
 val exists : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
+
 val must_exist : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
 
 val allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
-val must_be_allocated: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
 
+val must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
 
 val list : Raw_context.t -> Contract_repr.t list Lwt.t
 
@@ -52,28 +70,39 @@ val check_counter_increment:
 val increment_counter :
   Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
 
-val get_manager_004:
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t tzresult Lwt.t
-
 val get_manager_key :
-  Raw_context.t -> Signature.Public_key_hash.t -> Signature.Public_key.t tzresult Lwt.t
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Signature.Public_key.t tzresult Lwt.t
+
 val is_manager_key_revealed :
   Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
 val reveal_manager_key :
-  Raw_context.t -> Signature.Public_key_hash.t -> Signature.Public_key.t  ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Signature.Public_key.t ->
   Raw_context.t tzresult Lwt.t
 
 val get_balance : Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
-val get_counter: Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t
+
+val get_counter :
+  Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t
 
 val get_script_code :
-  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t
+  Raw_context.t ->
-val get_script:
+  Contract_repr.t ->
-  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t
+  (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t
-val get_storage:
-  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
 
+val get_script :
+  Raw_context.t ->
+  Contract_repr.t ->
+  (Raw_context.t * Script_repr.t option) tzresult Lwt.t
+
+val get_storage :
+  Raw_context.t ->
+  Contract_repr.t ->
+  (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
 
 type big_map_diff_item =
   | Update of {
@@ -95,16 +124,22 @@ type big_map_diff = big_map_diff_item list
 val big_map_diff_encoding : big_map_diff Data_encoding.t
 
 val update_script_storage :
-  Raw_context.t -> Contract_repr.t ->
+  Raw_context.t ->
-  Script_repr.expr -> big_map_diff option ->
+  Contract_repr.t ->
+  Script_repr.expr ->
+  big_map_diff option ->
   Raw_context.t tzresult Lwt.t
 
 val credit :
-  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
+  Raw_context.t ->
+  Contract_repr.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
 val spend :
-  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
+  Raw_context.t ->
+  Contract_repr.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
 val originate :
@@ -112,20 +147,26 @@ val originate:
   ?prepaid_bootstrap_storage:bool ->
   Contract_repr.t ->
   balance:Tez_repr.t ->
-  script:(Script_repr.t * big_map_diff option) ->
+  script:Script_repr.t * big_map_diff option ->
   delegate:Signature.Public_key_hash.t option ->
   Raw_context.t tzresult Lwt.t
 
 val fresh_contract_from_current_nonce :
   Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t
+
 val originated_from_current_nonce :
   since:Raw_context.t ->
   until:Raw_context.t ->
   Contract_repr.t list tzresult Lwt.t
 
-val init:
+val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
-  Raw_context.t -> Raw_context.t tzresult Lwt.t
 
 val used_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+
 val paid_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
-val set_paid_storage_space_and_return_fees_to_pay: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t
+
+val set_paid_storage_space_and_return_fees_to_pay :
+  Raw_context.t ->
+  Contract_repr.t ->
+  Z.t ->
+  (Z.t * Raw_context.t) tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/cycle_repr.ml

@@ -24,15 +24,20 @@
 (*****************************************************************************)
 
 type t = int32
+
 type cycle = t
 
 let encoding = Data_encoding.int32
+
 let rpc_arg =
   let construct = Int32.to_string in
   let destruct str =
     match Int32.of_string str with
-    | exception _ -> Error "Cannot parse cycle"
+    | exception _ ->
-    | cycle -> Ok cycle in
+        Error "Cannot parse cycle"
+    | cycle ->
+        Ok cycle
+  in
   RPC_arg.make
     ~descr:"A cycle integer"
     ~name:"block_cycle"
@@ -47,39 +52,42 @@ include (Compare.Int32 : Compare.S with type t := t)
 module Map = Map.Make (Compare.Int32)
 
 let root = 0l
+
 let succ = Int32.succ
-let pred = function
+
-  | 0l -> None
+let pred = function 0l -> None | i -> Some (Int32.pred i)
-  | i -> Some (Int32.pred i)
 
 let add c i =
-  assert Compare.Int.(i > 0) ;
+  assert (Compare.Int.(i > 0)) ;
   Int32.add c (Int32.of_int i)
 
 let sub c i =
-  assert Compare.Int.(i > 0) ;
+  assert (Compare.Int.(i > 0)) ;
   let r = Int32.sub c (Int32.of_int i) in
   if Compare.Int32.(r < 0l) then None else Some r
 
 let to_int32 i = i
 
 let of_int32_exn l =
-  if Compare.Int32.(l >= 0l)
+  if Compare.Int32.(l >= 0l) then l
-  then l
   else invalid_arg "Level_repr.Cycle.of_int32"
 
 module Index = struct
   type t = cycle
+
   let path_length = 1
-  let to_path c l =
+
-    Int32.to_string (to_int32 c) :: l
+  let to_path c l = Int32.to_string (to_int32 c) :: l
+
   let of_path = function
-    | [s] -> begin
+    | [s] -> (
-        try Some (Int32.of_string s)
+      try Some (Int32.of_string s) with _ -> None )
-        with _ -> None
+    | _ ->
-      end
+        None
-    | _ -> None
+
   let rpc_arg = rpc_arg
+
   let encoding = encoding
+
   let compare = compare
 end

vendors/ligo-utils/tezos-protocol-alpha/cycle_repr.mli

@@ -24,19 +24,29 @@
 (*****************************************************************************)
 
 type t
+
 type cycle = t
+
 include Compare.S with type t := t
+
 val encoding : cycle Data_encoding.t
+
 val rpc_arg : cycle RPC_arg.arg
+
 val pp : Format.formatter -> cycle -> unit
 
 val root : cycle
+
 val pred : cycle -> cycle option
+
 val add : cycle -> int -> cycle
+
 val sub : cycle -> int -> cycle option
+
 val succ : cycle -> cycle
 
 val to_int32 : cycle -> int32
+
 val of_int32_exn : int32 -> cycle
 
 module Map : S.MAP with type key = cycle

vendors/ligo-utils/tezos-protocol-alpha/delegate_services.ml

@@ -39,18 +39,40 @@ type info = {
 let info_encoding =
   let open Data_encoding in
   conv
-    (fun { balance ; frozen_balance ; frozen_balance_by_cycle ;
+    (fun { balance;
-           staking_balance ; delegated_contracts ;  delegated_balance ;
+           frozen_balance;
-           deactivated ; grace_period } ->
+           frozen_balance_by_cycle;
-      (balance, frozen_balance, frozen_balance_by_cycle,
+           staking_balance;
-       staking_balance, delegated_contracts, delegated_balance,
+           delegated_contracts;
-       deactivated, grace_period))
+           delegated_balance;
-    (fun (balance, frozen_balance, frozen_balance_by_cycle,
+           deactivated;
-          staking_balance, delegated_contracts, delegated_balance,
+           grace_period } ->
-          deactivated, grace_period) ->
+      ( balance,
-      { balance ; frozen_balance ; frozen_balance_by_cycle ;
+        frozen_balance,
-        staking_balance ; delegated_contracts ;  delegated_balance ;
+        frozen_balance_by_cycle,
-        deactivated ; grace_period })
+        staking_balance,
+        delegated_contracts,
+        delegated_balance,
+        deactivated,
+        grace_period ))
+    (fun ( balance,
+           frozen_balance,
+           frozen_balance_by_cycle,
+           staking_balance,
+           delegated_contracts,
+           delegated_balance,
+           deactivated,
+           grace_period ) ->
+      {
+        balance;
+        frozen_balance;
+        frozen_balance_by_cycle;
+        staking_balance;
+        delegated_contracts;
+        delegated_balance;
+        deactivated;
+        grace_period;
+      })
     (obj8
        (req "balance" Tez.encoding)
        (req "frozen_balance" Tez.encoding)
@@ -62,15 +84,12 @@ let info_encoding =
        (req "grace_period" Cycle.encoding))
 
 module S = struct
-
   let path = RPC_path.(open_root / "context" / "delegates")
 
   open Data_encoding
 
-  type list_query = {
+  type list_query = {active : bool; inactive : bool}
-    active: bool ;
+
-    inactive: bool ;
-  }
   let list_query : list_query RPC_query.t =
     let open RPC_query in
     query (fun active inactive -> {active; inactive})
@@ -80,8 +99,7 @@ module S = struct
 
   let list_delegate =
     RPC_service.get_service
-      ~description:
+      ~description:"Lists all registered delegates."
-        "Lists all registered delegates."
       ~query:list_query
       ~output:(list Signature.Public_key_hash.encoding)
       path
@@ -90,8 +108,7 @@ module S = struct
 
   let info =
     RPC_service.get_service
-      ~description:
+      ~description:"Everything about a delegate."
-        "Everything about a delegate."
       ~query:RPC_query.empty
       ~output:info_encoding
       path
@@ -99,8 +116,8 @@ module S = struct
   let balance =
     RPC_service.get_service
       ~description:
-        "Returns the full balance of a given delegate, \
+        "Returns the full balance of a given delegate, including the frozen \
-         including the frozen balances."
+         balances."
       ~query:RPC_query.empty
       ~output:Tez.encoding
       RPC_path.(path / "balance")
@@ -108,8 +125,8 @@ module S = struct
   let frozen_balance =
     RPC_service.get_service
       ~description:
-        "Returns the total frozen balances of a given delegate, \
+        "Returns the total frozen balances of a given delegate, this includes \
-         this includes the frozen deposits, rewards and fees."
+         the frozen deposits, rewards and fees."
       ~query:RPC_query.empty
       ~output:Tez.encoding
       RPC_path.(path / "frozen_balance")
@@ -117,8 +134,8 @@ module S = struct
   let frozen_balance_by_cycle =
     RPC_service.get_service
       ~description:
-        "Returns the frozen balances of a given delegate, \
+        "Returns the frozen balances of a given delegate, indexed by the \
-         indexed by the cycle by which it will be unfrozen"
+         cycle by which it will be unfrozen"
       ~query:RPC_query.empty
       ~output:Delegate.frozen_balance_by_cycle_encoding
       RPC_path.(path / "frozen_balance_by_cycle")
@@ -127,10 +144,10 @@ module S = struct
     RPC_service.get_service
       ~description:
         "Returns the total amount of tokens delegated to a given delegate. \
-         This includes the balances of all the contracts that delegate \
+         This includes the balances of all the contracts that delegate to it, \
-         to it, but also the balance of the delegate itself and its frozen \
+         but also the balance of the delegate itself and its frozen fees and \
-         fees and deposits. The rewards do not count in the delegated balance \
+         deposits. The rewards do not count in the delegated balance until \
-         until they are unfrozen."
+         they are unfrozen."
       ~query:RPC_query.empty
       ~output:Tez.encoding
       RPC_path.(path / "staking_balance")
@@ -146,9 +163,9 @@ module S = struct
   let delegated_balance =
     RPC_service.get_service
       ~description:
-        "Returns the balances of all the contracts that delegate to a \
+        "Returns the balances of all the contracts that delegate to a given \
-         given delegate. This excludes the delegate's own balance and \
+         delegate. This excludes the delegate's own balance and its frozen \
-         its frozen balances."
+         balances."
       ~query:RPC_query.empty
       ~output:Tez.encoding
       RPC_path.(path / "delegated_balance")
@@ -165,85 +182,82 @@ module S = struct
     RPC_service.get_service
       ~description:
         "Returns the cycle by the end of which the delegate might be \
-         deactivated if she fails to execute any delegate action. \
+         deactivated if she fails to execute any delegate action. A \
-         A deactivated delegate might be reactivated \
+         deactivated delegate might be reactivated (without loosing any \
-         (without loosing any rolls) by simply re-registering as a delegate. \
+         rolls) by simply re-registering as a delegate. For deactivated \
-         For deactivated delegates, this value contains the cycle by which \
+         delegates, this value contains the cycle by which they were \
-         they were deactivated."
+         deactivated."
       ~query:RPC_query.empty
       ~output:Cycle.encoding
       RPC_path.(path / "grace_period")
-
 end
 
 let register () =
   let open Services_registration in
-  register0 S.list_delegate begin fun ctxt q () ->
+  register0 S.list_delegate (fun ctxt q () ->
-    Delegate.list ctxt >>= fun delegates ->
+      Delegate.list ctxt
-    if q.active && q.inactive then
+      >>= fun delegates ->
-      return delegates
+      if q.active && q.inactive then return delegates
       else if q.active then
         filter_map_s
           (fun pkh ->
-           Delegate.deactivated ctxt pkh >>=? function
+            Delegate.deactivated ctxt pkh
-           | true -> return_none
+            >>=? function true -> return_none | false -> return_some pkh)
-           | false -> return_some pkh)
           delegates
       else if q.inactive then
         filter_map_s
           (fun pkh ->
-           Delegate.deactivated ctxt pkh >>=? function
-           | false -> return_none
-           | true -> return_some pkh)
-        delegates
-    else
-      return_nil
-  end ;
-  register1 S.info begin fun ctxt pkh () () ->
-    Delegate.full_balance ctxt pkh >>=? fun balance ->
-    Delegate.frozen_balance ctxt pkh >>=? fun frozen_balance ->
-    Delegate.frozen_balance_by_cycle ctxt pkh >>= fun frozen_balance_by_cycle ->
-    Delegate.staking_balance ctxt pkh >>=? fun staking_balance ->
-    Delegate.delegated_contracts ctxt pkh >>= fun delegated_contracts ->
-    Delegate.delegated_balance ctxt pkh >>=? fun delegated_balance ->
-    Delegate.deactivated ctxt pkh >>=? fun deactivated ->
-    Delegate.grace_period ctxt pkh >>=? fun grace_period ->
-    return {
-      balance ; frozen_balance ; frozen_balance_by_cycle ;
-      staking_balance ; delegated_contracts ; delegated_balance ;
-      deactivated ; grace_period
-    }
-  end ;
-  register1 S.balance begin fun ctxt pkh () () ->
-    Delegate.full_balance ctxt pkh
-  end ;
-  register1 S.frozen_balance begin fun ctxt pkh () () ->
-    Delegate.frozen_balance ctxt pkh
-  end ;
-  register1 S.frozen_balance_by_cycle begin fun ctxt pkh () () ->
-    Delegate.frozen_balance_by_cycle ctxt pkh >>= return
-  end ;
-  register1 S.staking_balance begin fun ctxt pkh () () ->
-    Delegate.staking_balance ctxt pkh
-  end ;
-  register1 S.delegated_contracts begin fun ctxt pkh () () ->
-    Delegate.delegated_contracts ctxt pkh >>= return
-  end ;
-  register1 S.delegated_balance begin fun ctxt pkh () () ->
-    Delegate.delegated_balance ctxt pkh
-  end ;
-  register1 S.deactivated begin fun ctxt pkh () () ->
             Delegate.deactivated ctxt pkh
-  end ;
+            >>=? function false -> return_none | true -> return_some pkh)
-  register1 S.grace_period begin fun ctxt pkh () () ->
+          delegates
+      else return_nil) ;
+  register1 S.info (fun ctxt pkh () () ->
+      Delegate.full_balance ctxt pkh
+      >>=? fun balance ->
+      Delegate.frozen_balance ctxt pkh
+      >>=? fun frozen_balance ->
+      Delegate.frozen_balance_by_cycle ctxt pkh
+      >>= fun frozen_balance_by_cycle ->
+      Delegate.staking_balance ctxt pkh
+      >>=? fun staking_balance ->
+      Delegate.delegated_contracts ctxt pkh
+      >>= fun delegated_contracts ->
+      Delegate.delegated_balance ctxt pkh
+      >>=? fun delegated_balance ->
+      Delegate.deactivated ctxt pkh
+      >>=? fun deactivated ->
       Delegate.grace_period ctxt pkh
-  end
+      >>=? fun grace_period ->
+      return
+        {
+          balance;
+          frozen_balance;
+          frozen_balance_by_cycle;
+          staking_balance;
+          delegated_contracts;
+          delegated_balance;
+          deactivated;
+          grace_period;
+        }) ;
+  register1 S.balance (fun ctxt pkh () () -> Delegate.full_balance ctxt pkh) ;
+  register1 S.frozen_balance (fun ctxt pkh () () ->
+      Delegate.frozen_balance ctxt pkh) ;
+  register1 S.frozen_balance_by_cycle (fun ctxt pkh () () ->
+      Delegate.frozen_balance_by_cycle ctxt pkh >>= return) ;
+  register1 S.staking_balance (fun ctxt pkh () () ->
+      Delegate.staking_balance ctxt pkh) ;
+  register1 S.delegated_contracts (fun ctxt pkh () () ->
+      Delegate.delegated_contracts ctxt pkh >>= return) ;
+  register1 S.delegated_balance (fun ctxt pkh () () ->
+      Delegate.delegated_balance ctxt pkh) ;
+  register1 S.deactivated (fun ctxt pkh () () -> Delegate.deactivated ctxt pkh) ;
+  register1 S.grace_period (fun ctxt pkh () () ->
+      Delegate.grace_period ctxt pkh)
 
 let list ctxt block ?(active = true) ?(inactive = false) () =
   RPC_context.make_call0 S.list_delegate ctxt block {active; inactive} ()
 
-let info ctxt block pkh =
+let info ctxt block pkh = RPC_context.make_call1 S.info ctxt block pkh () ()
-  RPC_context.make_call1 S.info ctxt block pkh () ()
 
 let balance ctxt block pkh =
   RPC_context.make_call1 S.balance ctxt block pkh () ()
@@ -270,30 +284,29 @@ let grace_period ctxt block pkh =
   RPC_context.make_call1 S.grace_period ctxt block pkh () ()
 
 let requested_levels ~default ctxt cycles levels =
-  match levels, cycles with
+  match (levels, cycles) with
-  | [], [] ->
+  | ([], []) ->
       return [default]
-  | levels, cycles ->
+  | (levels, cycles) ->
       (* explicitly fail when requested levels or cycle are in the past...
          or too far in the future... *)
       let levels =
         List.sort_uniq
           Level.compare
-          (List.concat (List.map (Level.from_raw ctxt) levels ::
+          (List.concat
-                        List.map (Level.levels_in_cycle ctxt) cycles)) in
+             ( List.map (Level.from_raw ctxt) levels
+             :: List.map (Level.levels_in_cycle ctxt) cycles ))
+      in
       map_s
         (fun level ->
           let current_level = Level.current ctxt in
-           if Level.(level <= current_level) then
+          if Level.(level <= current_level) then return (level, None)
-             return (level, None)
           else
-             Baking.earlier_predecessor_timestamp
+            Baking.earlier_predecessor_timestamp ctxt level
-               ctxt level >>=? fun timestamp ->
+            >>=? fun timestamp -> return (level, Some timestamp))
-             return (level, Some timestamp))
         levels
 
 module Baking_rights = struct
-
   type t = {
     level : Raw_level.t;
     delegate : Signature.Public_key_hash.t;
@@ -315,11 +328,9 @@ module Baking_rights = struct
          (opt "estimated_time" Timestamp.encoding))
 
   module S = struct
-
     open Data_encoding
 
-    let custom_root =
+    let custom_root = RPC_path.(open_root / "helpers" / "baking_rights")
-      RPC_path.(open_root / "helpers" / "baking_rights")
 
     type baking_rights_query = {
       levels : Raw_level.t list;
@@ -335,7 +346,8 @@ module Baking_rights = struct
           {levels; cycles; delegates; max_priority; all})
       |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
       |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
-      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)
+      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
+             t.delegates)
       |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority)
       |+ flag "all" (fun t -> t.all)
       |> seal
@@ -344,98 +356,100 @@ module Baking_rights = struct
       RPC_service.get_service
         ~description:
           "Retrieves the list of delegates allowed to bake a block.\n\
-           By default, it gives the best baking priorities for bakers \
+           By default, it gives the best baking priorities for bakers that \
-           that have at least one opportunity below the 64th priority \
+           have at least one opportunity below the 64th priority for the next \
-           for the next block.\n\
+           block.\n\
-           Parameters `level` and `cycle` can be used to specify the \
+           Parameters `level` and `cycle` can be used to specify the (valid) \
-           (valid) level(s) in the past or future at which the baking \
+           level(s) in the past or future at which the baking rights have to \
-           rights have to be returned. Parameter `delegate` can be \
+           be returned. Parameter `delegate` can be used to restrict the \
-           used to restrict the results to the given delegates. If \
+           results to the given delegates. If parameter `all` is set, all the \
-           parameter `all` is set, all the baking opportunities for \
+           baking opportunities for each baker at each level are returned, \
-           each baker at each level are returned, instead of just the \
+           instead of just the first one.\n\
-           first one.\n\
            Returns the list of baking slots. Also returns the minimal \
-           timestamps that correspond to these slots. The timestamps \
+           timestamps that correspond to these slots. The timestamps are \
-           are omitted for levels in the past, and are only estimates \
+           omitted for levels in the past, and are only estimates for levels \
-           for levels later that the next block, based on the \
+           later that the next block, based on the hypothesis that all \
-           hypothesis that all predecessor blocks were baked at the \
+           predecessor blocks were baked at the first priority."
-           first priority."
         ~query:baking_rights_query
         ~output:(list encoding)
         custom_root
-
   end
 
   let baking_priorities ctxt max_prio (level, pred_timestamp) =
-    Baking.baking_priorities ctxt level >>=? fun contract_list ->
+    Baking.baking_priorities ctxt level
+    >>=? fun contract_list ->
     let rec loop l acc priority =
-      if Compare.Int.(priority >= max_prio) then
+      if Compare.Int.(priority > max_prio) then return (List.rev acc)
-        return (List.rev acc)
       else
-        let Misc.LCons (pk, next) = l in
+        let (Misc.LCons (pk, next)) = l in
         let delegate = Signature.Public_key.hash pk in
-        begin
+        ( match pred_timestamp with
-          match pred_timestamp with
+        | None ->
-          | None -> return_none
+            return_none
         | Some pred_timestamp ->
-              Baking.minimal_time ctxt priority pred_timestamp >>=? fun t ->
+            Baking.minimal_time ctxt priority pred_timestamp
-              return_some t
+            >>=? fun t -> return_some t )
-        end>>=? fun timestamp ->
+        >>=? fun timestamp ->
         let acc =
-          { level = level.level ; delegate ; priority ; timestamp } :: acc in
+          {level = level.level; delegate; priority; timestamp} :: acc
-        next () >>=? fun l ->
+        in
-        loop l acc (priority+1) in
+        next () >>=? fun l -> loop l acc (priority + 1)
+    in
     loop contract_list [] 0
 
   let remove_duplicated_delegates rights =
-    List.rev @@ fst @@
+    List.rev @@ fst
-    List.fold_left
+    @@ List.fold_left
          (fun (acc, previous) r ->
            if Signature.Public_key_hash.Set.mem r.delegate previous then
              (acc, previous)
            else
-           (r :: acc,
+             (r :: acc, Signature.Public_key_hash.Set.add r.delegate previous))
-            Signature.Public_key_hash.Set.add r.delegate previous))
          ([], Signature.Public_key_hash.Set.empty)
          rights
 
   let register () =
     let open Services_registration in
-    register0 S.baking_rights begin fun ctxt q () ->
+    register0 S.baking_rights (fun ctxt q () ->
         requested_levels
           ~default:
-          (Level.succ ctxt (Level.current ctxt), Some (Timestamp.current ctxt))
+            ( Level.succ ctxt (Level.current ctxt),
-        ctxt q.cycles q.levels >>=? fun levels ->
+              Some (Timestamp.current ctxt) )
+          ctxt
+          q.cycles
+          q.levels
+        >>=? fun levels ->
         let max_priority =
-        match q.max_priority with
+          match q.max_priority with None -> 64 | Some max -> max
-        | None -> 64
+        in
-        | Some max -> max in
+        map_s (baking_priorities ctxt max_priority) levels
-      map_s (baking_priorities ctxt max_priority) levels >>=? fun rights ->
+        >>=? fun rights ->
         let rights =
-        if q.all then
+          if q.all then rights else List.map remove_duplicated_delegates rights
-          rights
+        in
-        else
-          List.map remove_duplicated_delegates rights in
         let rights = List.concat rights in
         match q.delegates with
-      | [] -> return rights
+        | [] ->
+            return rights
         | _ :: _ as delegates ->
             let is_requested p =
-            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in
+              List.exists
-          return (List.filter is_requested rights)
+                (Signature.Public_key_hash.equal p.delegate)
-    end
+                delegates
+            in
+            return (List.filter is_requested rights))
 
-  let get ctxt
+  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
-      ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
       ?max_priority block =
-    RPC_context.make_call0 S.baking_rights ctxt block
+    RPC_context.make_call0
+      S.baking_rights
+      ctxt
+      block
       {levels; cycles; delegates; max_priority; all}
       ()
-
 end
 
 module Endorsing_rights = struct
-
   type t = {
     level : Raw_level.t;
     delegate : Signature.Public_key_hash.t;
@@ -457,11 +471,9 @@ module Endorsing_rights = struct
          (opt "estimated_time" Timestamp.encoding))
 
   module S = struct
-
     open Data_encoding
 
-    let custom_root =
+    let custom_root = RPC_path.(open_root / "helpers" / "endorsing_rights")
-      RPC_path.(open_root / "helpers" / "endorsing_rights")
 
     type endorsing_rights_query = {
       levels : Raw_level.t list;
@@ -471,80 +483,85 @@ module Endorsing_rights = struct
 
     let endorsing_rights_query =
       let open RPC_query in
-      query (fun levels cycles delegates ->
+      query (fun levels cycles delegates -> {levels; cycles; delegates})
-          { levels ; cycles ; delegates })
       |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
       |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
-      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)
+      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
+             t.delegates)
       |> seal
 
     let endorsing_rights =
       RPC_service.get_service
         ~description:
           "Retrieves the delegates allowed to endorse a block.\n\
-           By default, it gives the endorsement slots for delegates that \
+           By default, it gives the endorsement slots for delegates that have \
-           have at least one in the next block.\n\
+           at least one in the next block.\n\
-           Parameters `level` and `cycle` can be used to specify the \
+           Parameters `level` and `cycle` can be used to specify the (valid) \
-           (valid) level(s) in the past or future at which the \
+           level(s) in the past or future at which the endorsement rights \
-           endorsement rights have to be returned. Parameter \
+           have to be returned. Parameter `delegate` can be used to restrict \
-           `delegate` can be used to restrict the results to the given \
+           the results to the given delegates.\n\
-           delegates.\n\
+           Returns the list of endorsement slots. Also returns the minimal \
-           Returns the list of endorsement slots. Also returns the \
+           timestamps that correspond to these slots. The timestamps are \
-           minimal timestamps that correspond to these slots. The \
+           omitted for levels in the past, and are only estimates for levels \
-           timestamps are omitted for levels in the past, and are only \
+           later that the next block, based on the hypothesis that all \
-           estimates for levels later that the next block, based on \
+           predecessor blocks were baked at the first priority."
-           the hypothesis that all predecessor blocks were baked at \
-           the first priority."
         ~query:endorsing_rights_query
         ~output:(list encoding)
         custom_root
-
   end
 
   let endorsement_slots ctxt (level, estimated_time) =
-    Baking.endorsement_rights ctxt level >>=? fun rights ->
+    Baking.endorsement_rights ctxt level
+    >>=? fun rights ->
     return
       (Signature.Public_key_hash.Map.fold
-         (fun delegate (_, slots, _) acc -> {
+         (fun delegate (_, slots, _) acc ->
-              level = level.level ; delegate ; slots ; estimated_time
+           {level = level.level; delegate; slots; estimated_time} :: acc)
-            } :: acc)
+         rights
-         rights [])
+         [])
 
   let register () =
     let open Services_registration in
-    register0 S.endorsing_rights begin fun ctxt q () ->
+    register0 S.endorsing_rights (fun ctxt q () ->
         requested_levels
           ~default:(Level.current ctxt, Some (Timestamp.current ctxt))
-        ctxt q.cycles q.levels >>=? fun levels ->
+          ctxt
-      map_s (endorsement_slots ctxt) levels >>=? fun rights ->
+          q.cycles
+          q.levels
+        >>=? fun levels ->
+        map_s (endorsement_slots ctxt) levels
+        >>=? fun rights ->
         let rights = List.concat rights in
         match q.delegates with
-      | [] -> return rights
+        | [] ->
+            return rights
         | _ :: _ as delegates ->
             let is_requested p =
-            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in
+              List.exists
-          return (List.filter is_requested rights)
+                (Signature.Public_key_hash.equal p.delegate)
-    end
+                delegates
+            in
+            return (List.filter is_requested rights))
 
-  let get ctxt
+  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) block =
-      ?(levels = []) ?(cycles = []) ?(delegates = []) block =
+    RPC_context.make_call0
-    RPC_context.make_call0 S.endorsing_rights ctxt block
+      S.endorsing_rights
+      ctxt
+      block
       {levels; cycles; delegates}
       ()
-
 end
 
 module Endorsing_power = struct
-
   let endorsing_power ctxt (operation, chain_id) =
-    let Operation_data data = operation.protocol_data in
+    let (Operation_data data) = operation.protocol_data in
     match data.contents with
-    | Single Endorsement _ ->
+    | Single (Endorsement _) ->
-        Baking.check_endorsement_rights ctxt chain_id {
+        Baking.check_endorsement_rights
-          shell = operation.shell ;
+          ctxt
-          protocol_data = data ;
+          chain_id
-        } >>=? fun (_, slots, _) ->
+          {shell = operation.shell; protocol_data = data}
-        return (List.length slots)
+        >>=? fun (_, slots, _) -> return (List.length slots)
     | _ ->
         failwith "Operation is not an endorsement"
 
@@ -552,10 +569,12 @@ module Endorsing_power = struct
     let endorsing_power =
       let open Data_encoding in
       RPC_service.post_service
-        ~description:"Get the endorsing power of an endorsement, that is, \
+        ~description:
-                      the number of slots that the endorser has"
+          "Get the endorsing power of an endorsement, that is, the number of \
+           slots that the endorser has"
         ~query:RPC_query.empty
-        ~input: (obj2
+        ~input:
+          (obj2
              (req "endorsement_operation" Operation.encoding)
              (req "chain_id" Chain_id.encoding))
         ~output:int31
@@ -564,37 +583,34 @@ module Endorsing_power = struct
 
   let register () =
     let open Services_registration in
-    register0 S.endorsing_power begin fun ctxt () (op, chain_id) ->
+    register0 S.endorsing_power (fun ctxt () (op, chain_id) ->
-      endorsing_power ctxt (op, chain_id)
+        endorsing_power ctxt (op, chain_id))
-    end
 
   let get ctxt block op chain_id =
     RPC_context.make_call0 S.endorsing_power ctxt block () (op, chain_id)
-
 end
 
 module Required_endorsements = struct
-
   let required_endorsements ctxt block_delay =
     return (Baking.minimum_allowed_endorsements ctxt ~block_delay)
 
   module S = struct
-
     type t = {block_delay : Period.t}
 
     let required_endorsements_query =
       let open RPC_query in
       query (fun block_delay -> {block_delay})
-      |+ field "block_delay" Period.rpc_arg Period.zero (fun t -> t.block_delay)
+      |+ field "block_delay" Period.rpc_arg Period.zero (fun t ->
+             t.block_delay)
       |> seal
 
     let required_endorsements =
       let open Data_encoding in
       RPC_service.get_service
-        ~description:"Minimum number of endorsements for a block to be \
+        ~description:
-                      valid, given a delay of the block's timestamp with \
+          "Minimum number of endorsements for a block to be valid, given a \
-                      respect to the minimum time to bake at the \
+           delay of the block's timestamp with respect to the minimum time to \
-                      block's priority"
+           bake at the block's priority"
         ~query:required_endorsements_query
         ~output:int31
         RPC_path.(open_root / "required_endorsements")
@@ -602,38 +618,32 @@ module Required_endorsements = struct
 
   let register () =
     let open Services_registration in
-    register0 S.required_endorsements begin fun ctxt ({ block_delay }) () ->
+    register0 S.required_endorsements (fun ctxt {block_delay} () ->
-      required_endorsements ctxt block_delay
+        required_endorsements ctxt block_delay)
-    end
 
   let get ctxt block block_delay =
     RPC_context.make_call0 S.required_endorsements ctxt block {block_delay} ()
-
 end
 
 module Minimal_valid_time = struct
-
   let minimal_valid_time ctxt ~priority ~endorsing_power =
-    Baking.minimal_valid_time ctxt
+    Baking.minimal_valid_time ctxt ~priority ~endorsing_power
-      ~priority ~endorsing_power
 
   module S = struct
-
+    type t = {priority : int; endorsing_power : int}
-    type t = { priority : int ;
-               endorsing_power : int }
 
     let minimal_valid_time_query =
       let open RPC_query in
-      query (fun priority endorsing_power ->
+      query (fun priority endorsing_power -> {priority; endorsing_power})
-          {  priority ; endorsing_power })
       |+ field "priority" RPC_arg.int 0 (fun t -> t.priority)
       |+ field "endorsing_power" RPC_arg.int 0 (fun t -> t.endorsing_power)
       |> seal
 
     let minimal_valid_time =
       RPC_service.get_service
-        ~description: "Minimal valid time for a block given a priority \
+        ~description:
-                       and an endorsing power."
+          "Minimal valid time for a block given a priority and an endorsing \
+           power."
         ~query:minimal_valid_time_query
         ~output:Time.encoding
         RPC_path.(open_root / "minimal_valid_time")
@@ -641,12 +651,16 @@ module Minimal_valid_time = struct
 
   let register () =
     let open Services_registration in
-    register0 S.minimal_valid_time begin fun ctxt { priority ; endorsing_power } () ->
+    register0 S.minimal_valid_time (fun ctxt {priority; endorsing_power} () ->
-      minimal_valid_time ctxt ~priority ~endorsing_power
+        minimal_valid_time ctxt ~priority ~endorsing_power)
-    end
 
   let get ctxt block priority endorsing_power =
-    RPC_context.make_call0 S.minimal_valid_time ctxt block { priority ; endorsing_power } ()
+    RPC_context.make_call0
+      S.minimal_valid_time
+      ctxt
+      block
+      {priority; endorsing_power}
+      ()
 end
 
 let register () =
@@ -658,17 +672,20 @@ let register () =
   Minimal_valid_time.register ()
 
 let endorsement_rights ctxt level =
-  Endorsing_rights.endorsement_slots ctxt (level, None) >>=? fun l ->
+  Endorsing_rights.endorsement_slots ctxt (level, None)
+  >>=? fun l ->
   return (List.map (fun {Endorsing_rights.delegate; _} -> delegate) l)
 
 let baking_rights ctxt max_priority =
   let max = match max_priority with None -> 64 | Some m -> m in
   let level = Level.current ctxt in
-  Baking_rights.baking_priorities ctxt max (level, None) >>=? fun l ->
+  Baking_rights.baking_priorities ctxt max (level, None)
-  return (level.level,
+  >>=? fun l ->
+  return
+    ( level.level,
       List.map
-            (fun { Baking_rights.delegate ; timestamp ; _ } ->
+        (fun {Baking_rights.delegate; timestamp; _} -> (delegate, timestamp))
-               (delegate, timestamp)) l)
+        l )
 
 let endorsing_power ctxt operation =
   Endorsing_power.endorsing_power ctxt operation

vendors/ligo-utils/tezos-protocol-alpha/delegate_services.mli

@@ -26,10 +26,12 @@
 open Alpha_context
 
 val list :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   ?active:bool ->
   ?inactive:bool ->
-  unit -> Signature.Public_key_hash.t list shell_tzresult Lwt.t
+  unit ->
+  Signature.Public_key_hash.t list shell_tzresult Lwt.t
 
 type info = {
   balance : Tez.t;
@@ -45,53 +47,60 @@ type info = {
 val info_encoding : info Data_encoding.t
 
 val info :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   info shell_tzresult Lwt.t
 
 val balance :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
 val frozen_balance :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
 val frozen_balance_by_cycle :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t
 
 val staking_balance :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
 val delegated_contracts :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Contract_repr.t list shell_tzresult Lwt.t
 
 val delegated_balance :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
 val deactivated :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   bool shell_tzresult Lwt.t
 
 val grace_period :
-  'a #RPC_context.simple -> 'a ->
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Cycle.t shell_tzresult Lwt.t
 
-
 module Baking_rights : sig
-
   type t = {
     level : Raw_level.t;
     delegate : Signature.Public_key_hash.t;
@@ -124,12 +133,11 @@ module Baking_rights : sig
     ?delegates:Signature.public_key_hash list ->
     ?all:bool ->
     ?max_priority:int ->
-    'a -> t list shell_tzresult Lwt.t
+    'a ->
-
+    t list shell_tzresult Lwt.t
 end
 
 module Endorsing_rights : sig
-
   type t = {
     level : Raw_level.t;
     delegate : Signature.Public_key_hash.t;
@@ -158,41 +166,32 @@ module Endorsing_rights : sig
     ?levels:Raw_level.t list ->
     ?cycles:Cycle.t list ->
     ?delegates:Signature.public_key_hash list ->
-    'a -> t list shell_tzresult Lwt.t
+    'a ->
-
+    t list shell_tzresult Lwt.t
 end
 
 module Endorsing_power : sig
-
   val get :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     Alpha_context.packed_operation ->
     Chain_id.t ->
     int shell_tzresult Lwt.t
-
 end
 
 module Required_endorsements : sig
-
   val get :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple -> 'a -> Period.t -> int shell_tzresult Lwt.t
-    Period.t -> int shell_tzresult Lwt.t
-
 end
 
 module Minimal_valid_time : sig
-
   val get :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple -> 'a -> int -> int -> Time.t shell_tzresult Lwt.t
-    int -> int -> Time.t shell_tzresult Lwt.t
-
 end
 
 (* temporary export for deprecated unit test *)
 val endorsement_rights :
-  Alpha_context.t ->
+  Alpha_context.t -> Level.t -> public_key_hash list tzresult Lwt.t
-  Level.t ->
-  public_key_hash list tzresult Lwt.t
 
 val baking_rights :
   Alpha_context.t ->
@@ -201,18 +200,12 @@ val baking_rights:
 
 val endorsing_power :
   Alpha_context.t ->
-  (Alpha_context.packed_operation * Chain_id.t) ->
+  Alpha_context.packed_operation * Chain_id.t ->
   int tzresult Lwt.t
 
 val required_endorsements :
-  Alpha_context.t ->
+  Alpha_context.t -> Alpha_context.Period.t -> int tzresult Lwt.t
-  Alpha_context.Period.t ->
-  int tzresult Lwt.t
 
-val minimal_valid_time:
+val minimal_valid_time : Alpha_context.t -> int -> int -> Time.t tzresult Lwt.t
-  Alpha_context.t ->
-  int ->
-  int ->
-  Time.t tzresult Lwt.t
 
 val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/delegate_storage.ml

@@ -31,16 +31,18 @@ type balance =
 
 let balance_encoding =
   let open Data_encoding in
-  def "operation_metadata.alpha.balance" @@
+  def "operation_metadata.alpha.balance"
-  union
+  @@ union
-    [ case (Tag 0)
+       [ case
+           (Tag 0)
            ~title:"Contract"
            (obj2
               (req "kind" (constant "contract"))
               (req "contract" Contract_repr.encoding))
            (function Contract c -> Some ((), c) | _ -> None)
-        (fun ((), c) -> (Contract c)) ;
+           (fun ((), c) -> Contract c);
-      case (Tag 1)
+         case
+           (Tag 1)
            ~title:"Rewards"
            (obj4
               (req "kind" (constant "freezer"))
@@ -49,7 +51,8 @@ let balance_encoding =
               (req "cycle" Cycle_repr.encoding))
            (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None)
            (fun ((), (), d, l) -> Rewards (d, l));
-      case (Tag 2)
+         case
+           (Tag 2)
            ~title:"Fees"
            (obj4
               (req "kind" (constant "freezer"))
@@ -58,7 +61,8 @@ let balance_encoding =
               (req "cycle" Cycle_repr.encoding))
            (function Fees (d, l) -> Some ((), (), d, l) | _ -> None)
            (fun ((), (), d, l) -> Fees (d, l));
-      case (Tag 3)
+         case
+           (Tag 3)
            ~title:"Deposits"
            (obj4
               (req "kind" (constant "freezer"))
@@ -68,37 +72,42 @@ let balance_encoding =
            (function Deposits (d, l) -> Some ((), (), d, l) | _ -> None)
            (fun ((), (), d, l) -> Deposits (d, l)) ]
 
-type balance_update =
+type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t
-  | Debited of Tez_repr.t
-  | Credited of Tez_repr.t
 
 let balance_update_encoding =
   let open Data_encoding in
-  def "operation_metadata.alpha.balance_update" @@
+  def "operation_metadata.alpha.balance_update"
-  obj1
+  @@ obj1
-    (req "change"
+       (req
+          "change"
           (conv
              (function
-            | Credited v -> Tez_repr.to_mutez v
+               | Credited v ->
-            | Debited v -> Int64.neg (Tez_repr.to_mutez v))
+                   Tez_repr.to_mutez v
-          (Json.wrap_error @@
+               | Debited v ->
-           fun v ->
+                   Int64.neg (Tez_repr.to_mutez v))
+             ( Json.wrap_error
+             @@ fun v ->
              if Compare.Int64.(v < 0L) then
                match Tez_repr.of_mutez (Int64.neg v) with
-             | Some v -> Debited v
+               | Some v ->
-             | None -> failwith "Qty.of_mutez"
+                   Debited v
+               | None ->
+                   failwith "Qty.of_mutez"
              else
                match Tez_repr.of_mutez v with
-             | Some v -> Credited v
+               | Some v ->
-             | None -> failwith "Qty.of_mutez")
+                   Credited v
+               | None ->
+                   failwith "Qty.of_mutez" )
              int64))
 
 type balance_updates = (balance * balance_update) list
 
 let balance_updates_encoding =
   let open Data_encoding in
-  def "operation_metadata.alpha.balance_updates" @@
+  def "operation_metadata.alpha.balance_updates"
-  list (merge_objs balance_encoding balance_update_encoding)
+  @@ list (merge_objs balance_encoding balance_update_encoding)
 
 let cleanup_balance_updates balance_updates =
   List.filter
@@ -127,10 +136,13 @@ type error +=
   | Active_delegate (* `Temporary *)
   | Current_delegate (* `Temporary *)
   | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
-  | Balance_too_low_for_deposit of
+  | Balance_too_low_for_deposit of {
-      { delegate : Signature.Public_key_hash.t ;
+      delegate : Signature.Public_key_hash.t;
       deposit : Tez_repr.t;
-        balance : Tez_repr.t } (* `Temporary *)
+      balance : Tez_repr.t;
+    }
+
+(* `Temporary *)
 
 let () =
   register_error_kind
@@ -139,8 +151,11 @@ let () =
     ~title:"Forbidden delegate deletion"
     ~description:"Tried to unregister a delegate"
     ~pp:(fun ppf delegate ->
-        Format.fprintf ppf "Delegate deletion is forbidden (%a)"
+      Format.fprintf
-          Signature.Public_key_hash.pp delegate)
+        ppf
+        "Delegate deletion is forbidden (%a)"
+        Signature.Public_key_hash.pp
+        delegate)
     Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
     (function No_deletion c -> Some c | _ -> None)
     (fun c -> No_deletion c) ;
@@ -150,8 +165,7 @@ let () =
     ~title:"Delegate already active"
     ~description:"Useless delegate reactivation"
     ~pp:(fun ppf () ->
-        Format.fprintf ppf
+      Format.fprintf ppf "The delegate is still active, no need to refresh it")
-          "The delegate is still active, no need to refresh it")
     Data_encoding.empty
     (function Active_delegate -> Some () | _ -> None)
     (fun () -> Active_delegate) ;
@@ -161,7 +175,8 @@ let () =
     ~title:"Unchanged delegated"
     ~description:"Contract already delegated to the given delegate"
     ~pp:(fun ppf () ->
-        Format.fprintf ppf
+      Format.fprintf
+        ppf
         "The contract is already delegated to the same delegate")
     Data_encoding.empty
     (function Current_delegate -> Some () | _ -> None)
@@ -170,12 +185,15 @@ let () =
     `Permanent
     ~id:"delegate.empty_delegate_account"
     ~title:"Empty delegate account"
-    ~description:"Cannot register a delegate when its implicit account is empty"
+    ~description:
+      "Cannot register a delegate when its implicit account is empty"
     ~pp:(fun ppf delegate ->
-        Format.fprintf ppf
+      Format.fprintf
-          "Delegate registration is forbidden when the delegate
+        ppf
-           implicit account is empty (%a)"
+        "Delegate registration is forbidden when the delegate\n\
-          Signature.Public_key_hash.pp delegate)
+        \           implicit account is empty (%a)"
+        Signature.Public_key_hash.pp
+        delegate)
     Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
     (function Empty_delegate_account c -> Some c | _ -> None)
     (fun c -> Empty_delegate_account c) ;
@@ -185,216 +203,249 @@ let () =
     ~title:"Balance too low for deposit"
     ~description:"Cannot freeze deposit when the balance is too low"
     ~pp:(fun ppf (delegate, balance, deposit) ->
-        Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Delegate %a has a too low balance (%a) to deposit %a"
-          Signature.Public_key_hash.pp delegate
+        Signature.Public_key_hash.pp
-          Tez_repr.pp balance
+        delegate
-          Tez_repr.pp deposit)
+        Tez_repr.pp
-    Data_encoding.
+        balance
-      (obj3
+        Tez_repr.pp
+        deposit)
+    Data_encoding.(
+      obj3
         (req "delegate" Signature.Public_key_hash.encoding)
         (req "balance" Tez_repr.encoding)
         (req "deposit" Tez_repr.encoding))
-    (function Balance_too_low_for_deposit { delegate ; balance ; deposit } ->
+    (function
-       Some (delegate, balance, deposit) | _ -> None)
+      | Balance_too_low_for_deposit {delegate; balance; deposit} ->
-    (fun (delegate, balance, deposit) -> Balance_too_low_for_deposit { delegate ; balance ; deposit } )
+          Some (delegate, balance, deposit)
+      | _ ->
+          None)
+    (fun (delegate, balance, deposit) ->
+      Balance_too_low_for_deposit {delegate; balance; deposit})
 
 let link c contract delegate =
-  Storage.Contract.Balance.get c contract >>=? fun balance ->
+  Storage.Contract.Balance.get c contract
-  Roll_storage.Delegate.add_amount c delegate balance >>=? fun c ->
+  >>=? fun balance ->
-  Storage.Contract.Delegated.add (c, Contract_repr.implicit_contract delegate) contract >>= fun c ->
+  Roll_storage.Delegate.add_amount c delegate balance
-  return c
+  >>=? fun c ->
+  Storage.Contract.Delegated.add
+    (c, Contract_repr.implicit_contract delegate)
+    contract
+  >>= fun c -> return c
 
 let unlink c contract =
-  Storage.Contract.Balance.get c contract >>=? fun balance ->
+  Storage.Contract.Balance.get c contract
-  Storage.Contract.Delegate.get_option c contract >>=? function
+  >>=? fun balance ->
-  | None -> return c
+  Storage.Contract.Delegate.get_option c contract
+  >>=? function
+  | None ->
+      return c
   | Some delegate ->
       (* Removes the balance of the contract from the delegate *)
-      Roll_storage.Delegate.remove_amount c delegate balance >>=? fun c ->
+      Roll_storage.Delegate.remove_amount c delegate balance
-      Storage.Contract.Delegated.del (c, Contract_repr.implicit_contract delegate) contract >>= fun c ->
+      >>=? fun c ->
-      return c
+      Storage.Contract.Delegated.del
+        (c, Contract_repr.implicit_contract delegate)
+        contract
+      >>= fun c -> return c
 
 let known c delegate =
   Storage.Contract.Manager.get_option
-    c (Contract_repr.implicit_contract delegate) >>=? function
+    c
-  | None | Some (Manager_repr.Hash _) -> return_false
+    (Contract_repr.implicit_contract delegate)
-  | Some (Manager_repr.Public_key _) -> return_true
+  >>=? function
+  | None | Some (Manager_repr.Hash _) ->
+      return_false
+  | Some (Manager_repr.Public_key _) ->
+      return_true
 
 (* A delegate is registered if its "implicit account" delegates to itself. *)
 let registered c delegate =
   Storage.Contract.Delegate.get_option
-    c (Contract_repr.implicit_contract delegate) >>=? function
+    c
+    (Contract_repr.implicit_contract delegate)
+  >>=? function
   | Some current_delegate ->
       return @@ Signature.Public_key_hash.equal delegate current_delegate
   | None ->
       return_false
 
 let init ctxt contract delegate =
-  known ctxt delegate >>=? fun known_delegate ->
+  known ctxt delegate
-  fail_unless
+  >>=? fun known_delegate ->
-    known_delegate
+  fail_unless known_delegate (Roll_storage.Unregistered_delegate delegate)
-    (Roll_storage.Unregistered_delegate delegate) >>=? fun () ->
+  >>=? fun () ->
-  registered ctxt delegate >>=? fun is_registered ->
+  registered ctxt delegate
-  fail_unless
+  >>=? fun is_registered ->
-    is_registered
+  fail_unless is_registered (Roll_storage.Unregistered_delegate delegate)
-    (Roll_storage.Unregistered_delegate delegate) >>=? fun () ->
+  >>=? fun () ->
-  Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt ->
+  Storage.Contract.Delegate.init ctxt contract delegate
-  link ctxt contract delegate
+  >>=? fun ctxt -> link ctxt contract delegate
 
 let get = Roll_storage.get_contract_delegate
 
 let set c contract delegate =
   match delegate with
-  | None -> begin
+  | None -> (
       let delete () =
-        unlink c contract >>=? fun c ->
+        unlink c contract
-        Storage.Contract.Delegate.remove c contract >>= fun c ->
+        >>=? fun c ->
-        return c in
+        Storage.Contract.Delegate.remove c contract >>= fun c -> return c
+      in
       match Contract_repr.is_implicit contract with
       | Some pkh ->
           (* check if contract is a registered delegate *)
-          registered c pkh >>=? fun is_registered ->
+          registered c pkh
-          if is_registered then
+          >>=? fun is_registered ->
-            fail (No_deletion pkh)
+          if is_registered then fail (No_deletion pkh) else delete ()
-          else
+      | None ->
-            delete ()
+          delete () )
-      | None -> delete ()
-    end
   | Some delegate ->
-      known c delegate >>=? fun known_delegate ->
+      known c delegate
-      registered c delegate >>=? fun registered_delegate ->
+      >>=? fun known_delegate ->
+      registered c delegate
+      >>=? fun registered_delegate ->
       let self_delegation =
-        match Contract_repr.is_implicit contract with
-        | Some pkh -> Signature.Public_key_hash.equal pkh delegate
-        | None -> false in
-      if not known_delegate || not (registered_delegate || self_delegation) then
-        fail (Roll_storage.Unregistered_delegate delegate)
-      else
-        begin
-          Storage.Contract.Delegate.get_option c contract >>=? function
-          | Some current_delegate
-            when Signature.Public_key_hash.equal delegate current_delegate ->
-              if self_delegation then
-                Roll_storage.Delegate.is_inactive c delegate >>=? function
-                | true -> return_unit
-                | false -> fail Active_delegate
-              else
-                fail Current_delegate
-          | None | Some _ -> return_unit
-        end >>=? fun () ->
-        (* check if contract is a registered delegate *)
-        begin
         match Contract_repr.is_implicit contract with
         | Some pkh ->
-              registered c pkh >>=? fun is_registered ->
+            Signature.Public_key_hash.equal pkh delegate
-              (* allow self-delegation to re-activate *)
-              if not self_delegation && is_registered then
-                fail (No_deletion pkh)
-              else
-                return_unit
         | None ->
-              return_unit
+            false
-        end >>=? fun () ->
+      in
-        Storage.Contract.Balance.mem c contract >>= fun exists ->
+      if (not known_delegate) || not (registered_delegate || self_delegation)
+      then fail (Roll_storage.Unregistered_delegate delegate)
+      else
+        Storage.Contract.Delegate.get_option c contract
+        >>=? (function
+               | Some current_delegate
+                 when Signature.Public_key_hash.equal delegate current_delegate
+                 ->
+                   if self_delegation then
+                     Roll_storage.Delegate.is_inactive c delegate
+                     >>=? function
+                     | true -> return_unit | false -> fail Active_delegate
+                   else fail Current_delegate
+               | None | Some _ ->
+                   return_unit)
+        >>=? fun () ->
+        (* check if contract is a registered delegate *)
+        ( match Contract_repr.is_implicit contract with
+        | Some pkh ->
+            registered c pkh
+            >>=? fun is_registered ->
+            (* allow self-delegation to re-activate *)
+            if (not self_delegation) && is_registered then
+              fail (No_deletion pkh)
+            else return_unit
+        | None ->
+            return_unit )
+        >>=? fun () ->
+        Storage.Contract.Balance.mem c contract
+        >>= fun exists ->
         fail_when
           (self_delegation && not exists)
-          (Empty_delegate_account delegate) >>=? fun () ->
+          (Empty_delegate_account delegate)
-        unlink c contract >>=? fun c ->
+        >>=? fun () ->
-        Storage.Contract.Delegate.init_set c contract delegate >>= fun c ->
+        unlink c contract
-        link c contract delegate >>=? fun c ->
+        >>=? fun c ->
-        begin
+        Storage.Contract.Delegate.init_set c contract delegate
-          if self_delegation then
+        >>= fun c ->
-            Storage.Delegates.add c delegate >>= fun c ->
+        link c contract delegate
-            Roll_storage.Delegate.set_active c delegate >>=? fun c ->
+        >>=? fun c ->
-            return c
+        ( if self_delegation then
-          else
+          Storage.Delegates.add c delegate
-            return c
+          >>= fun c ->
-        end >>=? fun c ->
+          Roll_storage.Delegate.set_active c delegate >>=? fun c -> return c
-        return c
+        else return c )
+        >>=? fun c -> return c
 
-let remove ctxt contract =
+let remove ctxt contract = unlink ctxt contract
-  unlink ctxt contract
 
 let delegated_contracts ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
   Storage.Contract.Delegated.elements (ctxt, contract)
 
 let get_frozen_deposit ctxt contract cycle =
-  Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle >>=? function
+  Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle
-  | None -> return Tez_repr.zero
+  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen
-  | Some frozen -> return frozen
 
 let credit_frozen_deposit ctxt delegate cycle amount =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_deposit ctxt contract cycle >>=? fun old_amount ->
+  get_frozen_deposit ctxt contract cycle
-  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->
+  >>=? fun old_amount ->
-  Storage.Contract.Frozen_deposits.init_set
+  Lwt.return Tez_repr.(old_amount +? amount)
-    (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  >>=? fun new_amount ->
-  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >>= fun ctxt ->
+  Storage.Contract.Frozen_deposits.init_set (ctxt, contract) cycle new_amount
-  return ctxt
+  >>= fun ctxt ->
+  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
+  >>= fun ctxt -> return ctxt
 
 let freeze_deposit ctxt delegate amount =
   let {Level_repr.cycle; _} = Level_storage.current ctxt in
-  Roll_storage.Delegate.set_active ctxt delegate >>=? fun ctxt ->
+  Roll_storage.Delegate.set_active ctxt delegate
+  >>=? fun ctxt ->
   let contract = Contract_repr.implicit_contract delegate in
-  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  Storage.Contract.Balance.get ctxt contract
+  >>=? fun balance ->
   Lwt.return
-    (record_trace (Balance_too_low_for_deposit { delegate; deposit = amount; balance })
+    (record_trace
-       Tez_repr.(balance -? amount)) >>=? fun new_balance ->
+       (Balance_too_low_for_deposit {delegate; deposit = amount; balance})
-  Storage.Contract.Balance.set ctxt contract new_balance >>=? fun ctxt ->
+       Tez_repr.(balance -? amount))
-  credit_frozen_deposit ctxt delegate cycle amount
+  >>=? fun new_balance ->
+  Storage.Contract.Balance.set ctxt contract new_balance
+  >>=? fun ctxt -> credit_frozen_deposit ctxt delegate cycle amount
 
 let get_frozen_fees ctxt contract cycle =
-  Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle >>=? function
+  Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle
-  | None -> return Tez_repr.zero
+  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen
-  | Some frozen -> return frozen
 
 let credit_frozen_fees ctxt delegate cycle amount =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_fees ctxt contract cycle >>=? fun old_amount ->
+  get_frozen_fees ctxt contract cycle
-  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->
+  >>=? fun old_amount ->
-  Storage.Contract.Frozen_fees.init_set
+  Lwt.return Tez_repr.(old_amount +? amount)
-    (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  >>=? fun new_amount ->
-  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >>= fun ctxt ->
+  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
-  return ctxt
+  >>= fun ctxt ->
+  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
+  >>= fun ctxt -> return ctxt
 
 let freeze_fees ctxt delegate amount =
   let {Level_repr.cycle; _} = Level_storage.current ctxt in
-  Roll_storage.Delegate.add_amount ctxt delegate amount >>=? fun ctxt ->
+  Roll_storage.Delegate.add_amount ctxt delegate amount
-  credit_frozen_fees ctxt delegate cycle amount
+  >>=? fun ctxt -> credit_frozen_fees ctxt delegate cycle amount
 
 let burn_fees ctxt delegate cycle amount =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_fees ctxt contract cycle >>=? fun old_amount ->
+  get_frozen_fees ctxt contract cycle
-  begin
+  >>=? fun old_amount ->
-    match Tez_repr.(old_amount -? amount) with
+  ( match Tez_repr.(old_amount -? amount) with
   | Ok new_amount ->
-        Roll_storage.Delegate.remove_amount
+      Roll_storage.Delegate.remove_amount ctxt delegate amount
-          ctxt delegate amount >>=? fun ctxt ->
+      >>=? fun ctxt -> return (new_amount, ctxt)
-        return (new_amount, ctxt)
   | Error _ ->
-        Roll_storage.Delegate.remove_amount
+      Roll_storage.Delegate.remove_amount ctxt delegate old_amount
-          ctxt delegate old_amount >>=? fun ctxt ->
+      >>=? fun ctxt -> return (Tez_repr.zero, ctxt) )
-        return (Tez_repr.zero, ctxt)
+  >>=? fun (new_amount, ctxt) ->
-  end >>=? fun (new_amount, ctxt) ->
+  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
-  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  >>= fun ctxt -> return ctxt
-  return ctxt
-
 
 let get_frozen_rewards ctxt contract cycle =
-  Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle >>=? function
+  Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle
-  | None -> return Tez_repr.zero
+  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen
-  | Some frozen -> return frozen
 
 let credit_frozen_rewards ctxt delegate cycle amount =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_rewards ctxt contract cycle >>=? fun old_amount ->
+  get_frozen_rewards ctxt contract cycle
-  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->
+  >>=? fun old_amount ->
-  Storage.Contract.Frozen_rewards.init_set
+  Lwt.return Tez_repr.(old_amount +? amount)
-    (ctxt, contract) cycle new_amount >>= fun ctxt ->
+  >>=? fun new_amount ->
-  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate >>= fun ctxt ->
+  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
-  return ctxt
+  >>= fun ctxt ->
+  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
+  >>= fun ctxt -> return ctxt
 
 let freeze_rewards ctxt delegate amount =
   let {Level_repr.cycle; _} = Level_storage.current ctxt in
@@ -402,175 +453,224 @@ let freeze_rewards ctxt delegate amount =
 
 let burn_rewards ctxt delegate cycle amount =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_rewards ctxt contract cycle >>=? fun old_amount ->
+  get_frozen_rewards ctxt contract cycle
+  >>=? fun old_amount ->
   let new_amount =
     match Tez_repr.(old_amount -? amount) with
-    | Error _ -> Tez_repr.zero
+    | Error _ ->
-    | Ok new_amount -> new_amount in
+        Tez_repr.zero
-  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount >>= fun ctxt ->
+    | Ok new_amount ->
-  return ctxt
+        new_amount
-
+  in
-
+  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
+  >>= fun ctxt -> return ctxt
 
 let unfreeze ctxt delegate cycle =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
+  get_frozen_deposit ctxt contract cycle
-  get_frozen_fees ctxt contract cycle >>=? fun fees ->
+  >>=? fun deposit ->
-  get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
+  get_frozen_fees ctxt contract cycle
-  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  >>=? fun fees ->
-  Lwt.return Tez_repr.(deposit +? fees) >>=? fun unfrozen_amount ->
+  get_frozen_rewards ctxt contract cycle
-  Lwt.return Tez_repr.(unfrozen_amount +? rewards) >>=? fun unfrozen_amount ->
+  >>=? fun rewards ->
-  Lwt.return Tez_repr.(balance +? unfrozen_amount) >>=? fun balance ->
+  Storage.Contract.Balance.get ctxt contract
-  Storage.Contract.Balance.set ctxt contract balance >>=? fun ctxt ->
+  >>=? fun balance ->
-  Roll_storage.Delegate.add_amount ctxt delegate rewards >>=? fun ctxt ->
+  Lwt.return Tez_repr.(deposit +? fees)
-  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle >>= fun ctxt ->
+  >>=? fun unfrozen_amount ->
-  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle >>= fun ctxt ->
+  Lwt.return Tez_repr.(unfrozen_amount +? rewards)
-  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle >>= fun ctxt ->
+  >>=? fun unfrozen_amount ->
-  return (ctxt, (cleanup_balance_updates
+  Lwt.return Tez_repr.(balance +? unfrozen_amount)
+  >>=? fun balance ->
+  Storage.Contract.Balance.set ctxt contract balance
+  >>=? fun ctxt ->
+  Roll_storage.Delegate.add_amount ctxt delegate rewards
+  >>=? fun ctxt ->
+  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
+  >>= fun ctxt ->
+  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
+  >>= fun ctxt ->
+  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
+  >>= fun ctxt ->
+  return
+    ( ctxt,
+      cleanup_balance_updates
         [ (Deposits (delegate, cycle), Debited deposit);
           (Fees (delegate, cycle), Debited fees);
           (Rewards (delegate, cycle), Debited rewards);
-                    (Contract (Contract_repr.implicit_contract delegate), Credited unfrozen_amount)]))
+          ( Contract (Contract_repr.implicit_contract delegate),
+            Credited unfrozen_amount ) ] )
 
 let cycle_end ctxt last_cycle unrevealed =
   let preserved = Constants_storage.preserved_cycles ctxt in
-  begin
+  ( match Cycle_repr.pred last_cycle with
-    match Cycle_repr.pred last_cycle with
+  | None ->
-    | None -> return (ctxt,[])
+      return (ctxt, [])
   | Some revealed_cycle ->
       List.fold_left
         (fun acc (u : Nonce_storage.unrevealed) ->
-             acc >>=? fun (ctxt, balance_updates) ->
+          acc
-             burn_fees
+          >>=? fun (ctxt, balance_updates) ->
-               ctxt u.delegate revealed_cycle u.fees >>=? fun ctxt ->
+          burn_fees ctxt u.delegate revealed_cycle u.fees
-             burn_rewards
+          >>=? fun ctxt ->
-               ctxt u.delegate revealed_cycle u.rewards >>=? fun ctxt ->
+          burn_rewards ctxt u.delegate revealed_cycle u.rewards
-             let bus = [(Fees (u.delegate, revealed_cycle), Debited u.fees);
+          >>=? fun ctxt ->
-                        (Rewards (u.delegate, revealed_cycle), Debited u.rewards)] in
+          let bus =
+            [ (Fees (u.delegate, revealed_cycle), Debited u.fees);
+              (Rewards (u.delegate, revealed_cycle), Debited u.rewards) ]
+          in
           return (ctxt, bus @ balance_updates))
-          (return (ctxt,[])) unrevealed
+        (return (ctxt, []))
-  end >>=? fun (ctxt, balance_updates) ->
+        unrevealed )
+  >>=? fun (ctxt, balance_updates) ->
   match Cycle_repr.sub last_cycle preserved with
-  | None -> return (ctxt, balance_updates, [])
+  | None ->
+      return (ctxt, balance_updates, [])
   | Some unfrozen_cycle ->
-      Storage.Delegates_with_frozen_balance.fold (ctxt, unfrozen_cycle)
+      Storage.Delegates_with_frozen_balance.fold
+        (ctxt, unfrozen_cycle)
         ~init:(Ok (ctxt, balance_updates))
         ~f:(fun delegate acc ->
-            Lwt.return acc >>=? fun (ctxt, bus) ->
+          Lwt.return acc
-            unfreeze ctxt
+          >>=? fun (ctxt, bus) ->
-              delegate unfrozen_cycle >>=? fun (ctxt, balance_updates) ->
+          unfreeze ctxt delegate unfrozen_cycle
-            return (ctxt, balance_updates @ bus)) >>=? fun (ctxt, balance_updates) ->
+          >>=? fun (ctxt, balance_updates) ->
-      Storage.Delegates_with_frozen_balance.clear (ctxt, unfrozen_cycle) >>= fun ctxt ->
+          return (ctxt, balance_updates @ bus))
-      Storage.Active_delegates_with_rolls.fold ctxt
+      >>=? fun (ctxt, balance_updates) ->
+      Storage.Delegates_with_frozen_balance.clear (ctxt, unfrozen_cycle)
+      >>= fun ctxt ->
+      Storage.Active_delegates_with_rolls.fold
+        ctxt
         ~init:(Ok (ctxt, []))
         ~f:(fun delegate acc ->
-            Lwt.return acc >>=? fun (ctxt, deactivated) ->
+          Lwt.return acc
-            Storage.Contract.Delegate_desactivation.get ctxt
+          >>=? fun (ctxt, deactivated) ->
-              (Contract_repr.implicit_contract delegate) >>=? fun cycle ->
+          Storage.Contract.Delegate_desactivation.get
+            ctxt
+            (Contract_repr.implicit_contract delegate)
+          >>=? fun cycle ->
           if Cycle_repr.(cycle <= last_cycle) then
-              Roll_storage.Delegate.set_inactive ctxt delegate >>=? fun ctxt ->
+            Roll_storage.Delegate.set_inactive ctxt delegate
-              return (ctxt, delegate :: deactivated)
+            >>=? fun ctxt -> return (ctxt, delegate :: deactivated)
-            else
+          else return (ctxt, deactivated))
-              return (ctxt, deactivated)) >>=? fun (ctxt, deactivated) ->
+      >>=? fun (ctxt, deactivated) ->
       return (ctxt, balance_updates, deactivated)
 
 let punish ctxt delegate cycle =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
+  get_frozen_deposit ctxt contract cycle
-  get_frozen_fees ctxt contract cycle >>=? fun fees ->
+  >>=? fun deposit ->
-  get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
+  get_frozen_fees ctxt contract cycle
-  Roll_storage.Delegate.remove_amount ctxt delegate deposit >>=? fun ctxt ->
+  >>=? fun fees ->
-  Roll_storage.Delegate.remove_amount ctxt delegate fees >>=? fun ctxt ->
+  get_frozen_rewards ctxt contract cycle
+  >>=? fun rewards ->
+  Roll_storage.Delegate.remove_amount ctxt delegate deposit
+  >>=? fun ctxt ->
+  Roll_storage.Delegate.remove_amount ctxt delegate fees
+  >>=? fun ctxt ->
   (* Rewards are not accounted in the delegate's rolls yet... *)
-  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle >>= fun ctxt ->
+  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
-  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle >>= fun ctxt ->
+  >>= fun ctxt ->
-  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle >>= fun ctxt ->
+  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
-  return (ctxt, { deposit ; fees ; rewards })
+  >>= fun ctxt ->
-
+  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
+  >>= fun ctxt -> return (ctxt, {deposit; fees; rewards})
 
 let has_frozen_balance ctxt delegate cycle =
   let contract = Contract_repr.implicit_contract delegate in
-  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->
+  get_frozen_deposit ctxt contract cycle
+  >>=? fun deposit ->
   if Tez_repr.(deposit <> zero) then return_true
   else
-    get_frozen_fees ctxt contract cycle >>=? fun fees ->
+    get_frozen_fees ctxt contract cycle
+    >>=? fun fees ->
     if Tez_repr.(fees <> zero) then return_true
     else
-      get_frozen_rewards ctxt contract cycle >>=? fun rewards ->
+      get_frozen_rewards ctxt contract cycle
-      return Tez_repr.(rewards <> zero)
+      >>=? fun rewards -> return Tez_repr.(rewards <> zero)
 
 let frozen_balance_by_cycle_encoding =
   let open Data_encoding in
   conv
-    (Cycle_repr.Map.bindings)
+    Cycle_repr.Map.bindings
     (List.fold_left
        (fun m (c, b) -> Cycle_repr.Map.add c b m)
        Cycle_repr.Map.empty)
-    (list (merge_objs
+    (list
+       (merge_objs
           (obj1 (req "cycle" Cycle_repr.encoding))
           frozen_balance_encoding))
 
 let empty_frozen_balance =
-  { deposit = Tez_repr.zero ;
+  {deposit = Tez_repr.zero; fees = Tez_repr.zero; rewards = Tez_repr.zero}
-    fees = Tez_repr.zero ;
-    rewards = Tez_repr.zero }
 
 let frozen_balance_by_cycle ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
   let map = Cycle_repr.Map.empty in
   Storage.Contract.Frozen_deposits.fold
-    (ctxt, contract) ~init:map
+    (ctxt, contract)
+    ~init:map
     ~f:(fun cycle amount map ->
       Lwt.return
-          (Cycle_repr.Map.add cycle
+        (Cycle_repr.Map.add
-             { empty_frozen_balance with deposit = amount } map)) >>= fun map ->
+           cycle
+           {empty_frozen_balance with deposit = amount}
+           map))
+  >>= fun map ->
   Storage.Contract.Frozen_fees.fold
-    (ctxt, contract) ~init:map
+    (ctxt, contract)
+    ~init:map
     ~f:(fun cycle amount map ->
       let balance =
         match Cycle_repr.Map.find_opt cycle map with
-          | None -> empty_frozen_balance
+        | None ->
-          | Some balance -> balance in
+            empty_frozen_balance
-        Lwt.return
+        | Some balance ->
-          (Cycle_repr.Map.add cycle
+            balance
-             { balance with fees = amount } map)) >>= fun map ->
+      in
+      Lwt.return (Cycle_repr.Map.add cycle {balance with fees = amount} map))
+  >>= fun map ->
   Storage.Contract.Frozen_rewards.fold
-    (ctxt, contract) ~init:map
+    (ctxt, contract)
+    ~init:map
     ~f:(fun cycle amount map ->
       let balance =
         match Cycle_repr.Map.find_opt cycle map with
-          | None -> empty_frozen_balance
+        | None ->
-          | Some balance -> balance in
+            empty_frozen_balance
-        Lwt.return
+        | Some balance ->
-          (Cycle_repr.Map.add cycle
+            balance
-             { balance with rewards = amount } map)) >>= fun map ->
+      in
-  Lwt.return map
+      Lwt.return (Cycle_repr.Map.add cycle {balance with rewards = amount} map))
+  >>= fun map -> Lwt.return map
 
 let frozen_balance ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
   let balance = Ok Tez_repr.zero in
   Storage.Contract.Frozen_deposits.fold
-    (ctxt, contract) ~init:balance
+    (ctxt, contract)
+    ~init:balance
     ~f:(fun _cycle amount acc ->
-        Lwt.return acc >>=? fun acc ->
+      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
-        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->
+  >>= fun balance ->
   Storage.Contract.Frozen_fees.fold
-    (ctxt, contract) ~init:balance
+    (ctxt, contract)
+    ~init:balance
     ~f:(fun _cycle amount acc ->
-        Lwt.return acc >>=? fun acc ->
+      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
-        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->
+  >>= fun balance ->
   Storage.Contract.Frozen_rewards.fold
-    (ctxt, contract) ~init:balance
+    (ctxt, contract)
+    ~init:balance
     ~f:(fun _cycle amount acc ->
-        Lwt.return acc >>=? fun acc ->
+      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
-        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->
+  >>= fun balance -> Lwt.return balance
-  Lwt.return balance
 
 let full_balance ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
-  frozen_balance ctxt delegate >>=? fun frozen_balance ->
+  frozen_balance ctxt delegate
-  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->
+  >>=? fun frozen_balance ->
-  Lwt.return Tez_repr.(frozen_balance +? balance)
+  Storage.Contract.Balance.get ctxt contract
+  >>=? fun balance -> Lwt.return Tez_repr.(frozen_balance +? balance)
 
 let deactivated = Roll_storage.Delegate.is_inactive
 
@@ -580,27 +680,34 @@ let grace_period ctxt delegate =
 
 let staking_balance ctxt delegate =
   let token_per_rolls = Constants_storage.tokens_per_roll ctxt in
-  Roll_storage.get_rolls ctxt delegate >>=? fun rolls ->
+  Roll_storage.get_rolls ctxt delegate
-  Roll_storage.get_change ctxt delegate >>=? fun change ->
+  >>=? fun rolls ->
+  Roll_storage.get_change ctxt delegate
+  >>=? fun change ->
   let rolls = Int64.of_int (List.length rolls) in
-  Lwt.return Tez_repr.(token_per_rolls *? rolls) >>=? fun balance ->
+  Lwt.return Tez_repr.(token_per_rolls *? rolls)
-  Lwt.return Tez_repr.(balance +? change)
+  >>=? fun balance -> Lwt.return Tez_repr.(balance +? change)
 
 let delegated_balance ctxt delegate =
   let contract = Contract_repr.implicit_contract delegate in
-  staking_balance ctxt delegate >>=? fun staking_balance ->
+  staking_balance ctxt delegate
-  Storage.Contract.Balance.get ctxt contract >>= fun self_staking_balance ->
+  >>=? fun staking_balance ->
+  Storage.Contract.Balance.get ctxt contract
+  >>= fun self_staking_balance ->
   Storage.Contract.Frozen_deposits.fold
-    (ctxt, contract) ~init:self_staking_balance
+    (ctxt, contract)
+    ~init:self_staking_balance
     ~f:(fun _cycle amount acc ->
-        Lwt.return acc >>=? fun acc ->
+      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
-        Lwt.return (Tez_repr.(acc +? amount))) >>= fun self_staking_balance ->
+  >>= fun self_staking_balance ->
   Storage.Contract.Frozen_fees.fold
-    (ctxt, contract) ~init:self_staking_balance
+    (ctxt, contract)
+    ~init:self_staking_balance
     ~f:(fun _cycle amount acc ->
-        Lwt.return acc >>=? fun acc ->
+      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
-        Lwt.return (Tez_repr.(acc +? amount))) >>=? fun self_staking_balance ->
+  >>=? fun self_staking_balance ->
   Lwt.return Tez_repr.(staking_balance -? self_staking_balance)
 
 let fold = Storage.Delegates.fold
+
 let list = Storage.Delegates.elements

vendors/ligo-utils/tezos-protocol-alpha/delegate_storage.mli

@@ -31,9 +31,7 @@ type balance =
   | Deposits of Signature.Public_key_hash.t * Cycle_repr.t
 
 (** A credit or debit of tezzies to a balance. *)
-type balance_update =
+type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t
-  | Debited of Tez_repr.t
-  | Credited of Tez_repr.t
 
 (** A list of balance updates. Duplicates may happen. *)
 type balance_updates = (balance * balance_update) list
@@ -51,19 +49,22 @@ type frozen_balance = {
 
 (** Allow to register a delegate when creating an account. *)
 val init :
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t ->
+  Raw_context.t ->
+  Contract_repr.t ->
+  Signature.Public_key_hash.t ->
   Raw_context.t tzresult Lwt.t
 
 (** Cleanup delegation when deleting a contract. *)
-val remove:
+val remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
-  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
 
 (** Reading the current delegate of a contract. *)
 val get :
-  Raw_context.t -> Contract_repr.t ->
+  Raw_context.t ->
+  Contract_repr.t ->
   Signature.Public_key_hash.t option tzresult Lwt.t
 
-val registered: Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
+val registered :
+  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
 (** Updating the delegate of a contract.
 
@@ -72,7 +73,9 @@ val registered: Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lw
     cannot unregister a delegate for now. The associate contract is now
     'undeletable'. *)
 val set :
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
+  Raw_context.t ->
+  Contract_repr.t ->
+  Signature.Public_key_hash.t option ->
   Raw_context.t tzresult Lwt.t
 
 type error +=
@@ -80,16 +83,20 @@ type error +=
   | Active_delegate (* `Temporary *)
   | Current_delegate (* `Temporary *)
   | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
-  | Balance_too_low_for_deposit of
+  | Balance_too_low_for_deposit of {
-      { delegate : Signature.Public_key_hash.t ;
+      delegate : Signature.Public_key_hash.t;
       deposit : Tez_repr.t;
-        balance : Tez_repr.t } (* `Temporary *)
+      balance : Tez_repr.t;
+    }
+
+(* `Temporary *)
 
 (** Iterate on all registered delegates. *)
 val fold :
   Raw_context.t ->
   init:'a ->
-  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) ->
+  'a Lwt.t
 
 (** List all registered delegates. *)
 val list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t
@@ -99,15 +106,21 @@ val list: Raw_context.t -> Signature.Public_key_hash.t list Lwt.t
     allocation. Rewards won't trigger new rolls allocation until
     unfrozen. *)
 val freeze_deposit :
-  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
 val freeze_fees :
-  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
 val freeze_rewards :
-  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
 (** Trigger the context maintenance at the end of cycle 'n', i.e.:
@@ -116,27 +129,34 @@ val freeze_rewards:
     Returns a list of account with the amount that was unfrozen for each
     and the list of deactivated delegates. *)
 val cycle_end :
-  Raw_context.t -> Cycle_repr.t -> Nonce_storage.unrevealed list ->
+  Raw_context.t ->
-  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult Lwt.t
+  Cycle_repr.t ->
+  Nonce_storage.unrevealed list ->
+  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult
+  Lwt.t
 
 (** Burn all then frozen deposit/fees/rewards for a delegate at a given
     cycle. Returns the burned amounts. *)
 val punish :
-  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Cycle_repr.t ->
   (Raw_context.t * frozen_balance) tzresult Lwt.t
 
 (** Has the given key some frozen tokens in its implicit contract? *)
 val has_frozen_balance :
-  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Cycle_repr.t ->
   bool tzresult Lwt.t
 
 (** Returns the amount of frozen deposit, fees and rewards associated
     to a given delegate. *)
 val frozen_balance :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
-  Tez_repr.t tzresult Lwt.t
 
 val frozen_balance_encoding : frozen_balance Data_encoding.t
+
 val frozen_balance_by_cycle_encoding :
   frozen_balance Cycle_repr.Map.t Data_encoding.t
 
@@ -144,33 +164,28 @@ val frozen_balance_by_cycle_encoding:
     to a given delegate, indexed by the cycle by which at the end the
     balance will be unfrozen. *)
 val frozen_balance_by_cycle :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
   frozen_balance Cycle_repr.Map.t Lwt.t
 
 (** Returns the full 'balance' of the implicit contract associated to
     a given key, i.e. the sum of the spendable balance and of the
     frozen balance. *)
 val full_balance :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
-  Tez_repr.t tzresult Lwt.t
 
 val staking_balance :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
-  Tez_repr.t tzresult Lwt.t
 
 (** Returns the list of contracts (implicit or originated) that delegated towards a given delegate *)
 val delegated_contracts :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t
-  Contract_repr.t list Lwt.t
 
 val delegated_balance :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
-  Tez_repr.t tzresult Lwt.t
 
 val deactivated :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
-  bool tzresult Lwt.t
 
 val grace_period :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t
-  Cycle_repr.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/fees_storage.ml

@@ -24,7 +24,9 @@
 (*****************************************************************************)
 
 type error += Cannot_pay_storage_fee (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
+
 type error += Storage_limit_too_high (* `Permanent *)
 
 let () =
@@ -43,8 +45,8 @@ let () =
     ~id:"storage_exhausted.operation"
     ~title:"Storage quota exceeded for the operation"
     ~description:
-      "A script or one of its callee wrote more \
+      "A script or one of its callee wrote more bytes than the operation said \
-       bytes than the operation said it would"
+       it would"
     Data_encoding.empty
     (function Operation_quota_exceeded -> Some () | _ -> None)
     (fun () -> Operation_quota_exceeded) ;
@@ -52,8 +54,7 @@ let () =
     `Permanent
     ~id:"storage_limit_too_high"
     ~title:"Storage limit out of protocol hard bounds"
-    ~description:
+    ~description:"A transaction tried to exceed the hard limit on storage"
-      "A transaction tried to exceed the hard limit on storage"
     empty
     (function Storage_limit_too_high -> Some () | _ -> None)
     (fun () -> Storage_limit_too_high)
@@ -62,50 +63,59 @@ let origination_burn c =
   let origination_size = Constants_storage.origination_size c in
   let cost_per_byte = Constants_storage.cost_per_byte c in
   (* the origination burn, measured in bytes *)
-  Lwt.return
+  Lwt.return Tez_repr.(cost_per_byte *? Int64.of_int origination_size)
-    Tez_repr.(cost_per_byte *? (Int64.of_int origination_size)) >>=? fun to_be_paid ->
+  >>=? fun to_be_paid ->
-  return (Raw_context.update_allocated_contracts_count c,
+  return (Raw_context.update_allocated_contracts_count c, to_be_paid)
-          to_be_paid)
 
 let record_paid_storage_space c contract =
-  Contract_storage.used_storage_space c contract >>=? fun size ->
+  Contract_storage.used_storage_space c contract
-  Contract_storage.set_paid_storage_space_and_return_fees_to_pay c contract size >>=? fun (to_be_paid, c) ->
+  >>=? fun size ->
+  Contract_storage.set_paid_storage_space_and_return_fees_to_pay
+    c
+    contract
+    size
+  >>=? fun (to_be_paid, c) ->
   let c = Raw_context.update_storage_space_to_pay c to_be_paid in
   let cost_per_byte = Constants_storage.cost_per_byte c in
-  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->
+  Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 to_be_paid)
-  return (c, size, to_be_paid, to_burn)
+  >>=? fun to_burn -> return (c, size, to_be_paid, to_burn)
 
 let burn_storage_fees c ~storage_limit ~payer =
   let origination_size = Constants_storage.origination_size c in
-  let c, storage_space_to_pay, allocated_contracts =
+  let (c, storage_space_to_pay, allocated_contracts) =
-    Raw_context.clear_storage_space_to_pay c in
+    Raw_context.clear_storage_space_to_pay c
+  in
   let storage_space_for_allocated_contracts =
-    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size) in
+    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size)
+  in
   let consumed =
-    Z.add storage_space_to_pay storage_space_for_allocated_contracts in
+    Z.add storage_space_to_pay storage_space_for_allocated_contracts
+  in
   let remaining = Z.sub storage_limit consumed in
-  if Compare.Z.(remaining < Z.zero) then
+  if Compare.Z.(remaining < Z.zero) then fail Operation_quota_exceeded
-    fail Operation_quota_exceeded
   else
     let cost_per_byte = Constants_storage.cost_per_byte c in
-    Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 consumed))) >>=? fun to_burn ->
+    Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 consumed)
+    >>=? fun to_burn ->
     (* Burning the fees... *)
     if Tez_repr.(to_burn = Tez_repr.zero) then
       (* If the payer was was deleted by transfering all its balance, and no space was used,
          burning zero would fail *)
       return c
     else
-      trace Cannot_pay_storage_fee
+      trace
-        (Contract_storage.must_exist c payer >>=? fun () ->
+        Cannot_pay_storage_fee
-         Contract_storage.spend c payer to_burn) >>=? fun c ->
+        ( Contract_storage.must_exist c payer
-      return c
+        >>=? fun () -> Contract_storage.spend c payer to_burn )
+      >>=? fun c -> return c
 
 let check_storage_limit c ~storage_limit =
-  if Compare.Z.(storage_limit > (Raw_context.constants c).hard_storage_limit_per_operation)
+  if
-  || Compare.Z.(storage_limit < Z.zero)then
+    Compare.Z.(
-    error Storage_limit_too_high
+      storage_limit
-  else
+      > (Raw_context.constants c).hard_storage_limit_per_operation)
-    ok ()
+    || Compare.Z.(storage_limit < Z.zero)
+  then error Storage_limit_too_high
+  else ok ()
 
-let start_counting_storage_fees c =
+let start_counting_storage_fees c = Raw_context.init_storage_space_to_pay c
-  Raw_context.init_storage_space_to_pay c

vendors/ligo-utils/tezos-protocol-alpha/fees_storage.mli

@@ -24,7 +24,9 @@
 (*****************************************************************************)
 
 type error += Cannot_pay_storage_fee (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
+
 type error += Storage_limit_too_high (* `Permanent *)
 
 (** Does not burn, only adds the burn to storage space to be paid *)
@@ -33,14 +35,16 @@ val origination_burn:
 
 (** The returned Tez quantity is for logging purpose only *)
 val record_paid_storage_space :
-  Raw_context.t -> Contract_repr.t ->
+  Raw_context.t ->
+  Contract_repr.t ->
   (Raw_context.t * Z.t * Z.t * Tez_repr.t) tzresult Lwt.t
 
-val check_storage_limit:
+val check_storage_limit : Raw_context.t -> storage_limit:Z.t -> unit tzresult
-  Raw_context.t -> storage_limit:Z.t -> unit tzresult
 
-val start_counting_storage_fees :
+val start_counting_storage_fees : Raw_context.t -> Raw_context.t
-  Raw_context.t -> Raw_context.t
 
 val burn_storage_fees :
-  Raw_context.t -> storage_limit:Z.t -> payer:Contract_repr.t -> Raw_context.t tzresult Lwt.t
+  Raw_context.t ->
+  storage_limit:Z.t ->
+  payer:Contract_repr.t ->
+  Raw_context.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/fitness_repr.ml

@@ -38,29 +38,25 @@ let () =
 
 let int64_to_bytes i =
   let b = MBytes.create 8 in
-  MBytes.set_int64 b 0 i;
+  MBytes.set_int64 b 0 i ; b
-  b
 
 let int64_of_bytes b =
-  if Compare.Int.(MBytes.length b <> 8) then
+  if Compare.Int.(MBytes.length b <> 8) then error Invalid_fitness
-    error Invalid_fitness
+  else ok (MBytes.get_int64 b 0)
-  else
-    ok (MBytes.get_int64 b 0)
 
 let from_int64 fitness =
-  [ MBytes.of_string Constants_repr.version_number ;
+  [MBytes.of_string Constants_repr.version_number; int64_to_bytes fitness]
-    int64_to_bytes fitness ]
 
 let to_int64 = function
-  | [ version ;
+  | [version; fitness]
-      fitness ]
+    when Compare.String.(
-    when Compare.String.
+           MBytes.to_string version = Constants_repr.version_number) ->
-           (MBytes.to_string version = Constants_repr.version_number) ->
       int64_of_bytes fitness
-  | [ version ;
+  | [version; _fitness (* ignored since higher version takes priority *)]
-      _fitness (* ignored since higher version takes priority *) ]
+    when Compare.String.(
-    when Compare.String.
+           MBytes.to_string version = Constants_repr.version_number_004) ->
-           (MBytes.to_string version = Constants_repr.version_number_004) ->
       ok 0L
-  | [] -> ok 0L
+  | [] ->
-  | _ -> error Invalid_fitness
+      ok 0L
+  | _ ->
+      error Invalid_fitness

vendors/ligo-utils/tezos-protocol-alpha/fitness_storage.ml

@@ -24,6 +24,7 @@
 (*****************************************************************************)
 
 let current = Raw_context.current_fitness
+
 let increase ?(gap = 1) ctxt =
   let fitness = current ctxt in
   Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness)

vendors/ligo-utils/tezos-protocol-alpha/gas_limit_repr.ml

@@ -23,29 +23,30 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type t =
+type t = Unaccounted | Limited of {remaining : Z.t}
-  | Unaccounted
-  | Limited of { remaining : Z.t }
 
 type internal_gas = Z.t
 
-type cost =
+type cost = {
-  { allocations : Z.t ;
+  allocations : Z.t;
   steps : Z.t;
   reads : Z.t;
   writes : Z.t;
   bytes_read : Z.t;
-    bytes_written : Z.t }
+  bytes_written : Z.t;
+}
 
 let encoding =
   let open Data_encoding in
   union
-    [ case (Tag 0)
+    [ case
+        (Tag 0)
         ~title:"Limited"
         z
         (function Limited {remaining} -> Some remaining | _ -> None)
         (fun remaining -> Limited {remaining});
-      case (Tag 1)
+      case
+        (Tag 1)
         ~title:"Unaccounted"
         (constant "unaccounted")
         (function Unaccounted -> Some () | _ -> None)
@@ -72,8 +73,10 @@ let cost_encoding =
        (req "bytes_read" z)
        (req "bytes_written" z))
 
-let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } =
+let pp_cost ppf {allocations; steps; reads; writes; bytes_read; bytes_written}
-  Format.fprintf ppf
+    =
+  Format.fprintf
+    ppf
     "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))"
     (Z.to_string steps)
     (Z.to_string allocations)
@@ -83,20 +86,27 @@ let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_writ
     (Z.to_string bytes_written)
 
 type error += Block_quota_exceeded (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
 
 let allocation_weight = Z.of_int 2
+
 let step_weight = Z.of_int 1
+
 let read_base_weight = Z.of_int 100
+
 let write_base_weight = Z.of_int 160
+
 let byte_read_weight = Z.of_int 10
+
 let byte_written_weight = Z.of_int 15
 
 let rescaling_bits = 7
-let rescaling_mask =
+
-  Z.sub (Z.shift_left Z.one rescaling_bits) Z.one
+let rescaling_mask = Z.sub (Z.shift_left Z.one rescaling_bits) Z.one
 
 let scale (z : Z.t) = Z.shift_left z rescaling_bits
+
 let rescale (z : Z.t) = Z.shift_right z rescaling_bits
 
 let cost_to_internal_gas (cost : cost) : internal_gas =
@@ -119,24 +129,20 @@ let internal_gas_to_gas internal_gas : Z.t * internal_gas =
 
 let consume block_gas operation_gas internal_gas cost =
   match operation_gas with
-  | Unaccounted -> ok (block_gas, Unaccounted, internal_gas)
+  | Unaccounted ->
+      ok (block_gas, Unaccounted, internal_gas)
   | Limited {remaining} ->
       let cost_internal_gas = cost_to_internal_gas cost in
-      let total_internal_gas =
+      let total_internal_gas = Z.add cost_internal_gas internal_gas in
-        Z.add cost_internal_gas internal_gas in
+      let (gas, rest) = internal_gas_to_gas total_internal_gas in
-      let gas, rest = internal_gas_to_gas total_internal_gas in
       if Compare.Z.(gas > Z.zero) then
-        let remaining =
+        let remaining = Z.sub remaining gas in
-          Z.sub remaining gas in
+        let block_remaining = Z.sub block_gas gas in
-        let block_remaining =
+        if Compare.Z.(remaining < Z.zero) then error Operation_quota_exceeded
-          Z.sub block_gas gas in
+        else if Compare.Z.(block_remaining < Z.zero) then
-        if Compare.Z.(remaining < Z.zero)
+          error Block_quota_exceeded
-        then error Operation_quota_exceeded
-        else if Compare.Z.(block_remaining < Z.zero)
-        then error Block_quota_exceeded
         else ok (block_remaining, Limited {remaining}, rest)
-      else
+      else ok (block_gas, operation_gas, total_internal_gas)
-        ok (block_gas, operation_gas, total_internal_gas)
 
 let check_enough block_gas operation_gas internal_gas cost =
   consume block_gas operation_gas internal_gas cost
@@ -145,77 +151,90 @@ let check_enough block_gas operation_gas internal_gas cost =
 let internal_gas_zero : internal_gas = Z.zero
 
 let alloc_cost n =
-  { allocations = scale (Z.of_int (n + 1)) ;
+  {
+    allocations = scale (Z.of_int (n + 1));
     steps = Z.zero;
     reads = Z.zero;
     writes = Z.zero;
     bytes_read = Z.zero;
-    bytes_written = Z.zero }
+    bytes_written = Z.zero;
+  }
 
-let alloc_bytes_cost n =
+let alloc_bytes_cost n = alloc_cost ((n + 7) / 8)
-  alloc_cost ((n + 7) / 8)
 
-let alloc_bits_cost n =
+let alloc_bits_cost n = alloc_cost ((n + 63) / 64)
-  alloc_cost ((n + 63) / 64)
 
 let atomic_step_cost n =
-  { allocations = Z.zero ;
+  {
+    allocations = Z.zero;
     steps = Z.of_int (2 * n);
     reads = Z.zero;
     writes = Z.zero;
     bytes_read = Z.zero;
-    bytes_written = Z.zero }
+    bytes_written = Z.zero;
+  }
 
 let step_cost n =
-  { allocations = Z.zero ;
+  {
+    allocations = Z.zero;
     steps = scale (Z.of_int n);
     reads = Z.zero;
     writes = Z.zero;
     bytes_read = Z.zero;
-    bytes_written = Z.zero }
+    bytes_written = Z.zero;
+  }
 
 let free =
-  { allocations = Z.zero ;
+  {
+    allocations = Z.zero;
     steps = Z.zero;
     reads = Z.zero;
     writes = Z.zero;
     bytes_read = Z.zero;
-    bytes_written = Z.zero }
+    bytes_written = Z.zero;
+  }
 
 let read_bytes_cost n =
-  { allocations = Z.zero ;
+  {
+    allocations = Z.zero;
     steps = Z.zero;
     reads = scale Z.one;
     writes = Z.zero;
     bytes_read = scale n;
-    bytes_written = Z.zero }
+    bytes_written = Z.zero;
+  }
 
 let write_bytes_cost n =
-  { allocations = Z.zero ;
+  {
+    allocations = Z.zero;
     steps = Z.zero;
     reads = Z.zero;
     writes = Z.one;
     bytes_read = Z.zero;
-    bytes_written = scale n }
+    bytes_written = scale n;
+  }
 
 let ( +@ ) x y =
-  { allocations = Z.add x.allocations y.allocations ;
+  {
+    allocations = Z.add x.allocations y.allocations;
     steps = Z.add x.steps y.steps;
     reads = Z.add x.reads y.reads;
     writes = Z.add x.writes y.writes;
     bytes_read = Z.add x.bytes_read y.bytes_read;
-    bytes_written = Z.add x.bytes_written y.bytes_written }
+    bytes_written = Z.add x.bytes_written y.bytes_written;
+  }
 
 let ( *@ ) x y =
-  { allocations = Z.mul (Z.of_int x) y.allocations ;
+  {
+    allocations = Z.mul (Z.of_int x) y.allocations;
     steps = Z.mul (Z.of_int x) y.steps;
     reads = Z.mul (Z.of_int x) y.reads;
     writes = Z.mul (Z.of_int x) y.writes;
     bytes_read = Z.mul (Z.of_int x) y.bytes_read;
-    bytes_written = Z.mul (Z.of_int x) y.bytes_written }
+    bytes_written = Z.mul (Z.of_int x) y.bytes_written;
+  }
 
-let alloc_mbytes_cost n =
+let alloc_mbytes_cost n = alloc_cost 12 +@ alloc_bytes_cost n
-  alloc_cost 12 +@ alloc_bytes_cost n
 
 let () =
   let open Data_encoding in
@@ -224,8 +243,8 @@ let () =
     ~id:"gas_exhausted.operation"
     ~title:"Gas quota exceeded for the operation"
     ~description:
-      "A script or one of its callee took more \
+      "A script or one of its callee took more time than the operation said \
-       time than the operation said it would"
+       it would"
     empty
     (function Operation_quota_exceeded -> Some () | _ -> None)
     (fun () -> Operation_quota_exceeded) ;
@@ -234,8 +253,8 @@ let () =
     ~id:"gas_exhausted.block"
     ~title:"Gas quota exceeded for the block"
     ~description:
-      "The sum of gas consumed by all the operations in the block \
+      "The sum of gas consumed by all the operations in the block exceeds the \
-       exceeds the hard gas limit per block"
+       hard gas limit per block"
     empty
     (function Block_quota_exceeded -> Some () | _ -> None)
-    (fun () -> Block_quota_exceeded) ;
+    (fun () -> Block_quota_exceeded)

vendors/ligo-utils/tezos-protocol-alpha/gas_limit_repr.mli

@@ -23,37 +23,49 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type t =
+type t = Unaccounted | Limited of {remaining : Z.t}
-  | Unaccounted
-  | Limited of { remaining : Z.t }
 
 type internal_gas
 
 val encoding : t Data_encoding.encoding
+
 val pp : Format.formatter -> t -> unit
 
 type cost
 
 val cost_encoding : cost Data_encoding.encoding
+
 val pp_cost : Format.formatter -> cost -> unit
 
 type error += Block_quota_exceeded (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
 
-val consume : Z.t -> t -> internal_gas -> cost -> (Z.t * t * internal_gas) tzresult
+val consume :
+  Z.t -> t -> internal_gas -> cost -> (Z.t * t * internal_gas) tzresult
+
 val check_enough : Z.t -> t -> internal_gas -> cost -> unit tzresult
 
 val internal_gas_zero : internal_gas
 
 val free : cost
+
 val atomic_step_cost : int -> cost
+
 val step_cost : int -> cost
+
 val alloc_cost : int -> cost
+
 val alloc_bytes_cost : int -> cost
+
 val alloc_mbytes_cost : int -> cost
+
 val alloc_bits_cost : int -> cost
+
 val read_bytes_cost : Z.t -> cost
+
 val write_bytes_cost : Z.t -> cost
 
 val ( *@ ) : int -> cost -> cost
+
 val ( +@ ) : cost -> cost -> cost

vendors/ligo-utils/tezos-protocol-alpha/helpers_services.mli

@@ -28,68 +28,98 @@ open Alpha_context
 type error += Cannot_parse_operation (* `Branch *)
 
 val current_level :
-  'a #RPC_context.simple ->
+  'a #RPC_context.simple -> ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t
-  ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t
 
 val levels_in_current_cycle :
   'a #RPC_context.simple ->
-  ?offset:int32 -> 'a -> (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t
+  ?offset:int32 ->
+  'a ->
+  (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t
 
 module Scripts : sig
-
   val run_code :
     'a #RPC_context.simple ->
-    'a -> Script.expr ->
+    'a ->
-    (Script.expr * Script.expr * Tez.t * Chain_id.t * Contract.t option * Contract.t option * Z.t option * string) ->
+    Script.expr ->
-    (Script.expr *
+    Script.expr
-     packed_internal_operation list *
+    * Script.expr
-     Contract.big_map_diff option) shell_tzresult Lwt.t
+    * Tez.t
+    * Chain_id.t
+    * Contract.t option
+    * Contract.t option
+    * Z.t option
+    * string ->
+    ( Script.expr
+    * packed_internal_operation list
+    * Contract.big_map_diff option )
+    shell_tzresult
+    Lwt.t
 
   val trace_code :
     'a #RPC_context.simple ->
-    'a -> Script.expr ->
+    'a ->
-    (Script.expr * Script.expr * Tez.t * Chain_id.t * Contract.t option * Contract.t option * Z.t option * string) ->
+    Script.expr ->
-    (Script.expr *
+    Script.expr
-     packed_internal_operation list *
+    * Script.expr
-     Script_interpreter.execution_trace *
+    * Tez.t
-     Contract.big_map_diff option) shell_tzresult Lwt.t
+    * Chain_id.t
+    * Contract.t option
+    * Contract.t option
+    * Z.t option
+    * string ->
+    ( Script.expr
+    * packed_internal_operation list
+    * Script_interpreter.execution_trace
+    * Contract.big_map_diff option )
+    shell_tzresult
+    Lwt.t
 
   val typecheck_code :
     'a #RPC_context.simple ->
-    'a -> (Script.expr * Z.t option) ->
+    'a ->
+    Script.expr * Z.t option ->
     (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t
 
   val typecheck_data :
     'a #RPC_context.simple ->
-    'a -> Script.expr * Script.expr * Z.t option -> Gas.t shell_tzresult Lwt.t
+    'a ->
+    Script.expr * Script.expr * Z.t option ->
+    Gas.t shell_tzresult Lwt.t
 
   val pack_data :
     'a #RPC_context.simple ->
-    'a -> Script.expr * Script.expr * Z.t option -> (MBytes.t * Gas.t) shell_tzresult Lwt.t
+    'a ->
+    Script.expr * Script.expr * Z.t option ->
+    (MBytes.t * Gas.t) shell_tzresult Lwt.t
 
   val run_operation :
     'a #RPC_context.simple ->
-    'a -> packed_operation * Chain_id.t ->
+    'a ->
-    (packed_protocol_data * Apply_results.packed_operation_metadata) shell_tzresult Lwt.t
+    packed_operation * Chain_id.t ->
+    (packed_protocol_data * Apply_results.packed_operation_metadata)
+    shell_tzresult
+    Lwt.t
 
   val entrypoint_type :
     'a #RPC_context.simple ->
-    'a -> Script.expr * string -> Script.expr shell_tzresult Lwt.t
+    'a ->
+    Script.expr * string ->
+    Script.expr shell_tzresult Lwt.t
 
   val list_entrypoints :
     'a #RPC_context.simple ->
-    'a -> Script.expr ->
+    'a ->
-    (Michelson_v1_primitives.prim list list *
+    Script.expr ->
-     (string * Script.expr) list) shell_tzresult Lwt.t
+    (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
-
+    shell_tzresult
+    Lwt.t
 end
 
 module Forge : sig
-
   module Manager : sig
-
     val operations :
-      'a #RPC_context.simple -> 'a ->
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
@@ -97,19 +127,23 @@ module Forge : sig
       fee:Tez.t ->
       gas_limit:Z.t ->
       storage_limit:Z.t ->
-      packed_manager_operation list -> MBytes.t shell_tzresult Lwt.t
+      packed_manager_operation list ->
+      MBytes.t shell_tzresult Lwt.t
 
     val reveal :
-      'a #RPC_context.simple -> 'a ->
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       sourcePubKey:public_key ->
       counter:counter ->
       fee:Tez.t ->
-      unit -> MBytes.t shell_tzresult Lwt.t
+      unit ->
+      MBytes.t shell_tzresult Lwt.t
 
     val transaction :
-      'a #RPC_context.simple -> 'a ->
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
@@ -121,10 +155,12 @@ module Forge : sig
       gas_limit:Z.t ->
       storage_limit:Z.t ->
       fee:Tez.t ->
-      unit -> MBytes.t shell_tzresult Lwt.t
+      unit ->
+      MBytes.t shell_tzresult Lwt.t
 
     val origination :
-      'a #RPC_context.simple -> 'a ->
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
@@ -135,10 +171,12 @@ module Forge : sig
       gas_limit:Z.t ->
       storage_limit:Z.t ->
       fee:Tez.t ->
-      unit -> MBytes.t shell_tzresult Lwt.t
+      unit ->
+      MBytes.t shell_tzresult Lwt.t
 
     val delegation :
-      'a #RPC_context.simple -> 'a ->
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
@@ -146,74 +184,88 @@ module Forge : sig
       fee:Tez.t ->
       public_key_hash option ->
       MBytes.t shell_tzresult Lwt.t
-
   end
 
   val endorsement :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     level:Raw_level.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
   val proposals :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     source:public_key_hash ->
     period:Voting_period.t ->
     proposals:Protocol_hash.t list ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
   val ballot :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     source:public_key_hash ->
     period:Voting_period.t ->
     proposal:Protocol_hash.t ->
     ballot:Vote.ballot ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
   val seed_nonce_revelation :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     level:Raw_level.t ->
     nonce:Nonce.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
   val double_baking_evidence :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     bh1:Block_header.t ->
     bh2:Block_header.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
   val double_endorsement_evidence :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     op1:Kind.endorsement operation ->
     op2:Kind.endorsement operation ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
   val protocol_data :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
+    'a ->
     priority:int ->
     ?seed_nonce_hash:Nonce_hash.t ->
     ?proof_of_work_nonce:MBytes.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
-
+    MBytes.t shell_tzresult Lwt.t
 end
 
 module Parse : sig
-
   val operations :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
-    ?check:bool -> Operation.raw list ->
+    'a ->
+    ?check:bool ->
+    Operation.raw list ->
     Operation.packed list shell_tzresult Lwt.t
 
   val block :
-    'a #RPC_context.simple -> 'a ->
+    'a #RPC_context.simple ->
-    Block_header.shell_header -> MBytes.t ->
+    'a ->
+    Block_header.shell_header ->
+    MBytes.t ->
     Block_header.protocol_data shell_tzresult Lwt.t
-
 end
 
 val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/init_storage.ml

@@ -2,7 +2,6 @@
 (*                                                                           *)
 (* Open Source License                                                       *)
 (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
-(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
 (*                                                                           *)
 (* Permission is hereby granted, free of charge, to any person obtaining a   *)
 (* copy of this software and associated documentation files (the "Software"),*)
@@ -24,355 +23,36 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(* Delegated storage changed type of value from Contract_hash to
+(* This is the genesis protocol: initialise the state *)
-   Contract_repr. Move all 'delegated' data into a storage with
-   the original type, then copy over into the new storage. *)
-let migrate_delegated ctxt contract =
-  let path = "contracts" :: (* module Contract *)
-             "index" :: (* module Indexed_context *)
-             Contract_repr.Index.to_path contract [
-               "delegated" ; (* module Delegated *)
-             ] in
-  let path_tmp = "contracts" :: (* module Contract *)
-                 "index" :: (* module Indexed_context *)
-                 Contract_repr.Index.to_path contract [
-                   "delegated_004" ; (* module Delegated *)
-                 ] in
-  Raw_context.dir_mem ctxt path >>= fun exists ->
-  if exists then
-    Raw_context.copy ctxt path path_tmp >>=? fun ctxt ->
-    Raw_context.remove_rec ctxt path >>= fun ctxt ->
-    Storage.Contract.Delegated_004.fold (ctxt, contract) ~init:(Ok ctxt) ~f:(fun delegated ctxt ->
-        Lwt.return ctxt >>=? fun ctxt ->
-        let originated = Contract_repr.originated_contract_004 delegated in
-        Storage.Contract.Delegated.add (ctxt, contract) originated >>= fun ctxt ->
-        return ctxt
-      ) >>=? fun ctxt ->
-    Raw_context.remove_rec ctxt path_tmp >>= fun ctxt ->
-    return ctxt
-  else
-    return ctxt
-
-let transform_script:
-  (manager_pkh: Signature.Public_key_hash.t ->
-   script_code: Script_repr.lazy_expr ->
-   script_storage: Script_repr.lazy_expr ->
-   (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t) ->
-  manager_pkh: Signature.Public_key_hash.t ->
-  Raw_context.t ->
-  Contract_repr.t ->
-  Script_repr.lazy_expr ->
-  Raw_context.t tzresult Lwt.t =
-  fun transformation ~manager_pkh ctxt contract code ->
-  Storage.Contract.Storage.get ctxt contract >>=? fun (_ctxt, storage) ->
-  transformation manager_pkh code storage >>=? fun (migrated_code, migrated_storage) ->
-  (* Set the migrated script code for free *)
-  Storage.Contract.Code.set_free ctxt contract migrated_code >>=? fun (ctxt, code_size_diff) ->
-  (* Set the migrated script storage for free *)
-  Storage.Contract.Storage.set_free ctxt contract migrated_storage >>=? fun (ctxt, storage_size_diff) ->
-  Storage.Contract.Used_storage_space.get ctxt contract >>=? fun used_space ->
-  let total_size = Z.(add (of_int code_size_diff) (add (of_int storage_size_diff) used_space)) in
-  (* Free storage space for migrated contracts *)
-  Storage.Contract.Used_storage_space.set ctxt contract total_size >>=? fun ctxt ->
-  Storage.Contract.Paid_storage_space.get ctxt contract >>=? fun paid_space ->
-  if Compare.Z.(paid_space < total_size) then
-    Storage.Contract.Paid_storage_space.set ctxt contract total_size >>=? fun ctxt ->
-    return ctxt
-  else
-    return ctxt
-
-let manager_script_storage: Signature.Public_key_hash.t -> Script_repr.lazy_expr =
-  fun manager_pkh ->
-  let open Micheline in
-  Script_repr.lazy_expr @@ strip_locations @@
-  (* store in optimized binary representation - as unparsed with [Optimized]. *)
-  let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding manager_pkh in
-  Bytes (0, bytes)
-
-(* If the given contract is not allocated, we'll allocate it with 1 mutez,
-   so that the migrated contracts' managers don't have to pay origination burn *)
-let allocate_contract ctxt contract =
-  Contract_storage.allocated ctxt contract >>=? function
-  | true ->
-      return ctxt
-  | false ->
-      Contract_storage.credit ctxt contract Tez_repr.one_mutez
-
-(* Process an individual contract *)
-let process_contract_add_manager contract ctxt =
-  let open Legacy_script_support_repr in
-  match Contract_repr.is_originated contract with
-  | None -> return ctxt (* Only process originated contracts *)
-  | Some _ -> begin
-      Storage.Contract.Counter.remove ctxt contract >>= fun ctxt ->
-      Storage.Contract.Spendable_004.mem ctxt contract >>= fun is_spendable ->
-      Storage.Contract.Delegatable_004.mem ctxt contract >>= fun is_delegatable ->
-      Storage.Contract.Spendable_004.del ctxt contract >>= fun ctxt ->
-      Storage.Contract.Delegatable_004.del ctxt contract >>= fun ctxt ->
-      (* Try to get script code (ignore ctxt update to discard the initialization) *)
-      Storage.Contract.Code.get_option ctxt contract >>=? fun (_ctxt, code) ->
-      (* Get the manager of the originated contract *)
-      Contract_storage.get_manager_004 ctxt contract >>=? fun manager_pkh ->
-      let manager = Contract_repr.implicit_contract manager_pkh in
-      Storage.Contract.Manager.remove ctxt contract >>= fun ctxt ->
-      match code with
-      | Some code ->
-          (*
-          | spendable | delegatable | template         |
-          |-----------+-------------+------------------|
-          | true      | true        | add_do           |
-          | true      | false       | add_do           |
-          | false     | true        | add_set_delegate |
-          | false     | false       | nothing          |
-          *)
-          if is_spendable then
-            transform_script add_do ~manager_pkh ctxt contract code >>=? fun ctxt ->
-            allocate_contract ctxt manager
-          else if is_delegatable then
-            transform_script add_set_delegate ~manager_pkh ctxt contract code >>=? fun ctxt ->
-            allocate_contract ctxt manager
-          else if has_default_entrypoint code then
-            transform_script
-              (fun ~manager_pkh:_ ~script_code  ~script_storage ->
-                 add_root_entrypoint script_code >>=? fun script_code ->
-                 return (script_code, script_storage))
-              ~manager_pkh ctxt contract code
-          else
-            return ctxt
-      | None -> begin
-          (* Initialize the script code for free *)
-          Storage.Contract.Code.init_free ctxt contract manager_script_code >>=? fun (ctxt, code_size) ->
-          let storage = manager_script_storage manager_pkh in
-          (* Initialize the script storage for free *)
-          Storage.Contract.Storage.init_free ctxt contract storage >>=? fun (ctxt, storage_size) ->
-          let total_size = Z.(add (of_int code_size) (of_int storage_size)) in
-          (* Free storage space for migrated contracts *)
-          Storage.Contract.Paid_storage_space.init_set ctxt contract total_size >>= fun ctxt ->
-          Storage.Contract.Used_storage_space.init_set ctxt contract total_size >>= fun ctxt ->
-          allocate_contract ctxt manager
-        end
-    end
-
-(* The [[update_contract_script]] function returns a copy of its
-   argument (the Micheline AST of a contract script) with "ADDRESS"
-   replaced by "ADDRESS; CHAIN_ID; PAIR".
-
-   [[Micheline.strip_locations]] should be called on the resulting
-   Micheline AST to get meaningful locations. *)
-
-let rec update_contract_script : ('l, 'p) Micheline.node -> ('l, 'p) Micheline.node
-  = function
-    | Micheline.Seq (_,
-                     Micheline.Prim (_, Michelson_v1_primitives.I_ADDRESS, [], []) ::
-                     l) ->
-        Micheline.Seq (0,
-                       Micheline.Prim (0, Michelson_v1_primitives.I_ADDRESS, [], []) ::
-                       Micheline.Prim (0, Michelson_v1_primitives.I_CHAIN_ID, [], []) ::
-                       Micheline.Prim (0, Michelson_v1_primitives.I_PAIR, [], []) :: l)
-    | Micheline.Seq (_, a :: l) ->
-        let a' = update_contract_script a in
-        let b = Micheline.Seq (0, l) in
-        let b' = update_contract_script b in
-        begin match b' with
-          | Micheline.Seq (_, l') ->
-              Micheline.Seq (0, a' :: l')
-          | _ -> assert false
-        end
-    | Micheline.Prim (_, p, l, annot) ->
-        Micheline.Prim (0, p, List.map update_contract_script l, annot)
-    | script -> script
-
-let migrate_multisig_script (ctxt : Raw_context.t) (contract : Contract_repr.t)
-    (code : Script_repr.expr) : Raw_context.t tzresult Lwt.t =
-  let migrated_code =
-    Script_repr.lazy_expr @@ Micheline.strip_locations @@
-    update_contract_script @@ Micheline.root code
-  in
-  Storage.Contract.Code.set_free ctxt contract migrated_code >>=? fun (ctxt, _code_size_diff) ->
-  (* Set the spendable and delegatable flags to false so that no entrypoint gets added by
-     the [[process_contract_add_manager]] function. *)
-  Storage.Contract.Spendable_004.set ctxt contract false >>= fun ctxt ->
-  Storage.Contract.Delegatable_004.set ctxt contract false >>= fun ctxt ->
-  return ctxt
-
-(* The hash of the multisig contract; only contracts with this exact
-   hash are going to be updated by the [[update_contract_script]]
-   function. *)
-let multisig_hash : Script_expr_hash.t =
-  Script_expr_hash.of_bytes_exn @@
-  MBytes.of_hex @@
-  `Hex "475e37a6386d0b85890eb446db1faad67f85fc814724ad07473cac8c0a124b31"
-
-let process_contract_multisig (contract : Contract_repr.t) (ctxt : Raw_context.t) =
-  Contract_storage.get_script ctxt contract >>=? fun (ctxt, script_opt) ->
-  match script_opt with
-  | None ->
-      (* Do nothing on scriptless contracts *)
-      return ctxt
-  | Some { Script_repr.code = code ; Script_repr.storage = _storage } ->
-      (* The contract has some script, only try to modify it if it has
-         the hash of the multisig contract *)
-      Lwt.return (Script_repr.force_decode code) >>=? fun (code, _gas_cost) ->
-      let bytes =
-        Data_encoding.Binary.to_bytes_exn Script_repr.expr_encoding code
-      in
-      let hash = Script_expr_hash.hash_bytes [ bytes ] in
-      if Script_expr_hash.(hash = multisig_hash) then
-        migrate_multisig_script ctxt contract code
-      else
-        return ctxt
-
-(* Process an individual contract *)
-let process_contract contract ctxt =
-  process_contract_multisig contract ctxt >>=? fun ctxt ->
-  process_contract_add_manager contract ctxt >>=? fun ctxt ->
-  return ctxt
-
-let invoice_contract ctxt kt1_addr amount =
-  let amount = Tez_repr.of_mutez_exn (Int64.(mul 1_000_000L (of_int amount))) in
-  match Contract_repr.of_b58check kt1_addr with
-  | Ok recipient -> begin
-      Contract_storage.credit ctxt recipient amount >>= function
-      | Ok ctxt -> return ctxt
-      | Error _ -> return ctxt end
-  | Error _ -> return ctxt
-
-(* Extract Big_maps from their parent contract directory,
-   recompute their used space, and assign them an ID. *)
-let migrate_contract_big_map ctxt contract =
-  Storage.Contract.Code.get_option ctxt contract >>=? function
-  | ctxt, None -> return ctxt
-  | ctxt, Some code ->
-      Storage.Contract.Storage.get ctxt contract >>=? fun (ctxt, storage) ->
-      let extract_big_map_types expr =
-        let open Michelson_v1_primitives in
-        let open Micheline in
-        match Micheline.root expr with
-        | Seq (_, [ Prim (_, K_storage, [ expr ], _) ; _ ; _ ])
-        | Seq (_, [ _ ; Prim (_, K_storage, [ expr ], _) ; _ ])
-        | Seq (_, [ _ ; _ ; Prim (_, K_storage, [ expr ], _) ]) ->
-            begin match expr with
-              | Prim (_, T_pair, [ Prim (_, T_big_map, [ kt ; vt ], _ ) ; _ ], _) -> Some (kt, vt)
-              | _ -> None
-            end
-        | _ -> None in
-      let rewrite_big_map expr id =
-        let open Michelson_v1_primitives in
-        let open Micheline in
-        match Micheline.root expr with
-        | Prim (_, D_Pair, [ Seq (_, _ (* ignore_unused_origination_literal *)) ; pannot ], sannot) ->
-            Micheline.strip_locations (Prim (0, D_Pair, [ Int (0, id) ; pannot ], sannot))
-        | _ -> assert false in
-      Lwt.return (Script_repr.force_decode code) >>=? fun (code, _) ->
-      match extract_big_map_types code with
-      | None -> return ctxt
-      | Some (kt, vt) ->
-          Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, _) ->
-          Storage.Big_map.Next.incr ctxt >>=? fun (ctxt, id) ->
-          let contract_path suffix =
-            "contracts" :: (* module Contract *)
-            "index" :: (* module Indexed_context *)
-            Contract_repr.Index.to_path contract suffix in
-          let old_path = contract_path [ "big_map" ] in
-          let storage = rewrite_big_map storage id in
-          Storage.Contract.Storage.set ctxt contract (Script_repr.lazy_expr storage) >>=? fun (ctxt, _) ->
-          let kt = Micheline.strip_locations (Script_repr.strip_annotations kt) in
-          let vt = Micheline.strip_locations (Script_repr.strip_annotations vt) in
-          Storage.Big_map.Key_type.init ctxt id kt >>=? fun ctxt ->
-          Storage.Big_map.Value_type.init ctxt id vt >>=? fun ctxt ->
-          Raw_context.dir_mem ctxt old_path >>= fun exists ->
-          if exists then
-            let read_size ctxt key =
-              Raw_context.get ctxt key >>=? fun len ->
-              match Data_encoding.(Binary.of_bytes int31) len with
-              | None -> assert false
-              | Some len -> return len in
-            let iter_sizes f (ctxt, acc) =
-              let rec dig i path (ctxt, acc) =
-                if Compare.Int.(i <= 0) then
-                  Raw_context.fold ctxt path ~init:(ok (ctxt, acc)) ~f:begin fun k acc ->
-                    Lwt.return acc >>=? fun (ctxt, acc) ->
-                    match k with
-                    | `Dir _ -> return (ctxt, acc)
-                    | `Key file ->
-                        match List.rev file with
-                        | last :: _ when Compare.String.(last = "data") ->
-                            return (ctxt, acc)
-                        | last :: _ when Compare.String.(last = "len") ->
-                            read_size ctxt file >>=? fun len ->
-                            return (ctxt, f len acc)
-                        | _ -> assert false
-                  end
-                else
-                  Raw_context.fold ctxt path ~init:(ok (ctxt, acc)) ~f:begin fun k acc ->
-                    Lwt.return acc >>=? fun (ctxt, acc) ->
-                    match k with
-                    | `Dir k -> dig (i-1) k (ctxt, acc)
-                    | `Key _ -> return (ctxt, acc)
-                  end in
-              dig Script_expr_hash.path_length old_path (ctxt, acc) in
-            iter_sizes
-              (fun s acc -> (acc |> Z.add (Z.of_int s) |> Z.add (Z.of_int 65)))
-              (ctxt, (Z.of_int 0)) >>=? fun (ctxt, total_bytes) ->
-            Storage.Big_map.Total_bytes.init ctxt id total_bytes >>=? fun ctxt ->
-            let new_path = "big_maps" :: (* module Big_map *)
-                           "index" :: (* module Indexed_context *)
-                           Storage.Big_map.Index.to_path id [
-                             "contents" ; (* module Delegated *)
-                           ] in
-            Raw_context.copy ctxt old_path new_path >>=? fun ctxt ->
-            Raw_context.remove_rec ctxt old_path >>= fun ctxt ->
-            read_size ctxt (contract_path [ "len" ; "code" ]) >>=? fun code_size ->
-            read_size ctxt (contract_path [ "len" ; "storage" ]) >>=? fun storage_size ->
-            let total_bytes =
-              total_bytes |>
-              Z.add (Z.of_int 33) |>
-              Z.add (Z.of_int code_size) |>
-              Z.add (Z.of_int storage_size) in
-            Storage.Contract.Used_storage_space.get ctxt contract >>=? fun previous_size ->
-            Storage.Contract.Paid_storage_space.get ctxt contract >>=? fun paid_bytes ->
-            let change = Z.sub paid_bytes previous_size in
-            Storage.Contract.Used_storage_space.set ctxt contract total_bytes >>=? fun ctxt ->
-            Storage.Contract.Paid_storage_space.set ctxt contract (Z.add total_bytes change)
-          else
-            Storage.Big_map.Total_bytes.init ctxt id Z.zero >>=? fun ctxt ->
-            return ctxt
-
 let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
-  Raw_context.prepare_first_block
+  Raw_context.prepare_first_block ~level ~timestamp ~fitness ctxt
-    ~level ~timestamp ~fitness ctxt >>=? fun (previous_protocol, ctxt) ->
+  >>=? fun (previous_protocol, ctxt) ->
-  Storage.Big_map.Next.init ctxt >>=? fun ctxt ->
   match previous_protocol with
   | Genesis param ->
-      Commitment_storage.init ctxt param.commitments >>=? fun ctxt ->
+      Commitment_storage.init ctxt param.commitments
-      Roll_storage.init ctxt >>=? fun ctxt ->
+      >>=? fun ctxt ->
-      Seed_storage.init ctxt >>=? fun ctxt ->
+      Roll_storage.init ctxt
-      Contract_storage.init ctxt >>=? fun ctxt ->
+      >>=? fun ctxt ->
-      Bootstrap_storage.init ctxt
+      Seed_storage.init ctxt
+      >>=? fun ctxt ->
+      Contract_storage.init ctxt
+      >>=? fun ctxt ->
+      Bootstrap_storage.init
+        ctxt
         ~typecheck
         ?ramp_up_cycles:param.security_deposit_ramp_up_cycles
         ?no_reward_cycles:param.no_reward_cycles
         param.bootstrap_accounts
-        param.bootstrap_contracts >>=? fun ctxt ->
+        param.bootstrap_contracts
-      Roll_storage.init_first_cycles ctxt >>=? fun ctxt ->
-      Vote_storage.init ctxt >>=? fun ctxt ->
-      Storage.Block_priority.init ctxt 0 >>=? fun ctxt ->
-      Vote_storage.freeze_listings ctxt >>=? fun ctxt ->
-      return ctxt
-  | Athens_004 ->
-      Storage.Vote.Current_quorum_004.get ctxt >>=? fun quorum ->
-      Storage.Vote.Participation_ema.init ctxt quorum >>=? fun ctxt ->
-      Storage.Vote.Current_quorum_004.delete ctxt >>=? fun ctxt ->
-      Storage.Block_priority.init ctxt 0 >>=? fun ctxt ->
-      Storage.Last_block_priority.delete ctxt >>=? fun ctxt ->
-      Storage.Contract.fold ctxt ~init:(Ok ctxt)
-        ~f:(fun contract ctxt ->
-            Lwt.return ctxt >>=? fun ctxt ->
-            migrate_delegated ctxt contract >>=? fun ctxt ->
-            migrate_contract_big_map ctxt contract >>=? fun ctxt ->
-            process_contract contract ctxt)
       >>=? fun ctxt ->
-      invoice_contract ctxt "KT1DUfaMfTRZZkvZAYQT5b3byXnvqoAykc43" 500 >>=? fun ctxt ->
+      Roll_storage.init_first_cycles ctxt
+      >>=? fun ctxt ->
+      Vote_storage.init ctxt
+      >>=? fun ctxt ->
+      Storage.Block_priority.init ctxt 0
+      >>=? fun ctxt ->
+      Vote_storage.freeze_listings ctxt >>=? fun ctxt -> return ctxt
+  | Babylon_005 ->
       return ctxt
 
 let prepare ctxt ~level ~predecessor_timestamp ~timestamp ~fitness =

vendors/ligo-utils/tezos-protocol-alpha/legacy_script_support_repr.mli

@@ -60,10 +60,8 @@ val add_set_delegate:
 (** Checks if a contract was declaring a default entrypoint somewhere
    else than at the root, in which case its type changes when
    entrypoints are activated. *)
-val has_default_entrypoint:
+val has_default_entrypoint : Script_repr.lazy_expr -> bool
-  Script_repr.lazy_expr -> bool
 
 (** Adds a [%root] annotation on the toplevel parameter construct. *)
 val add_root_entrypoint :
-  script_code: Script_repr.lazy_expr ->
+  script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t
-  Script_repr.lazy_expr tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/level_repr.ml

@@ -35,6 +35,7 @@ type t = {
 
 include Compare.Make (struct
   type nonrec t = t
+
   let compare {level = l1} {level = l2} = Raw_level_repr.compare l1 l2
 end)
 
@@ -43,74 +44,102 @@ type level = t
 let pp ppf {level} = Raw_level_repr.pp ppf level
 
 let pp_full ppf l =
-  Format.fprintf ppf
+  Format.fprintf
+    ppf
     "%a.%ld (cycle %a.%ld) (vote %a.%ld)"
-    Raw_level_repr.pp l.level l.level_position
+    Raw_level_repr.pp
-    Cycle_repr.pp l.cycle l.cycle_position
+    l.level
-    Voting_period_repr.pp l.voting_period l.voting_period_position
+    l.level_position
+    Cycle_repr.pp
+    l.cycle
+    l.cycle_position
+    Voting_period_repr.pp
+    l.voting_period
+    l.voting_period_position
 
 let encoding =
   let open Data_encoding in
   conv
-    (fun { level ; level_position ;
+    (fun { level;
-           cycle ; cycle_position ;
+           level_position;
-           voting_period; voting_period_position ;
+           cycle;
+           cycle_position;
+           voting_period;
+           voting_period_position;
            expected_commitment } ->
-      (level, level_position,
+      ( level,
-       cycle, cycle_position,
+        level_position,
-       voting_period, voting_period_position,
+        cycle,
+        cycle_position,
+        voting_period,
+        voting_period_position,
         expected_commitment ))
-    (fun (level, level_position,
+    (fun ( level,
-          cycle, cycle_position,
+           level_position,
-          voting_period, voting_period_position,
+           cycle,
+           cycle_position,
+           voting_period,
+           voting_period_position,
            expected_commitment ) ->
-      { level ; level_position ;
+      {
-        cycle ; cycle_position ;
+        level;
-        voting_period ; voting_period_position ;
+        level_position;
-        expected_commitment })
+        cycle;
+        cycle_position;
+        voting_period;
+        voting_period_position;
+        expected_commitment;
+      })
     (obj7
-       (req "level"
+       (req
+          "level"
           ~description:
-            "The level of the block relative to genesis. This is also \
+            "The level of the block relative to genesis. This is also the \
-             the Shell's notion of level"
+             Shell's notion of level"
           Raw_level_repr.encoding)
-       (req "level_position"
+       (req
+          "level_position"
           ~description:
             "The level of the block relative to the block that starts \
-             protocol alpha. This is specific to the protocol \
+             protocol alpha. This is specific to the protocol alpha. Other \
-             alpha. Other protocols might or might not include a \
+             protocols might or might not include a similar notion."
-             similar notion."
           int32)
-       (req "cycle"
+       (req
+          "cycle"
           ~description:
             "The current cycle's number. Note that cycles are a \
-             protocol-specific notion. As a result, the cycle number starts at 0 \
+             protocol-specific notion. As a result, the cycle number starts \
-             with the first block of protocol alpha."
+             at 0 with the first block of protocol alpha."
           Cycle_repr.encoding)
-       (req "cycle_position"
+       (req
+          "cycle_position"
           ~description:
-            "The current level of the block relative to the first \
+            "The current level of the block relative to the first block of \
-             block of the current cycle."
+             the current cycle."
           int32)
-       (req "voting_period"
+       (req
+          "voting_period"
           ~description:
             "The current voting period's index. Note that cycles are a \
-             protocol-specific notion. As a result, the voting period \
+             protocol-specific notion. As a result, the voting period index \
-             index starts at 0 with the first block of protocol alpha."
+             starts at 0 with the first block of protocol alpha."
           Voting_period_repr.encoding)
-       (req "voting_period_position"
+       (req
+          "voting_period_position"
           ~description:
-            "The current level of the block relative to the first \
+            "The current level of the block relative to the first block of \
-             block of the current voting period."
+             the current voting period."
           int32)
-       (req "expected_commitment"
+       (req
+          "expected_commitment"
           ~description:
-            "Tells wether the baker of this block has to commit a seed \
+            "Tells wether the baker of this block has to commit a seed nonce \
-             nonce hash."
+             hash."
           bool))
 
 let root first_level =
-  { level = first_level ;
+  {
+    level = first_level;
     level_position = 0l;
     cycle = Cycle_repr.root;
     cycle_position = 0l;
@@ -119,30 +148,38 @@ let root first_level =
     expected_commitment = false;
   }
 
-let from_raw
+let from_raw ~first_level ~blocks_per_cycle ~blocks_per_voting_period
-    ~first_level ~blocks_per_cycle ~blocks_per_voting_period
+    ~blocks_per_commitment level =
-    ~blocks_per_commitment
-    level =
   let raw_level = Raw_level_repr.to_int32 level in
   let first_level = Raw_level_repr.to_int32 first_level in
   let level_position =
-    Compare.Int32.max 0l (Int32.sub raw_level first_level) in
+    Compare.Int32.max 0l (Int32.sub raw_level first_level)
+  in
   let cycle =
-    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle) in
+    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle)
+  in
   let cycle_position = Int32.rem level_position blocks_per_cycle in
   let voting_period =
     Voting_period_repr.of_int32_exn
-      (Int32.div level_position blocks_per_voting_period) in
+      (Int32.div level_position blocks_per_voting_period)
+  in
   let voting_period_position =
-    Int32.rem level_position blocks_per_voting_period in
+    Int32.rem level_position blocks_per_voting_period
+  in
   let expected_commitment =
-    Compare.Int32.(Int32.rem cycle_position blocks_per_commitment =
+    Compare.Int32.(
-                   Int32.pred blocks_per_commitment) in
+      Int32.rem cycle_position blocks_per_commitment
-  { level ; level_position ;
+      = Int32.pred blocks_per_commitment)
-    cycle ; cycle_position ;
+  in
-    voting_period ; voting_period_position ;
+  {
-    expected_commitment }
+    level;
+    level_position;
+    cycle;
+    cycle_position;
+    voting_period;
+    voting_period_position;
+    expected_commitment;
+  }
 
 let diff {level = l1; _} {level = l2; _} =
   Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)
-

vendors/ligo-utils/tezos-protocol-alpha/level_repr.mli

@@ -24,18 +24,22 @@
 (*****************************************************************************)
 
 type t = private {
-  level: Raw_level_repr.t (** The level of the block relative to genesis. This
+  level : Raw_level_repr.t;
-                              is also the Shell's notion of level. *);
+      (** The level of the block relative to genesis. This
-  level_position: int32 (** The level of the block relative to the block that
+                              is also the Shell's notion of level. *)
+  level_position : int32;
+      (** The level of the block relative to the block that
                             starts protocol alpha. This is specific to the
                             protocol alpha. Other protocols might or might not
-                            include a similar notion. *);
+                            include a similar notion. *)
-  cycle: Cycle_repr.t (** The current cycle's number. Note that cycles are a
+  cycle : Cycle_repr.t;
+      (** The current cycle's number. Note that cycles are a
                           protocol-specific notion. As a result, the cycle
                           number starts at 0 with the first block of protocol
-                          alpha. *);
+                          alpha. *)
-  cycle_position: int32 (** The current level of the block relative to the first
+  cycle_position : int32;
-                            block of the current cycle. *);
+      (** The current level of the block relative to the first
+                            block of the current cycle. *)
   voting_period : Voting_period_repr.t;
   voting_period_position : int32;
   expected_commitment : bool;
@@ -47,14 +51,14 @@ type t = private {
    level_position = cycle * blocks_per_cycle + cycle_position
 *)
 
-
-
 type level = t
 
 include Compare.S with type t := level
 
 val encoding : level Data_encoding.t
+
 val pp : Format.formatter -> level -> unit
+
 val pp_full : Format.formatter -> level -> unit
 
 val root : Raw_level_repr.t -> level
@@ -64,6 +68,7 @@ val from_raw:
   blocks_per_cycle:int32 ->
   blocks_per_voting_period:int32 ->
   blocks_per_commitment:int32 ->
-  Raw_level_repr.t -> level
+  Raw_level_repr.t ->
+  level
 
 val diff : level -> level -> int32

vendors/ligo-utils/tezos-protocol-alpha/level_storage.ml

@@ -28,8 +28,11 @@ open Level_repr
 let from_raw c ?offset l =
   let l =
     match offset with
-    | None -> l
+    | None ->
-    | Some o -> Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o)) in
+        l
+    | Some o ->
+        Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o))
+  in
   let constants = Raw_context.constants c in
   let first_level = Raw_context.first_level c in
   Level_repr.from_raw
@@ -39,27 +42,32 @@ let from_raw c ?offset l =
     ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
     l
 
-let root c =
+let root c = Level_repr.root (Raw_context.first_level c)
-  Level_repr.root (Raw_context.first_level c)
 
 let succ c l = from_raw c (Raw_level_repr.succ l.level)
+
 let pred c l =
   match Raw_level_repr.pred l.Level_repr.level with
-  | None -> None
+  | None ->
-  | Some l -> Some (from_raw c l)
+      None
+  | Some l ->
+      Some (from_raw c l)
 
 let current ctxt = Raw_context.current_level ctxt
 
 let previous ctxt =
   let l = current ctxt in
   match pred ctxt l with
-  | None -> assert false (* We never validate the Genesis... *)
+  | None ->
-  | Some p -> p
+      assert false (* We never validate the Genesis... *)
+  | Some p ->
+      p
 
 let first_level_in_cycle ctxt c =
   let constants = Raw_context.constants ctxt in
   let first_level = Raw_context.first_level ctxt in
-  from_raw ctxt
+  from_raw
+    ctxt
     (Raw_level_repr.of_int32_exn
        (Int32.add
           (Raw_level_repr.to_int32 first_level)
@@ -69,14 +77,15 @@ let first_level_in_cycle ctxt c =
 
 let last_level_in_cycle ctxt c =
   match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with
-  | None -> assert false
+  | None ->
-  | Some x -> x
+      assert false
+  | Some x ->
+      x
 
 let levels_in_cycle ctxt cycle =
   let first = first_level_in_cycle ctxt cycle in
   let rec loop n acc =
-    if Cycle_repr.(n.cycle = first.cycle)
+    if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc)
-    then loop (succ ctxt n) (n :: acc)
     else acc
   in
   loop first []
@@ -84,8 +93,7 @@ let levels_in_cycle ctxt cycle =
 let levels_in_current_cycle ctxt ?(offset = 0l) () =
   let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in
   let cycle = Int32.add current_cycle offset in
-  if Compare.Int32.(cycle < 0l) then
+  if Compare.Int32.(cycle < 0l) then []
-    []
   else
     let cycle = Cycle_repr.of_int32_exn cycle in
     levels_in_cycle ctxt cycle
@@ -93,20 +101,18 @@ 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 acc =
-    if Cycle_repr.(n.cycle = first.cycle)
+    if Cycle_repr.(n.cycle = first.cycle) then
-    then
+      if n.expected_commitment then loop (succ ctxt n) (n :: acc)
-      if n.expected_commitment then
+      else loop (succ ctxt n) acc
-        loop (succ ctxt n) (n :: acc)
-      else
-        loop (succ ctxt n) acc
     else acc
   in
   loop first []
 
-
 let last_allowed_fork_level c =
   let level = Raw_context.current_level c in
   let preserved_cycles = Constants_storage.preserved_cycles c in
   match Cycle_repr.sub level.cycle preserved_cycles with
-  | None -> Raw_level_repr.root
+  | None ->
-  | Some cycle -> (first_level_in_cycle c cycle).level
+      Raw_level_repr.root
+  | Some cycle ->
+      (first_level_in_cycle c cycle).level

vendors/ligo-utils/tezos-protocol-alpha/level_storage.mli

@@ -24,17 +24,24 @@
 (*****************************************************************************)
 
 val current : Raw_context.t -> Level_repr.t
+
 val previous : Raw_context.t -> Level_repr.t
 
 val root : Raw_context.t -> Level_repr.t
 
-val from_raw: Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t
+val from_raw :
+  Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t
+
 val pred : Raw_context.t -> Level_repr.t -> Level_repr.t option
+
 val succ : Raw_context.t -> Level_repr.t -> Level_repr.t
 
 val first_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t
+
 val last_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t
+
 val levels_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t list
+
 val levels_in_current_cycle :
   Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list
 

vendors/ligo-utils/tezos-protocol-alpha/main.ml

@@ -26,25 +26,33 @@
 (* Tezos Protocol Implementation - Protocol Signature Instance *)
 
 type block_header_data = Alpha_context.Block_header.protocol_data
+
 type block_header = Alpha_context.Block_header.t = {
   shell : Block_header.shell_header;
   protocol_data : block_header_data;
 }
 
-let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding
+let block_header_data_encoding =
+  Alpha_context.Block_header.protocol_data_encoding
 
 type block_header_metadata = Apply_results.block_metadata
+
 let block_header_metadata_encoding = Apply_results.block_metadata_encoding
 
 type operation_data = Alpha_context.packed_protocol_data =
-  | Operation_data : 'kind Alpha_context.Operation.protocol_data -> operation_data
+  | Operation_data :
+      'kind Alpha_context.Operation.protocol_data
+      -> operation_data
+
 let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
 
 type operation_receipt = Apply_results.packed_operation_metadata =
-  | Operation_metadata : 'kind Apply_results.operation_metadata -> operation_receipt
+  | Operation_metadata :
+      'kind Apply_results.operation_metadata
+      -> operation_receipt
   | No_operation_metadata : operation_receipt
-let operation_receipt_encoding =
+
-  Apply_results.operation_metadata_encoding
+let operation_receipt_encoding = Apply_results.operation_metadata_encoding
 
 let operation_data_and_receipt_encoding =
   Apply_results.operation_data_and_metadata_encoding
@@ -56,21 +64,28 @@ type operation = Alpha_context.packed_operation = {
 
 let acceptable_passes = Alpha_context.Operation.acceptable_passes
 
-let max_block_length =
+let max_block_length = Alpha_context.Block_header.max_header_length
-  Alpha_context.Block_header.max_header_length
 
 let max_operation_data_length =
   Alpha_context.Constants.max_operation_data_length
 
 let validation_passes =
   let max_anonymous_operations =
-    Alpha_context.Constants.max_revelations_per_block +
+    Alpha_context.Constants.max_revelations_per_block
-    (* allow 100 wallet activations or denunciations per block *) 100 in
+    + (* allow 100 wallet activations or denunciations per block *) 100
-  Updater.[ { max_size = 32 * 1024 ; max_op = Some 32 } ; (* 32 endorsements *)
+  in
-            { max_size = 32 * 1024 ; max_op = None } ; (* 32k of voting operations *)
+  Updater.
-            { max_size = max_anonymous_operations * 1024 ;
+    [ {max_size = 32 * 1024; max_op = Some 32};
-              max_op = Some max_anonymous_operations } ;
+      (* 32 endorsements *)
-            { max_size = 512 * 1024 ; max_op = None } ] (* 512kB *)
+      {max_size = 32 * 1024; max_op = None};
+      (* 32k of voting operations *)
+      {
+        max_size = max_anonymous_operations * 1024;
+        max_op = Some max_anonymous_operations;
+      };
+      {max_size = 512 * 1024; max_op = None} ]
+
+(* 512kB *)
 
 let rpc_services =
   Alpha_services.register () ;
@@ -87,9 +102,7 @@ type validation_mode =
       baker : Alpha_context.public_key_hash;
       block_delay : Alpha_context.Period.t;
     }
-  | Partial_construction of {
+  | Partial_construction of {predecessor : Block_hash.t}
-      predecessor : Block_hash.t ;
-    }
   | Full_construction of {
       predecessor : Block_hash.t;
       protocol_data : Alpha_context.Block_header.contents;
@@ -97,85 +110,80 @@ type validation_mode =
       block_delay : Alpha_context.Period.t;
     }
 
-type validation_state =
+type validation_state = {
-  { mode : validation_mode ;
+  mode : validation_mode;
   chain_id : Chain_id.t;
   ctxt : Alpha_context.t;
   op_count : int;
 }
 
-let current_context { ctxt ; _ } =
+let current_context {ctxt; _} = return (Alpha_context.finalize ctxt).context
-  return (Alpha_context.finalize ctxt).context
 
-let begin_partial_application
+let begin_partial_application ~chain_id ~ancestor_context:ctxt
-    ~chain_id
+    ~predecessor_timestamp ~predecessor_fitness
-    ~ancestor_context:ctxt
-    ~predecessor_timestamp
-    ~predecessor_fitness
     (block_header : Alpha_context.Block_header.t) =
   let level = block_header.shell.level in
   let fitness = predecessor_fitness in
   let timestamp = block_header.shell.timestamp in
-  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
-  Apply.begin_application
+  >>=? fun ctxt ->
-    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) ->
+  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
+  >>=? fun (ctxt, baker, block_delay) ->
   let mode =
     Partial_application
-      { block_header ; baker = Signature.Public_key.hash baker ; block_delay } in
+      {block_header; baker = Signature.Public_key.hash baker; block_delay}
+  in
   return {mode; chain_id; ctxt; op_count = 0}
 
-let begin_application
+let begin_application ~chain_id ~predecessor_context:ctxt
-    ~chain_id
+    ~predecessor_timestamp ~predecessor_fitness
-    ~predecessor_context:ctxt
-    ~predecessor_timestamp
-    ~predecessor_fitness
     (block_header : Alpha_context.Block_header.t) =
   let level = block_header.shell.level in
   let fitness = predecessor_fitness in
   let timestamp = block_header.shell.timestamp in
-  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
-  Apply.begin_application
+  >>=? fun ctxt ->
-    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) ->
+  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
+  >>=? fun (ctxt, baker, block_delay) ->
   let mode =
-    Application { block_header ; baker = Signature.Public_key.hash baker ; block_delay } in
+    Application
+      {block_header; baker = Signature.Public_key.hash baker; block_delay}
+  in
   return {mode; chain_id; ctxt; op_count = 0}
 
-let begin_construction
+let begin_construction ~chain_id ~predecessor_context:ctxt
-    ~chain_id
+    ~predecessor_timestamp ~predecessor_level:pred_level
-    ~predecessor_context:ctxt
+    ~predecessor_fitness:pred_fitness ~predecessor ~timestamp
-    ~predecessor_timestamp
+    ?(protocol_data : block_header_data option) () =
-    ~predecessor_level:pred_level
-    ~predecessor_fitness:pred_fitness
-    ~predecessor
-    ~timestamp
-    ?(protocol_data : block_header_data option)
-    () =
   let level = Int32.succ pred_level in
   let fitness = pred_fitness in
-  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
-  begin
+  >>=? fun ctxt ->
-    match protocol_data with
+  ( match protocol_data with
   | None ->
-        Apply.begin_partial_construction ctxt >>=? fun ctxt ->
+      Apply.begin_partial_construction ctxt
+      >>=? fun ctxt ->
       let mode = Partial_construction {predecessor} in
       return (mode, ctxt)
   | Some proto_header ->
       Apply.begin_full_construction
-          ctxt predecessor_timestamp
+        ctxt
-          proto_header.contents >>=? fun (ctxt, protocol_data, baker, block_delay) ->
+        predecessor_timestamp
+        proto_header.contents
+      >>=? fun (ctxt, protocol_data, baker, block_delay) ->
       let mode =
         let baker = Signature.Public_key.hash baker in
-          Full_construction { predecessor ; baker ; protocol_data ; block_delay } in
+        Full_construction {predecessor; baker; protocol_data; block_delay}
-        return (mode, ctxt)
+      in
-  end >>=? fun (mode, ctxt) ->
+      return (mode, ctxt) )
-  return { mode ; chain_id ; ctxt ; op_count = 0 }
+  >>=? fun (mode, ctxt) -> return {mode; chain_id; ctxt; op_count = 0}
 
-let apply_operation
+let apply_operation ({mode; chain_id; ctxt; op_count; _} as data)
-    ({ mode ; chain_id ; ctxt ; op_count ; _ } as data)
     (operation : Alpha_context.packed_operation) =
   match mode with
-  | Partial_application _ when
+  | Partial_application _
-      not (List.exists
+    when not
+           (List.exists
               (Compare.Int.equal 0)
               (Alpha_context.Operation.acceptable_passes operation)) ->
       (* Multipass validation only considers operations in pass 0. *)
@@ -184,20 +192,25 @@ let apply_operation
   | _ ->
       let {shell; protocol_data = Operation_data protocol_data} = operation in
       let operation : _ Alpha_context.operation = {shell; protocol_data} in
-      let predecessor, baker =
+      let (predecessor, baker) =
         match mode with
         | Partial_application
             {block_header = {shell = {predecessor; _}; _}; baker}
-        | Application
+        | Application {block_header = {shell = {predecessor; _}; _}; baker}
-            { block_header = { shell = { predecessor ; _ } ; _ } ; baker }
+        | Full_construction {predecessor; baker; _} ->
-        | Full_construction { predecessor ; baker ; _ }
+            (predecessor, baker)
-          -> predecessor, baker
+        | Partial_construction {predecessor} ->
-        | Partial_construction { predecessor }
+            (predecessor, Signature.Public_key_hash.zero)
-          -> predecessor, Signature.Public_key_hash.zero
       in
-      Apply.apply_operation ctxt chain_id Optimized predecessor baker
+      Apply.apply_operation
+        ctxt
+        chain_id
+        Optimized
+        predecessor
+        baker
         (Alpha_context.Operation.hash operation)
-        operation >>=? fun (ctxt, result) ->
+        operation
+      >>=? fun (ctxt, result) ->
       let op_count = op_count + 1 in
       return ({data with ctxt; op_count}, Operation_metadata result)
 
@@ -205,41 +218,61 @@ let finalize_block { mode ; ctxt ; op_count } =
   match mode with
   | Partial_construction _ ->
       let level = Alpha_context.Level.current ctxt in
-      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+      Alpha_context.Vote.get_current_period_kind ctxt
+      >>=? fun voting_period_kind ->
       let baker = Signature.Public_key_hash.zero in
       Signature.Public_key_hash.Map.fold
         (fun delegate deposit ctxt ->
-           ctxt >>=? fun ctxt ->
+          ctxt
+          >>=? fun ctxt ->
           Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
         (Alpha_context.get_deposits ctxt)
-        (return ctxt) >>=? fun ctxt ->
+        (return ctxt)
+      >>=? fun ctxt ->
       let ctxt = Alpha_context.finalize ctxt in
-      return (ctxt, Apply_results.{ baker ;
+      return
+        ( ctxt,
+          Apply_results.
+            {
+              baker;
               level;
               voting_period_kind;
               nonce_hash = None;
               consumed_gas = Z.zero;
               deactivated = [];
-                                    balance_updates = []})
+              balance_updates = [];
+            } )
   | Partial_application {block_header; baker; block_delay} ->
       let level = Alpha_context.Level.current ctxt in
       let included_endorsements = Alpha_context.included_endorsements ctxt in
-      Apply.check_minimum_endorsements ctxt
+      Apply.check_minimum_endorsements
+        ctxt
         block_header.protocol_data.contents
-        block_delay included_endorsements >>=? fun () ->
+        block_delay
-      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+        included_endorsements
+      >>=? fun () ->
+      Alpha_context.Vote.get_current_period_kind ctxt
+      >>=? fun voting_period_kind ->
       let ctxt = Alpha_context.finalize ctxt in
-      return (ctxt, Apply_results.{ baker ;
+      return
+        ( ctxt,
+          Apply_results.
+            {
+              baker;
               level;
               voting_period_kind;
               nonce_hash = None;
               consumed_gas = Z.zero;
               deactivated = [];
-                                    balance_updates = []})
+              balance_updates = [];
+            } )
   | Application
-      { baker ; block_delay ; block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
+      { baker;
+        block_delay;
+        block_header = {protocol_data = {contents = protocol_data; _}; _} }
   | Full_construction {protocol_data; baker; block_delay; _} ->
-      Apply.finalize_application ctxt protocol_data baker ~block_delay >>=? fun (ctxt, receipt) ->
+      Apply.finalize_application ctxt protocol_data baker ~block_delay
+      >>=? fun (ctxt, receipt) ->
       let level = Alpha_context.Level.current ctxt in
       let priority = protocol_data.priority in
       let raw_level = Alpha_context.Raw_level.to_int32 level.level in
@@ -247,69 +280,101 @@ let finalize_block { mode ; ctxt ; op_count } =
       let commit_message =
         Format.asprintf
           "lvl %ld, fit 1:%Ld, prio %d, %d ops"
-          raw_level fitness priority op_count in
+          raw_level
+          fitness
+          priority
+          op_count
+      in
       let ctxt = Alpha_context.finalize ~commit_message ctxt in
       return (ctxt, receipt)
 
 let compare_operations op1 op2 =
   let open Alpha_context in
-  let Operation_data op1 = op1.protocol_data in
+  let (Operation_data op1) = op1.protocol_data in
-  let Operation_data op2 = op2.protocol_data in
+  let (Operation_data op2) = op2.protocol_data in
-  match op1.contents, op2.contents with
+  match (op1.contents, op2.contents) with
-  | Single (Endorsement _), Single (Endorsement _) -> 0
+  | (Single (Endorsement _), Single (Endorsement _)) ->
-  | _, Single (Endorsement _) -> 1
+      0
-  | Single (Endorsement _), _ -> -1
+  | (_, Single (Endorsement _)) ->
-
+      1
-  | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
+  | (Single (Endorsement _), _) ->
-  | _, Single (Seed_nonce_revelation _) -> 1
+      -1
-  | Single (Seed_nonce_revelation _), _ -> -1
+  | (Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _)) ->
-
+      0
-  | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0
+  | (_, Single (Seed_nonce_revelation _)) ->
-  | _, Single (Double_endorsement_evidence _) -> 1
+      1
-  | Single (Double_endorsement_evidence _), _ -> -1
+  | (Single (Seed_nonce_revelation _), _) ->
-
+      -1
-  | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0
+  | ( Single (Double_endorsement_evidence _),
-  | _, Single (Double_baking_evidence _) -> 1
+      Single (Double_endorsement_evidence _) ) ->
-  | Single (Double_baking_evidence _), _ -> -1
+      0
-
+  | (_, Single (Double_endorsement_evidence _)) ->
-  | Single (Activate_account _), Single (Activate_account _) -> 0
+      1
-  | _, Single (Activate_account _) -> 1
+  | (Single (Double_endorsement_evidence _), _) ->
-  | Single (Activate_account _), _ -> -1
+      -1
-
+  | (Single (Double_baking_evidence _), Single (Double_baking_evidence _)) ->
-  | Single (Proposals _), Single (Proposals _) -> 0
+      0
-  | _, Single (Proposals _) -> 1
+  | (_, Single (Double_baking_evidence _)) ->
-  | Single (Proposals _), _ -> -1
+      1
-
+  | (Single (Double_baking_evidence _), _) ->
-  | Single (Ballot _), Single (Ballot _) -> 0
+      -1
-  | _, Single (Ballot _) -> 1
+  | (Single (Activate_account _), Single (Activate_account _)) ->
-  | Single (Ballot _), _ -> -1
+      0
-
+  | (_, Single (Activate_account _)) ->
+      1
+  | (Single (Activate_account _), _) ->
+      -1
+  | (Single (Proposals _), Single (Proposals _)) ->
+      0
+  | (_, Single (Proposals _)) ->
+      1
+  | (Single (Proposals _), _) ->
+      -1
+  | (Single (Ballot _), Single (Ballot _)) ->
+      0
+  | (_, Single (Ballot _)) ->
+      1
+  | (Single (Ballot _), _) ->
+      -1
   (* Manager operations with smaller counter are pre-validated first. *)
-  | Single (Manager_operation op1), Single (Manager_operation op2) ->
+  | (Single (Manager_operation op1), Single (Manager_operation op2)) ->
       Z.compare op1.counter op2.counter
-  | Cons (Manager_operation op1, _), Single (Manager_operation op2) ->
+  | (Cons (Manager_operation op1, _), Single (Manager_operation op2)) ->
       Z.compare op1.counter op2.counter
-  | Single (Manager_operation op1), Cons (Manager_operation op2, _) ->
+  | (Single (Manager_operation op1), Cons (Manager_operation op2, _)) ->
       Z.compare op1.counter op2.counter
-  | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) ->
+  | (Cons (Manager_operation op1, _), Cons (Manager_operation op2, _)) ->
       Z.compare op1.counter op2.counter
 
 let init ctxt block_header =
   let level = block_header.Block_header.level in
   let fitness = block_header.fitness in
   let timestamp = block_header.timestamp in
-  let typecheck (ctxt:Alpha_context.context) (script:Alpha_context.Script.t) =
+  let typecheck (ctxt : Alpha_context.context)
-    Script_ir_translator.parse_script ctxt ~legacy:false script >>=? fun (Ex_script parsed_script, ctxt) ->
+      (script : Alpha_context.Script.t) =
-    Script_ir_translator.extract_big_map_diff ctxt Optimized parsed_script.storage_type parsed_script.storage
+    Script_ir_translator.parse_script ctxt ~legacy:false script
+    >>=? fun (Ex_script parsed_script, ctxt) ->
+    Script_ir_translator.extract_big_map_diff
+      ctxt
+      Optimized
+      parsed_script.storage_type
+      parsed_script.storage
       ~to_duplicate:Script_ir_translator.no_big_map_id
       ~to_update:Script_ir_translator.no_big_map_id
-      ~temporary:false >>=? fun (storage, big_map_diff, ctxt) ->
+      ~temporary:false
-    Script_ir_translator.unparse_data ctxt Optimized parsed_script.storage_type storage >>=? fun (storage, ctxt) ->
+    >>=? fun (storage, big_map_diff, ctxt) ->
-    let storage = Alpha_context.Script.lazy_expr (Micheline.strip_locations storage) in
+    Script_ir_translator.unparse_data
+      ctxt
+      Optimized
+      parsed_script.storage_type
+      storage
+    >>=? fun (storage, ctxt) ->
+    let storage =
+      Alpha_context.Script.lazy_expr (Micheline.strip_locations storage)
+    in
     return (({script with storage}, big_map_diff), ctxt)
   in
-  Alpha_context.prepare_first_block
+  Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ~fitness ctxt
-    ~typecheck
+  >>=? fun ctxt -> return (Alpha_context.finalize ctxt)
-    ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
+
-  return (Alpha_context.finalize ctxt)
+(* Vanity nonce: 0050006865723388 *)
-(* Vanity nonce: 415767323 *)

vendors/ligo-utils/tezos-protocol-alpha/main.mli

@@ -36,9 +36,7 @@ type validation_mode =
       baker : Alpha_context.public_key_hash;
       block_delay : Alpha_context.Period.t;
     }
-  | Partial_construction of {
+  | Partial_construction of {predecessor : Block_hash.t}
-      predecessor : Block_hash.t ;
-    }
   | Full_construction of {
       predecessor : Block_hash.t;
       protocol_data : Alpha_context.Block_header.contents;
@@ -46,8 +44,8 @@ type validation_mode =
       block_delay : Alpha_context.Period.t;
     }
 
-type validation_state =
+type validation_state = {
-  { mode : validation_mode ;
+  mode : validation_mode;
   chain_id : Chain_id.t;
   ctxt : Alpha_context.t;
   op_count : int;
@@ -60,7 +58,8 @@ type operation = Alpha_context.packed_operation = {
   protocol_data : operation_data;
 }
 
-include Updater.PROTOCOL
+include
+  Updater.PROTOCOL
     with type block_header_data = Alpha_context.Block_header.protocol_data
      and type block_header_metadata = Apply_results.block_metadata
      and type block_header = Alpha_context.Block_header.t

vendors/ligo-utils/tezos-protocol-alpha/manager_repr.ml

@@ -34,27 +34,19 @@ type t = manager_key
 open Data_encoding
 
 let hash_case tag =
-  case tag
+  case
+    tag
     ~title:"Public_key_hash"
     Signature.Public_key_hash.encoding
-    (function
+    (function Hash hash -> Some hash | _ -> None)
-      | Hash hash -> Some hash
-      | _ -> None)
     (fun hash -> Hash hash)
 
 let pubkey_case tag =
-  case tag
+  case
+    tag
     ~title:"Public_key"
     Signature.Public_key.encoding
-    (function
+    (function Public_key hash -> Some hash | _ -> None)
-      | Public_key hash -> Some hash
-      | _ -> None)
     (fun hash -> Public_key hash)
 
-
+let encoding = union [hash_case (Tag 0); pubkey_case (Tag 1)]
-let encoding =
-  union [
-    hash_case (Tag 0) ;
-    pubkey_case (Tag 1) ;
-  ]
-

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_gas.ml

@@ -27,93 +27,108 @@ open Alpha_context
 open Gas
 
 module Cost_of = struct
-
   let log2 =
-    let rec help acc = function
+    let rec help acc = function 0 -> acc | n -> help (acc + 1) (n / 2) in
-      | 0 -> acc
+    help 1
-      | n -> help (acc + 1) (n / 2)
-    in help 1
 
   let z_bytes (z : Z.t) =
     let bits = Z.numbits z in
     (7 + bits) / 8
 
-  let int_bytes (z : 'a Script_int.num) =
+  let int_bytes (z : 'a Script_int.num) = z_bytes (Script_int.to_zint z)
-    z_bytes (Script_int.to_zint z)
 
   let timestamp_bytes (t : Script_timestamp.t) =
     let z = Script_timestamp.to_zint t in
     z_bytes z
 
   (* For now, returns size in bytes, but this could get more complicated... *)
-  let rec size_of_comparable : type a b. (a, b) Script_typed_ir.comparable_struct -> a -> int =
+  let rec size_of_comparable :
+      type a b. (a, b) Script_typed_ir.comparable_struct -> a -> int =
    fun wit v ->
     match wit with
-      | Int_key _ -> int_bytes v
+    | Int_key _ ->
-      | Nat_key _ -> int_bytes v
+        int_bytes v
-      | String_key _ -> String.length v
+    | Nat_key _ ->
-      | Bytes_key _ -> MBytes.length v
+        int_bytes v
-      | Bool_key _ -> 8
+    | String_key _ ->
-      | Key_hash_key _ -> Signature.Public_key_hash.size
+        String.length v
-      | Timestamp_key _ -> timestamp_bytes v
+    | Bytes_key _ ->
-      | Address_key _ -> Signature.Public_key_hash.size
+        MBytes.length v
-      | Mutez_key _ -> 8
+    | Bool_key _ ->
+        8
+    | Key_hash_key _ ->
+        Signature.Public_key_hash.size
+    | Timestamp_key _ ->
+        timestamp_bytes v
+    | Address_key _ ->
+        Signature.Public_key_hash.size
+    | Mutez_key _ ->
+        8
     | Pair_key ((l, _), (r, _), _) ->
         let (lval, rval) = v in
         size_of_comparable l lval + size_of_comparable r rval
 
-  let string length =
+  let string length = alloc_bytes_cost length
-    alloc_bytes_cost length
 
-  let bytes length =
+  let bytes length = alloc_mbytes_cost length
-    alloc_mbytes_cost length
 
   let manager_operation = step_cost 10_000
 
   module Legacy = struct
-    let zint z =
+    let zint z = alloc_bits_cost (Z.numbits z)
-      alloc_bits_cost (Z.numbits z)
 
-    let set_to_list : type item. item Script_typed_ir.set -> cost
+    let set_to_list : type item. item Script_typed_ir.set -> cost =
-      = fun (module Box) ->
+     fun (module Box) -> alloc_cost @@ Pervasives.(Box.size * 2)
-        alloc_cost @@ Pervasives.(Box.size * 2)
 
     let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
-      = fun (module Box) ->
+        =
+     fun (module Box) ->
       let size = snd Box.boxed in
       3 *@ alloc_cost size
 
     let z_to_int64 = step_cost 2 +@ alloc_cost 1
 
-    let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len
+    let hash data len = (10 *@ step_cost (MBytes.length data)) +@ bytes len
 
-    let set_access : type elt. elt -> elt Script_typed_ir.set -> int
+    let set_access : type elt. elt -> elt Script_typed_ir.set -> int =
-      = fun _key (module Box) ->
+     fun _key (module Box) -> log2 @@ Box.size
-        log2 @@ Box.size
 
-    let set_update key _presence set =
+    let set_update key _presence set = set_access key set *@ alloc_cost 3
-      set_access key set *@ alloc_cost 3
   end
 
   module Interpreter = struct
     let cycle = atomic_step_cost 10
+
     let nop = free
+
     let stack_op = atomic_step_cost 10
+
     let push = atomic_step_cost 10
+
     let wrap = atomic_step_cost 10
+
     let variant_no_data = atomic_step_cost 10
+
     let branch = atomic_step_cost 10
+
     let pair = atomic_step_cost 10
+
     let pair_access = atomic_step_cost 10
+
     let cons = atomic_step_cost 10
+
     let loop_size = atomic_step_cost 5
+
     let loop_cycle = atomic_step_cost 10
+
     let loop_iter = atomic_step_cost 20
+
     let loop_map = atomic_step_cost 30
+
     let empty_set = atomic_step_cost 10
+
     let set_to_list : type elt. elt Script_typed_ir.set -> cost =
-      fun (module Box) ->
+     fun (module Box) -> atomic_step_cost (Box.size * 20)
-        atomic_step_cost (Box.size * 20)
 
     let set_mem : type elt. elt -> elt Script_typed_ir.set -> cost =
      fun elt (module Box) ->
@@ -126,23 +141,30 @@ module Cost_of = struct
       atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)
 
     let set_size = atomic_step_cost 10
+
     let empty_map = atomic_step_cost 10
-    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost =
+
+    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
+        =
      fun (module Box) ->
       let size = snd Box.boxed in
       atomic_step_cost (size * 20)
 
-    let map_access : type key value. key -> (key, value) Script_typed_ir.map -> cost
+    let map_access :
-      = fun key (module Box) ->
+        type key value. key -> (key, value) Script_typed_ir.map -> cost =
+     fun key (module Box) ->
       let map_card = snd Box.boxed in
       let key_bytes = size_of_comparable Box.key_ty key in
       atomic_step_cost ((1 + (key_bytes / 70)) * log2 map_card)
 
     let map_mem = map_access
+
     let map_get = map_access
 
-    let map_update : type key value. key -> value option -> (key, value) Script_typed_ir.map -> cost
+    let map_update :
-      = fun key _value (module Box) ->
+        type key value.
+        key -> value option -> (key, value) Script_typed_ir.map -> cost =
+     fun key _value (module Box) ->
       let map_card = snd Box.boxed in
       let key_bytes = size_of_comparable Box.key_ty key in
       atomic_step_cost ((1 + (key_bytes / 38)) * log2 map_card)
@@ -153,16 +175,16 @@ module Cost_of = struct
       let bytes1 = timestamp_bytes t1 in
       let bytes2 = int_bytes t2 in
       atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))
+
     let sub_timestamp = add_timestamp
+
     let diff_timestamps (t1 : Script_timestamp.t) (t2 : Script_timestamp.t) =
       let bytes1 = timestamp_bytes t1 in
       let bytes2 = timestamp_bytes t2 in
       atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))
 
     let rec concat_loop l acc =
-      match l with
+      match l with [] -> 30 | _ :: tl -> concat_loop tl (acc + 30)
-      | [] -> 30
-      | _ :: tl -> concat_loop tl (acc + 30)
 
     let concat_string string_list =
       atomic_step_cost (concat_loop string_list 0)
@@ -170,19 +192,28 @@ module Cost_of = struct
     let slice_string string_length =
       atomic_step_cost (40 + (string_length / 70))
 
-    let concat_bytes bytes_list =
+    let concat_bytes bytes_list = atomic_step_cost (concat_loop bytes_list 0)
-      atomic_step_cost (concat_loop bytes_list 0)
 
     let int64_op = atomic_step_cost 61
+
     let z_to_int64 = atomic_step_cost 20
+
     let int64_to_z = atomic_step_cost 20
+
     let bool_binop _ _ = atomic_step_cost 10
+
     let bool_unop _ = atomic_step_cost 10
 
-    let abs int = atomic_step_cost (61 + ((int_bytes int) / 70))
+    let abs int = atomic_step_cost (61 + (int_bytes int / 70))
+
     let int _int = free
+
     let neg = abs
-    let add i1 i2 = atomic_step_cost (51 + (Compare.Int.max (int_bytes i1) (int_bytes i2) / 62))
+
+    let add i1 i2 =
+      atomic_step_cost
+        (51 + (Compare.Int.max (int_bytes i1) (int_bytes i2) / 62))
+
     let sub = add
 
     let mul i1 i2 =
@@ -198,303 +229,537 @@ module Cost_of = struct
       atomic_step_cost (51 + (cost / 3151))
 
     let shift_left _i _shift_bits = atomic_step_cost 30
+
     let shift_right _i _shift_bits = atomic_step_cost 30
+
     let logor i1 i2 =
       let bytes1 = int_bytes i1 in
       let bytes2 = int_bytes i2 in
-      atomic_step_cost (51 + ((Compare.Int.max bytes1 bytes2) / 70))
+      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 70))
+
     let logand i1 i2 =
       let bytes1 = int_bytes i1 in
       let bytes2 = int_bytes i2 in
-      atomic_step_cost (51 + ((Compare.Int.min bytes1 bytes2) / 70))
+      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 70))
+
     let logxor = logor
-    let lognot i = atomic_step_cost (51 + ((int_bytes i) / 20))
+
+    let lognot i = atomic_step_cost (51 + (int_bytes i / 20))
+
     let exec = atomic_step_cost 10
+
     let compare_bool _ _ = atomic_step_cost 30
 
     let compare_string s1 s2 =
       let bytes1 = String.length s1 in
       let bytes2 = String.length s2 in
-      atomic_step_cost (30 + ((Compare.Int.min bytes1 bytes2) / 123))
+      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))
+
     let compare_bytes b1 b2 =
       let bytes1 = MBytes.length b1 in
       let bytes2 = MBytes.length b2 in
-      atomic_step_cost (30 + ((Compare.Int.min bytes1 bytes2) / 123))
+      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))
+
     let compare_tez _ _ = atomic_step_cost 30
+
     let compare_zint i1 i2 =
-      atomic_step_cost (51 + ((Compare.Int.min (int_bytes i1) (int_bytes i2)) / 82))
+      atomic_step_cost
+        (51 + (Compare.Int.min (int_bytes i1) (int_bytes i2) / 82))
+
     let compare_key_hash _ _ = atomic_step_cost 92
 
     let compare_timestamp t1 t2 =
       let bytes1 = timestamp_bytes t1 in
       let bytes2 = timestamp_bytes t2 in
-      atomic_step_cost (51 + ((Compare.Int.min bytes1 bytes2) / 82))
+      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 82))
 
     let compare_address _ _ = atomic_step_cost 92
+
     let compare_res = atomic_step_cost 30
+
     let unpack_failed bytes =
       (* We cannot instrument failed deserialization,
          so we take worst case fees: a set of size 1 bytes values. *)
       let len = MBytes.length bytes in
-      (len *@ alloc_mbytes_cost 1) +@
+      (len *@ alloc_mbytes_cost 1)
-      (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
+      +@ (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
+
     let address = atomic_step_cost 10
+
     let contract = step_cost 10000
+
     let transfer = step_cost 10
+
     let create_account = step_cost 10
+
     let create_contract = step_cost 10
+
     let implicit_account = step_cost 10
+
     let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)
+
     let balance = atomic_step_cost 10
+
     let now = atomic_step_cost 10
+
     let check_signature_secp256k1 bytes = atomic_step_cost (10342 + (bytes / 5))
+
     let check_signature_ed25519 bytes = atomic_step_cost (36864 + (bytes / 5))
+
     let check_signature_p256 bytes = atomic_step_cost (36864 + (bytes / 5))
+
     let check_signature (pkey : Signature.public_key) bytes =
       match pkey with
-      | Ed25519 _ -> check_signature_ed25519 (MBytes.length bytes)
+      | Ed25519 _ ->
-      | Secp256k1 _ -> check_signature_secp256k1 (MBytes.length bytes)
+          check_signature_ed25519 (MBytes.length bytes)
-      | P256 _ ->  check_signature_p256 (MBytes.length bytes)
+      | Secp256k1 _ ->
+          check_signature_secp256k1 (MBytes.length bytes)
+      | P256 _ ->
+          check_signature_p256 (MBytes.length bytes)
+
     let hash_key = atomic_step_cost 30
-    let hash_blake2b b = atomic_step_cost (102 + ((MBytes.length b) / 5))
+
-    let hash_sha256 b = atomic_step_cost (409 + (MBytes.length b))
+    let hash_blake2b b = atomic_step_cost (102 + (MBytes.length b / 5))
+
+    let hash_sha256 b = atomic_step_cost (409 + MBytes.length b)
+
     let hash_sha512 b =
-      let bytes = MBytes.length b in atomic_step_cost (409 + ((bytes lsr 1) + (bytes lsr 4)))
+      let bytes = MBytes.length b in
+      atomic_step_cost (409 + ((bytes lsr 1) + (bytes lsr 4)))
+
     let steps_to_quota = atomic_step_cost 10
+
     let source = atomic_step_cost 10
+
     let self = atomic_step_cost 10
+
     let amount = atomic_step_cost 10
+
     let chain_id = step_cost 1
-    let stack_n_op n = atomic_step_cost (20 + (((n lsr 1) + (n lsr 2)) + (n lsr 4)))
+
+    let stack_n_op n =
+      atomic_step_cost (20 + ((n lsr 1) + (n lsr 2) + (n lsr 4)))
+
     let apply = alloc_cost 8 +@ step_cost 1
 
-    let rec compare : type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost = fun ty x y ->
+    let rec compare :
+        type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost =
+     fun ty x y ->
       match ty with
-      | Bool_key _ -> compare_bool x y
+      | Bool_key _ ->
-      | String_key _ -> compare_string x y
+          compare_bool x y
-      | Bytes_key _ -> compare_bytes x y
+      | String_key _ ->
-      | Mutez_key _ -> compare_tez x y
+          compare_string x y
-      | Int_key _ -> compare_zint x y
+      | Bytes_key _ ->
-      | Nat_key _ -> compare_zint x y
+          compare_bytes x y
-      | Key_hash_key _ -> compare_key_hash x y
+      | Mutez_key _ ->
-      | Timestamp_key _ -> compare_timestamp x y
+          compare_tez x y
-      | Address_key _ -> compare_address x y
+      | Int_key _ ->
+          compare_zint x y
+      | Nat_key _ ->
+          compare_zint x y
+      | Key_hash_key _ ->
+          compare_key_hash x y
+      | Timestamp_key _ ->
+          compare_timestamp x y
+      | Address_key _ ->
+          compare_address x y
       | Pair_key ((tl, _), (tr, _), _) ->
           (* Reasonable over-approximation of the cost of lexicographic comparison. *)
           let (xl, xr) = x and (yl, yr) = y in
           compare tl xl yl +@ compare tr xr yr
-
   end
 
   module Typechecking = struct
     let cycle = step_cost 1
+
     let bool = free
+
     let unit = free
+
     let string = string
+
     let bytes = bytes
+
     let z = Legacy.zint
+
     let int_of_string str =
-      alloc_cost @@ (Pervasives.(/) (String.length str) 5)
+      alloc_cost @@ Pervasives.( / ) (String.length str) 5
+
     let tez = step_cost 1 +@ alloc_cost 1
+
     let string_timestamp = step_cost 3 +@ alloc_cost 3
+
     let key = step_cost 3 +@ alloc_cost 3
+
     let key_hash = step_cost 1 +@ alloc_cost 1
+
     let signature = step_cost 1 +@ alloc_cost 1
+
     let chain_id = step_cost 1 +@ alloc_cost 1
+
     let contract = step_cost 5
+
     let get_script = step_cost 20 +@ alloc_cost 5
+
     let contract_exists = step_cost 15 +@ alloc_cost 5
+
     let pair = alloc_cost 2
+
     let union = alloc_cost 1
+
     let lambda = alloc_cost 5 +@ step_cost 3
+
     let some = alloc_cost 1
+
     let none = alloc_cost 0
+
     let list_element = alloc_cost 2 +@ step_cost 1
+
     let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2)
+
     let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2)
+
     let primitive_type = alloc_cost 1
+
     let one_arg_type = alloc_cost 2
+
     let two_arg_type = alloc_cost 3
+
     let operation b = bytes b
+
     let type_ nb_args = alloc_cost (nb_args + 1)
 
     (* Cost of parsing instruction, is cost of allocation of
        constructor + cost of contructor parameters + cost of
        allocation on the stack type *)
-    let instr
+    let instr : type b a. (b, a) Script_typed_ir.instr -> cost =
-      : type b a. (b, a) Script_typed_ir.instr -> cost
+     fun i ->
-      = fun i ->
       let open Script_typed_ir in
-        alloc_cost 1 +@ (* cost of allocation of constructor *)
+      alloc_cost 1
+      +@
+      (* cost of allocation of constructor *)
       match i with
-        | Drop -> alloc_cost 0
+      | Drop ->
-        | Dup -> alloc_cost 1
+          alloc_cost 0
-        | Swap -> alloc_cost 0
+      | Dup ->
-        | Const _ -> alloc_cost 1
+          alloc_cost 1
-        | Cons_pair -> alloc_cost 2
+      | Swap ->
-        | Car -> alloc_cost 1
+          alloc_cost 0
-        | Cdr -> alloc_cost 1
+      | Const _ ->
-        | Cons_some -> alloc_cost 2
+          alloc_cost 1
-        | Cons_none _ -> alloc_cost 3
+      | Cons_pair ->
-        | If_none _ -> alloc_cost 2
+          alloc_cost 2
-        | Left -> alloc_cost 3
+      | Car ->
-        | Right -> alloc_cost 3
+          alloc_cost 1
-        | If_left _ -> alloc_cost 2
+      | Cdr ->
-        | Cons_list -> alloc_cost 1
+          alloc_cost 1
-        | Nil -> alloc_cost 1
+      | Cons_some ->
-        | If_cons _ -> alloc_cost 2
+          alloc_cost 2
-        | List_map _ -> alloc_cost 5
+      | Cons_none _ ->
-        | List_iter _ -> alloc_cost 4
+          alloc_cost 3
-        | List_size -> alloc_cost 1
+      | If_none _ ->
-        | Empty_set _ -> alloc_cost 1
+          alloc_cost 2
-        | Set_iter _ -> alloc_cost 4
+      | Left ->
-        | Set_mem -> alloc_cost 1
+          alloc_cost 3
-        | Set_update -> alloc_cost 1
+      | Right ->
-        | Set_size -> alloc_cost 1
+          alloc_cost 3
-        | Empty_map _ -> alloc_cost 2
+      | If_left _ ->
-        | Map_map _ -> alloc_cost 5
+          alloc_cost 2
-        | Map_iter _ -> alloc_cost 4
+      | Cons_list ->
-        | Map_mem -> alloc_cost 1
+          alloc_cost 1
-        | Map_get -> alloc_cost 1
+      | Nil ->
-        | Map_update -> alloc_cost 1
+          alloc_cost 1
-        | Map_size -> alloc_cost 1
+      | If_cons _ ->
-        | Empty_big_map _ -> alloc_cost 2
+          alloc_cost 2
-        | Big_map_mem -> alloc_cost 1
+      | List_map _ ->
-        | Big_map_get -> alloc_cost 1
+          alloc_cost 5
-        | Big_map_update -> alloc_cost 1
+      | List_iter _ ->
-        | Concat_string -> alloc_cost 1
+          alloc_cost 4
-        | Concat_string_pair -> alloc_cost 1
+      | List_size ->
-        | Concat_bytes -> alloc_cost 1
+          alloc_cost 1
-        | Concat_bytes_pair -> alloc_cost 1
+      | Empty_set _ ->
-        | Slice_string -> alloc_cost 1
+          alloc_cost 1
-        | Slice_bytes -> alloc_cost 1
+      | Set_iter _ ->
-        | String_size -> alloc_cost 1
+          alloc_cost 4
-        | Bytes_size -> alloc_cost 1
+      | Set_mem ->
-        | Add_seconds_to_timestamp -> alloc_cost 1
+          alloc_cost 1
-        | Add_timestamp_to_seconds -> alloc_cost 1
+      | Set_update ->
-        | Sub_timestamp_seconds -> alloc_cost 1
+          alloc_cost 1
-        | Diff_timestamps -> alloc_cost 1
+      | Set_size ->
-        | Add_tez -> alloc_cost 1
+          alloc_cost 1
-        | Sub_tez -> alloc_cost 1
+      | Empty_map _ ->
-        | Mul_teznat -> alloc_cost 1
+          alloc_cost 2
-        | Mul_nattez -> alloc_cost 1
+      | Map_map _ ->
-        | Ediv_teznat -> alloc_cost 1
+          alloc_cost 5
-        | Ediv_tez -> alloc_cost 1
+      | Map_iter _ ->
-        | Or -> alloc_cost 1
+          alloc_cost 4
-        | And -> alloc_cost 1
+      | Map_mem ->
-        | Xor -> alloc_cost 1
+          alloc_cost 1
-        | Not -> alloc_cost 1
+      | Map_get ->
-        | Is_nat -> alloc_cost 1
+          alloc_cost 1
-        | Neg_nat -> alloc_cost 1
+      | Map_update ->
-        | Neg_int -> alloc_cost 1
+          alloc_cost 1
-        | Abs_int -> alloc_cost 1
+      | Map_size ->
-        | Int_nat -> alloc_cost 1
+          alloc_cost 1
-        | Add_intint -> alloc_cost 1
+      | Empty_big_map _ ->
-        | Add_intnat -> alloc_cost 1
+          alloc_cost 2
-        | Add_natint -> alloc_cost 1
+      | Big_map_mem ->
-        | Add_natnat -> alloc_cost 1
+          alloc_cost 1
-        | Sub_int -> alloc_cost 1
+      | Big_map_get ->
-        | Mul_intint -> alloc_cost 1
+          alloc_cost 1
-        | Mul_intnat -> alloc_cost 1
+      | Big_map_update ->
-        | Mul_natint -> alloc_cost 1
+          alloc_cost 1
-        | Mul_natnat -> alloc_cost 1
+      | Concat_string ->
-        | Ediv_intint -> alloc_cost 1
+          alloc_cost 1
-        | Ediv_intnat -> alloc_cost 1
+      | Concat_string_pair ->
-        | Ediv_natint -> alloc_cost 1
+          alloc_cost 1
-        | Ediv_natnat -> alloc_cost 1
+      | Concat_bytes ->
-        | Lsl_nat -> alloc_cost 1
+          alloc_cost 1
-        | Lsr_nat -> alloc_cost 1
+      | Concat_bytes_pair ->
-        | Or_nat -> alloc_cost 1
+          alloc_cost 1
-        | And_nat -> alloc_cost 1
+      | Slice_string ->
-        | And_int_nat -> alloc_cost 1
+          alloc_cost 1
-        | Xor_nat -> alloc_cost 1
+      | Slice_bytes ->
-        | Not_nat -> alloc_cost 1
+          alloc_cost 1
-        | Not_int -> alloc_cost 1
+      | String_size ->
-        | Seq _ -> alloc_cost 8
+          alloc_cost 1
-        | If _ -> alloc_cost 8
+      | Bytes_size ->
-        | Loop _ -> alloc_cost 4
+          alloc_cost 1
-        | Loop_left _ -> alloc_cost 5
+      | Add_seconds_to_timestamp ->
-        | Dip _ -> alloc_cost 4
+          alloc_cost 1
-        | Exec -> alloc_cost 1
+      | Add_timestamp_to_seconds ->
-        | Apply _ -> alloc_cost 1
+          alloc_cost 1
-        | Lambda _ -> alloc_cost 2
+      | Sub_timestamp_seconds ->
-        | Failwith _ -> alloc_cost 1
+          alloc_cost 1
-        | Nop -> alloc_cost 0
+      | Diff_timestamps ->
-        | Compare _ -> alloc_cost 1
+          alloc_cost 1
-        | Eq -> alloc_cost 1
+      | Add_tez ->
-        | Neq -> alloc_cost 1
+          alloc_cost 1
-        | Lt -> alloc_cost 1
+      | Sub_tez ->
-        | Gt -> alloc_cost 1
+          alloc_cost 1
-        | Le -> alloc_cost 1
+      | Mul_teznat ->
-        | Ge -> alloc_cost 1
+          alloc_cost 1
-        | Address -> alloc_cost 1
+      | Mul_nattez ->
-        | Contract _ -> alloc_cost 2
+          alloc_cost 1
-        | Transfer_tokens -> alloc_cost 1
+      | Ediv_teznat ->
-        | Create_account -> alloc_cost 2
+          alloc_cost 1
-        | Implicit_account -> alloc_cost 1
+      | Ediv_tez ->
-        | Create_contract _ -> alloc_cost 8
+          alloc_cost 1
+      | Or ->
+          alloc_cost 1
+      | And ->
+          alloc_cost 1
+      | Xor ->
+          alloc_cost 1
+      | Not ->
+          alloc_cost 1
+      | Is_nat ->
+          alloc_cost 1
+      | Neg_nat ->
+          alloc_cost 1
+      | Neg_int ->
+          alloc_cost 1
+      | Abs_int ->
+          alloc_cost 1
+      | Int_nat ->
+          alloc_cost 1
+      | Add_intint ->
+          alloc_cost 1
+      | Add_intnat ->
+          alloc_cost 1
+      | Add_natint ->
+          alloc_cost 1
+      | Add_natnat ->
+          alloc_cost 1
+      | Sub_int ->
+          alloc_cost 1
+      | Mul_intint ->
+          alloc_cost 1
+      | Mul_intnat ->
+          alloc_cost 1
+      | Mul_natint ->
+          alloc_cost 1
+      | Mul_natnat ->
+          alloc_cost 1
+      | Ediv_intint ->
+          alloc_cost 1
+      | Ediv_intnat ->
+          alloc_cost 1
+      | Ediv_natint ->
+          alloc_cost 1
+      | Ediv_natnat ->
+          alloc_cost 1
+      | Lsl_nat ->
+          alloc_cost 1
+      | Lsr_nat ->
+          alloc_cost 1
+      | Or_nat ->
+          alloc_cost 1
+      | And_nat ->
+          alloc_cost 1
+      | And_int_nat ->
+          alloc_cost 1
+      | Xor_nat ->
+          alloc_cost 1
+      | Not_nat ->
+          alloc_cost 1
+      | Not_int ->
+          alloc_cost 1
+      | Seq _ ->
+          alloc_cost 8
+      | If _ ->
+          alloc_cost 8
+      | Loop _ ->
+          alloc_cost 4
+      | Loop_left _ ->
+          alloc_cost 5
+      | Dip _ ->
+          alloc_cost 4
+      | Exec ->
+          alloc_cost 1
+      | Apply _ ->
+          alloc_cost 1
+      | Lambda _ ->
+          alloc_cost 2
+      | Failwith _ ->
+          alloc_cost 1
+      | Nop ->
+          alloc_cost 0
+      | Compare _ ->
+          alloc_cost 1
+      | Eq ->
+          alloc_cost 1
+      | Neq ->
+          alloc_cost 1
+      | Lt ->
+          alloc_cost 1
+      | Gt ->
+          alloc_cost 1
+      | Le ->
+          alloc_cost 1
+      | Ge ->
+          alloc_cost 1
+      | Address ->
+          alloc_cost 1
+      | Contract _ ->
+          alloc_cost 2
+      | Transfer_tokens ->
+          alloc_cost 1
+      | Create_account ->
+          alloc_cost 2
+      | Implicit_account ->
+          alloc_cost 1
+      | Create_contract _ ->
+          alloc_cost 8
       (* Deducted the cost of removed arguments manager, spendable and delegatable:
            - manager: key_hash = 1
            - spendable: bool = 0
            - delegatable: bool = 0
         *)
-        | Create_contract_2 _ -> alloc_cost 7
+      | Create_contract_2 _ ->
-        | Set_delegate -> alloc_cost 1
+          alloc_cost 7
-        | Now -> alloc_cost 1
+      | Set_delegate ->
-        | Balance -> alloc_cost 1
+          alloc_cost 1
-        | Check_signature -> alloc_cost 1
+      | Now ->
-        | Hash_key -> alloc_cost 1
+          alloc_cost 1
-        | Pack _ -> alloc_cost 2
+      | Balance ->
-        | Unpack _ -> alloc_cost 2
+          alloc_cost 1
-        | Blake2b -> alloc_cost 1
+      | Check_signature ->
-        | Sha256 -> alloc_cost 1
+          alloc_cost 1
-        | Sha512 -> alloc_cost 1
+      | Hash_key ->
-        | Steps_to_quota -> alloc_cost 1
+          alloc_cost 1
-        | Source -> alloc_cost 1
+      | Pack _ ->
-        | Sender -> alloc_cost 1
+          alloc_cost 2
-        | Self _ -> alloc_cost 2
+      | Unpack _ ->
-        | Amount -> alloc_cost 1
+          alloc_cost 2
-        | Dig (n,_) -> n *@ alloc_cost 1 (* _ is a unary development of n *)
+      | Blake2b ->
-        | Dug (n,_) -> n *@ alloc_cost 1
+          alloc_cost 1
-        | Dipn (n,_,_) -> n *@ alloc_cost 1
+      | Sha256 ->
-        | Dropn (n,_) -> n *@ alloc_cost 1
+          alloc_cost 1
-        | ChainId -> alloc_cost 1
+      | Sha512 ->
+          alloc_cost 1
+      | Steps_to_quota ->
+          alloc_cost 1
+      | Source ->
+          alloc_cost 1
+      | Sender ->
+          alloc_cost 1
+      | Self _ ->
+          alloc_cost 2
+      | Amount ->
+          alloc_cost 1
+      | Dig (n, _) ->
+          n *@ alloc_cost 1 (* _ is a unary development of n *)
+      | Dug (n, _) ->
+          n *@ alloc_cost 1
+      | Dipn (n, _, _) ->
+          n *@ alloc_cost 1
+      | Dropn (n, _) ->
+          n *@ alloc_cost 1
+      | ChainId ->
+          alloc_cost 1
   end
 
   module Unparse = struct
     let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot
+
     let seq_cost = Script.seq_node_cost_nonrec_of_length
+
     let string_cost length = Script.string_node_cost_of_length length
 
     let cycle = step_cost 1
+
     let bool = prim_cost 0 []
+
     let unit = prim_cost 0 []
+
     (* We count the length of strings and bytes to prevent hidden
        miscalculations due to non detectable expansion of sharing. *)
     let string s = Script.string_node_cost s
+
     let bytes s = Script.bytes_node_cost s
+
     let z i = Script.int_node_cost i
+
     let int i = Script.int_node_cost (Script_int.to_zint i)
+
     let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)
+
     let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int
+
     let operation bytes = Script.bytes_node_cost bytes
+
     let chain_id bytes = Script.bytes_node_cost bytes
+
     let key = string_cost 54
+
     let key_hash = string_cost 36
+
     let signature = string_cost 128
+
     let contract = string_cost 36
+
     let pair = prim_cost 2 []
+
     let union = prim_cost 1 []
+
     let some = prim_cost 1 []
+
     let none = prim_cost 0 []
+
     let list_element = alloc_cost 2
+
     let set_element = alloc_cost 2
+
     let map_element = alloc_cost 2
+
     let one_arg_type = prim_cost 1
+
     let two_arg_type = prim_cost 2
 
     let set_to_list = Legacy.set_to_list
+
     let map_to_list = Legacy.map_to_list
   end
-
 end

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_gas.mli

@@ -26,107 +26,194 @@
 open Alpha_context
 
 module Cost_of : sig
-
   val manager_operation : Gas.cost
 
   module Legacy : sig
     val z_to_int64 : Gas.cost
+
     val hash : MBytes.t -> int -> Gas.cost
-    val map_to_list :
+
-      ('b, 'c) Script_typed_ir.map -> Gas.cost
+    val map_to_list : ('b, 'c) Script_typed_ir.map -> Gas.cost
+
     val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
   end
 
   module Interpreter : sig
     val cycle : Gas.cost
+
     val loop_cycle : Gas.cost
+
     val loop_size : Gas.cost
+
     val loop_iter : Gas.cost
+
     val loop_map : Gas.cost
+
     val nop : Gas.cost
+
     val stack_op : Gas.cost
+
     val stack_n_op : int -> Gas.cost
+
     val bool_binop : 'a -> 'b -> Gas.cost
+
     val bool_unop : 'a -> Gas.cost
+
     val pair : Gas.cost
+
     val pair_access : Gas.cost
+
     val cons : Gas.cost
+
     val variant_no_data : Gas.cost
+
     val branch : Gas.cost
+
     val concat_string : string list -> Gas.cost
+
     val concat_bytes : MBytes.t list -> Gas.cost
+
     val slice_string : int -> Gas.cost
+
     val map_mem : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+
     val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
+
     val map_get : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost
-    val map_update : 'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+
+    val map_update :
+      'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+
     val map_size : Gas.cost
+
     val set_to_list : 'a Script_typed_ir.set -> Gas.cost
+
     val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
+
     val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost
+
     val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val abs : 'a Script_int.num -> Gas.cost
+
     val neg : 'a Script_int.num -> Gas.cost
+
     val int : 'a -> Gas.cost
+
     val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+
     val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+
     val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost
+
     val empty_set : Gas.cost
+
     val set_size : Gas.cost
+
     val empty_map : Gas.cost
+
     val int64_op : Gas.cost
+
     val z_to_int64 : Gas.cost
+
     val int64_to_z : Gas.cost
+
     val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val lognot : 'a Script_int.num -> Gas.cost
+
     val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val exec : Gas.cost
+
     val push : Gas.cost
+
     val compare_res : Gas.cost
+
     val unpack_failed : MBytes.t -> Gas.cost
+
     val address : Gas.cost
+
     val contract : Gas.cost
+
     val transfer : Gas.cost
+
     val create_account : Gas.cost
+
     val create_contract : Gas.cost
+
     val implicit_account : Gas.cost
+
     val set_delegate : Gas.cost
+
     val balance : Gas.cost
+
     val now : Gas.cost
+
     val check_signature : public_key -> MBytes.t -> Gas.cost
+
     val hash_key : Gas.cost
+
     val hash_blake2b : MBytes.t -> Gas.cost
+
     val hash_sha256 : MBytes.t -> Gas.cost
+
     val hash_sha512 : MBytes.t -> Gas.cost
+
     val steps_to_quota : Gas.cost
+
     val source : Gas.cost
+
     val self : Gas.cost
+
     val amount : Gas.cost
+
     val chain_id : Gas.cost
+
     val wrap : Gas.cost
+
     val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost
+
     val apply : Gas.cost
   end
 
   module Typechecking : sig
     val cycle : Gas.cost
+
     val unit : Gas.cost
+
     val bool : Gas.cost
+
     val tez : Gas.cost
+
     val z : Z.t -> Gas.cost
+
     val string : int -> Gas.cost
+
     val bytes : int -> Gas.cost
+
     val int_of_string : string -> Gas.cost
+
     val string_timestamp : Gas.cost
+
     val key : Gas.cost
+
     val key_hash : Gas.cost
+
     val signature : Gas.cost
+
     val chain_id : Gas.cost
 
     val contract : Gas.cost
@@ -144,14 +231,19 @@ module Cost_of : sig
     val lambda : Gas.cost
 
     val some : Gas.cost
+
     val none : Gas.cost
 
     val list_element : Gas.cost
+
     val set_element : int -> Gas.cost
+
     val map_element : int -> Gas.cost
 
     val primitive_type : Gas.cost
+
     val one_arg_type : Gas.cost
+
     val two_arg_type : Gas.cost
 
     val operation : int -> Gas.cost
@@ -165,20 +257,35 @@ module Cost_of : sig
 
   module Unparse : sig
     val prim_cost : int -> Script.annot -> Gas.cost
+
     val seq_cost : int -> Gas.cost
+
     val cycle : Gas.cost
+
     val unit : Gas.cost
+
     val bool : Gas.cost
+
     val z : Z.t -> Gas.cost
+
     val int : 'a Script_int.num -> Gas.cost
+
     val tez : Gas.cost
+
     val string : string -> Gas.cost
+
     val bytes : MBytes.t -> Gas.cost
+
     val timestamp : Script_timestamp.t -> Gas.cost
+
     val key : Gas.cost
+
     val key_hash : Gas.cost
+
     val signature : Gas.cost
+
     val operation : MBytes.t -> Gas.cost
+
     val chain_id : MBytes.t -> Gas.cost
 
     val contract : Gas.cost
@@ -189,15 +296,21 @@ module Cost_of : sig
     val union : Gas.cost
 
     val some : Gas.cost
+
     val none : Gas.cost
 
     val list_element : Gas.cost
+
     val set_element : Gas.cost
+
     val map_element : Gas.cost
 
     val one_arg_type : Script.annot -> Gas.cost
+
     val two_arg_type : Script.annot -> Gas.cost
+
     val set_to_list : 'a Script_typed_ir.set -> Gas.cost
+
     val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
   end
 end

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_primitives.ml

@@ -26,8 +26,12 @@
 open Micheline
 
 type error += Unknown_primitive_name of string
+
 type error += Invalid_case of string
-type error += Invalid_primitive_name of string Micheline.canonical * Micheline.canonical_location
+
+type error +=
+  | Invalid_primitive_name of
+      string Micheline.canonical * Micheline.canonical_location
 
 type prim =
   | K_parameter
@@ -153,308 +157,539 @@ 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
+    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] <> '_')
-  Compare.Char.(String.get name 0 <> '_')
+  && ( (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_upper name.[i]))
-  &&
+     || (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
-  ((is_upper (String.get name 0)
+     || (is_lower name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
-    && for_all 1 (len - 1) (fun i -> is_upper (String.get name i)))
+     )
-   ||
-   (is_upper (String.get name 0)
-    && for_all 1 (len - 1) (fun i -> is_lower (String.get name i)))
-   ||
-   (is_lower (String.get name 0)
-    && for_all 1 (len - 1) (fun i -> is_lower (String.get name i))))
 
 let string_of_prim = function
-  | K_parameter -> "parameter"
+  | K_parameter ->
-  | K_storage -> "storage"
+      "parameter"
-  | K_code -> "code"
+  | K_storage ->
-  | D_False -> "False"
+      "storage"
-  | D_Elt -> "Elt"
+  | K_code ->
-  | D_Left -> "Left"
+      "code"
-  | D_None -> "None"
+  | D_False ->
-  | D_Pair -> "Pair"
+      "False"
-  | D_Right -> "Right"
+  | D_Elt ->
-  | D_Some -> "Some"
+      "Elt"
-  | D_True -> "True"
+  | D_Left ->
-  | D_Unit -> "Unit"
+      "Left"
-  | I_PACK -> "PACK"
+  | D_None ->
-  | I_UNPACK -> "UNPACK"
+      "None"
-  | I_BLAKE2B -> "BLAKE2B"
+  | D_Pair ->
-  | I_SHA256 -> "SHA256"
+      "Pair"
-  | I_SHA512 -> "SHA512"
+  | D_Right ->
-  | I_ABS -> "ABS"
+      "Right"
-  | I_ADD -> "ADD"
+  | D_Some ->
-  | I_AMOUNT -> "AMOUNT"
+      "Some"
-  | I_AND -> "AND"
+  | D_True ->
-  | I_BALANCE -> "BALANCE"
+      "True"
-  | I_CAR -> "CAR"
+  | D_Unit ->
-  | I_CDR -> "CDR"
+      "Unit"
-  | I_CHAIN_ID -> "CHAIN_ID"
+  | I_PACK ->
-  | I_CHECK_SIGNATURE -> "CHECK_SIGNATURE"
+      "PACK"
-  | I_COMPARE -> "COMPARE"
+  | I_UNPACK ->
-  | I_CONCAT -> "CONCAT"
+      "UNPACK"
-  | I_CONS -> "CONS"
+  | I_BLAKE2B ->
-  | I_CREATE_ACCOUNT -> "CREATE_ACCOUNT"
+      "BLAKE2B"
-  | I_CREATE_CONTRACT -> "CREATE_CONTRACT"
+  | I_SHA256 ->
-  | I_IMPLICIT_ACCOUNT -> "IMPLICIT_ACCOUNT"
+      "SHA256"
-  | I_DIP -> "DIP"
+  | I_SHA512 ->
-  | I_DROP -> "DROP"
+      "SHA512"
-  | I_DUP -> "DUP"
+  | I_ABS ->
-  | I_EDIV -> "EDIV"
+      "ABS"
-  | I_EMPTY_BIG_MAP -> "EMPTY_BIG_MAP"
+  | I_ADD ->
-  | I_EMPTY_MAP -> "EMPTY_MAP"
+      "ADD"
-  | I_EMPTY_SET -> "EMPTY_SET"
+  | I_AMOUNT ->
-  | I_EQ -> "EQ"
+      "AMOUNT"
-  | I_EXEC -> "EXEC"
+  | I_AND ->
-  | I_APPLY -> "APPLY"
+      "AND"
-  | I_FAILWITH -> "FAILWITH"
+  | I_BALANCE ->
-  | I_GE -> "GE"
+      "BALANCE"
-  | I_GET -> "GET"
+  | I_CAR ->
-  | I_GT -> "GT"
+      "CAR"
-  | I_HASH_KEY -> "HASH_KEY"
+  | I_CDR ->
-  | I_IF -> "IF"
+      "CDR"
-  | I_IF_CONS -> "IF_CONS"
+  | I_CHAIN_ID ->
-  | I_IF_LEFT -> "IF_LEFT"
+      "CHAIN_ID"
-  | I_IF_NONE -> "IF_NONE"
+  | I_CHECK_SIGNATURE ->
-  | I_INT -> "INT"
+      "CHECK_SIGNATURE"
-  | I_LAMBDA -> "LAMBDA"
+  | I_COMPARE ->
-  | I_LE -> "LE"
+      "COMPARE"
-  | I_LEFT -> "LEFT"
+  | I_CONCAT ->
-  | I_LOOP -> "LOOP"
+      "CONCAT"
-  | I_LSL -> "LSL"
+  | I_CONS ->
-  | I_LSR -> "LSR"
+      "CONS"
-  | I_LT -> "LT"
+  | I_CREATE_ACCOUNT ->
-  | I_MAP -> "MAP"
+      "CREATE_ACCOUNT"
-  | I_MEM -> "MEM"
+  | I_CREATE_CONTRACT ->
-  | I_MUL -> "MUL"
+      "CREATE_CONTRACT"
-  | I_NEG -> "NEG"
+  | I_IMPLICIT_ACCOUNT ->
-  | I_NEQ -> "NEQ"
+      "IMPLICIT_ACCOUNT"
-  | I_NIL -> "NIL"
+  | I_DIP ->
-  | I_NONE -> "NONE"
+      "DIP"
-  | I_NOT -> "NOT"
+  | I_DROP ->
-  | I_NOW -> "NOW"
+      "DROP"
-  | I_OR -> "OR"
+  | I_DUP ->
-  | I_PAIR -> "PAIR"
+      "DUP"
-  | I_PUSH -> "PUSH"
+  | I_EDIV ->
-  | I_RIGHT -> "RIGHT"
+      "EDIV"
-  | I_SIZE -> "SIZE"
+  | I_EMPTY_BIG_MAP ->
-  | I_SOME -> "SOME"
+      "EMPTY_BIG_MAP"
-  | I_SOURCE -> "SOURCE"
+  | I_EMPTY_MAP ->
-  | I_SENDER -> "SENDER"
+      "EMPTY_MAP"
-  | I_SELF -> "SELF"
+  | I_EMPTY_SET ->
-  | I_SLICE -> "SLICE"
+      "EMPTY_SET"
-  | I_STEPS_TO_QUOTA -> "STEPS_TO_QUOTA"
+  | I_EQ ->
-  | I_SUB -> "SUB"
+      "EQ"
-  | I_SWAP -> "SWAP"
+  | I_EXEC ->
-  | I_TRANSFER_TOKENS -> "TRANSFER_TOKENS"
+      "EXEC"
-  | I_SET_DELEGATE -> "SET_DELEGATE"
+  | I_APPLY ->
-  | I_UNIT -> "UNIT"
+      "APPLY"
-  | I_UPDATE -> "UPDATE"
+  | I_FAILWITH ->
-  | I_XOR -> "XOR"
+      "FAILWITH"
-  | I_ITER -> "ITER"
+  | I_GE ->
-  | I_LOOP_LEFT -> "LOOP_LEFT"
+      "GE"
-  | I_ADDRESS -> "ADDRESS"
+  | I_GET ->
-  | I_CONTRACT -> "CONTRACT"
+      "GET"
-  | I_ISNAT -> "ISNAT"
+  | I_GT ->
-  | I_CAST -> "CAST"
+      "GT"
-  | I_RENAME -> "RENAME"
+  | I_HASH_KEY ->
-  | I_DIG -> "DIG"
+      "HASH_KEY"
-  | I_DUG -> "DUG"
+  | I_IF ->
-  | T_bool -> "bool"
+      "IF"
-  | T_contract -> "contract"
+  | I_IF_CONS ->
-  | T_int -> "int"
+      "IF_CONS"
-  | T_key -> "key"
+  | I_IF_LEFT ->
-  | T_key_hash -> "key_hash"
+      "IF_LEFT"
-  | T_lambda -> "lambda"
+  | I_IF_NONE ->
-  | T_list -> "list"
+      "IF_NONE"
-  | T_map -> "map"
+  | I_INT ->
-  | T_big_map -> "big_map"
+      "INT"
-  | T_nat -> "nat"
+  | I_LAMBDA ->
-  | T_option -> "option"
+      "LAMBDA"
-  | T_or -> "or"
+  | I_LE ->
-  | T_pair -> "pair"
+      "LE"
-  | T_set -> "set"
+  | I_LEFT ->
-  | T_signature -> "signature"
+      "LEFT"
-  | T_string -> "string"
+  | I_LOOP ->
-  | T_bytes -> "bytes"
+      "LOOP"
-  | T_mutez -> "mutez"
+  | I_LSL ->
-  | T_timestamp -> "timestamp"
+      "LSL"
-  | T_unit -> "unit"
+  | I_LSR ->
-  | T_operation -> "operation"
+      "LSR"
-  | T_address -> "address"
+  | I_LT ->
-  | T_chain_id -> "chain_id"
+      "LT"
+  | I_MAP ->
+      "MAP"
+  | I_MEM ->
+      "MEM"
+  | I_MUL ->
+      "MUL"
+  | I_NEG ->
+      "NEG"
+  | I_NEQ ->
+      "NEQ"
+  | I_NIL ->
+      "NIL"
+  | I_NONE ->
+      "NONE"
+  | I_NOT ->
+      "NOT"
+  | I_NOW ->
+      "NOW"
+  | I_OR ->
+      "OR"
+  | I_PAIR ->
+      "PAIR"
+  | I_PUSH ->
+      "PUSH"
+  | I_RIGHT ->
+      "RIGHT"
+  | I_SIZE ->
+      "SIZE"
+  | I_SOME ->
+      "SOME"
+  | I_SOURCE ->
+      "SOURCE"
+  | I_SENDER ->
+      "SENDER"
+  | I_SELF ->
+      "SELF"
+  | I_SLICE ->
+      "SLICE"
+  | I_STEPS_TO_QUOTA ->
+      "STEPS_TO_QUOTA"
+  | I_SUB ->
+      "SUB"
+  | I_SWAP ->
+      "SWAP"
+  | I_TRANSFER_TOKENS ->
+      "TRANSFER_TOKENS"
+  | I_SET_DELEGATE ->
+      "SET_DELEGATE"
+  | I_UNIT ->
+      "UNIT"
+  | I_UPDATE ->
+      "UPDATE"
+  | I_XOR ->
+      "XOR"
+  | I_ITER ->
+      "ITER"
+  | I_LOOP_LEFT ->
+      "LOOP_LEFT"
+  | I_ADDRESS ->
+      "ADDRESS"
+  | I_CONTRACT ->
+      "CONTRACT"
+  | I_ISNAT ->
+      "ISNAT"
+  | I_CAST ->
+      "CAST"
+  | I_RENAME ->
+      "RENAME"
+  | I_DIG ->
+      "DIG"
+  | I_DUG ->
+      "DUG"
+  | T_bool ->
+      "bool"
+  | T_contract ->
+      "contract"
+  | T_int ->
+      "int"
+  | T_key ->
+      "key"
+  | T_key_hash ->
+      "key_hash"
+  | T_lambda ->
+      "lambda"
+  | T_list ->
+      "list"
+  | T_map ->
+      "map"
+  | T_big_map ->
+      "big_map"
+  | T_nat ->
+      "nat"
+  | T_option ->
+      "option"
+  | T_or ->
+      "or"
+  | T_pair ->
+      "pair"
+  | T_set ->
+      "set"
+  | T_signature ->
+      "signature"
+  | T_string ->
+      "string"
+  | T_bytes ->
+      "bytes"
+  | T_mutez ->
+      "mutez"
+  | T_timestamp ->
+      "timestamp"
+  | T_unit ->
+      "unit"
+  | T_operation ->
+      "operation"
+  | T_address ->
+      "address"
+  | T_chain_id ->
+      "chain_id"
 
 let prim_of_string = function
-  | "parameter" -> ok K_parameter
+  | "parameter" ->
-  | "storage" -> ok K_storage
+      ok K_parameter
-  | "code" -> ok K_code
+  | "storage" ->
-  | "False" -> ok D_False
+      ok K_storage
-  | "Elt" -> ok D_Elt
+  | "code" ->
-  | "Left" -> ok D_Left
+      ok K_code
-  | "None" -> ok D_None
+  | "False" ->
-  | "Pair" -> ok D_Pair
+      ok D_False
-  | "Right" -> ok D_Right
+  | "Elt" ->
-  | "Some" -> ok D_Some
+      ok D_Elt
-  | "True" -> ok D_True
+  | "Left" ->
-  | "Unit" -> ok D_Unit
+      ok D_Left
-  | "PACK" -> ok I_PACK
+  | "None" ->
-  | "UNPACK" -> ok I_UNPACK
+      ok D_None
-  | "BLAKE2B" -> ok I_BLAKE2B
+  | "Pair" ->
-  | "SHA256" -> ok I_SHA256
+      ok D_Pair
-  | "SHA512" -> ok I_SHA512
+  | "Right" ->
-  | "ABS" -> ok I_ABS
+      ok D_Right
-  | "ADD" -> ok I_ADD
+  | "Some" ->
-  | "AMOUNT" -> ok I_AMOUNT
+      ok D_Some
-  | "AND" -> ok I_AND
+  | "True" ->
-  | "BALANCE" -> ok I_BALANCE
+      ok D_True
-  | "CAR" -> ok I_CAR
+  | "Unit" ->
-  | "CDR" -> ok I_CDR
+      ok D_Unit
-  | "CHAIN_ID" -> ok I_CHAIN_ID
+  | "PACK" ->
-  | "CHECK_SIGNATURE" -> ok I_CHECK_SIGNATURE
+      ok I_PACK
-  | "COMPARE" -> ok I_COMPARE
+  | "UNPACK" ->
-  | "CONCAT" -> ok I_CONCAT
+      ok I_UNPACK
-  | "CONS" -> ok I_CONS
+  | "BLAKE2B" ->
-  | "CREATE_ACCOUNT" -> ok I_CREATE_ACCOUNT
+      ok I_BLAKE2B
-  | "CREATE_CONTRACT" -> ok I_CREATE_CONTRACT
+  | "SHA256" ->
-  | "IMPLICIT_ACCOUNT" -> ok I_IMPLICIT_ACCOUNT
+      ok I_SHA256
-  | "DIP" -> ok I_DIP
+  | "SHA512" ->
-  | "DROP" -> ok I_DROP
+      ok I_SHA512
-  | "DUP" -> ok I_DUP
+  | "ABS" ->
-  | "EDIV" -> ok I_EDIV
+      ok I_ABS
-  | "EMPTY_BIG_MAP" -> ok I_EMPTY_BIG_MAP
+  | "ADD" ->
-  | "EMPTY_MAP" -> ok I_EMPTY_MAP
+      ok I_ADD
-  | "EMPTY_SET" -> ok I_EMPTY_SET
+  | "AMOUNT" ->
-  | "EQ" -> ok I_EQ
+      ok I_AMOUNT
-  | "EXEC" -> ok I_EXEC
+  | "AND" ->
-  | "APPLY" -> ok I_APPLY
+      ok I_AND
-  | "FAILWITH" -> ok I_FAILWITH
+  | "BALANCE" ->
-  | "GE" -> ok I_GE
+      ok I_BALANCE
-  | "GET" -> ok I_GET
+  | "CAR" ->
-  | "GT" -> ok I_GT
+      ok I_CAR
-  | "HASH_KEY" -> ok I_HASH_KEY
+  | "CDR" ->
-  | "IF" -> ok I_IF
+      ok I_CDR
-  | "IF_CONS" -> ok I_IF_CONS
+  | "CHAIN_ID" ->
-  | "IF_LEFT" -> ok I_IF_LEFT
+      ok I_CHAIN_ID
-  | "IF_NONE" -> ok I_IF_NONE
+  | "CHECK_SIGNATURE" ->
-  | "INT" -> ok I_INT
+      ok I_CHECK_SIGNATURE
-  | "LAMBDA" -> ok I_LAMBDA
+  | "COMPARE" ->
-  | "LE" -> ok I_LE
+      ok I_COMPARE
-  | "LEFT" -> ok I_LEFT
+  | "CONCAT" ->
-  | "LOOP" -> ok I_LOOP
+      ok I_CONCAT
-  | "LSL" -> ok I_LSL
+  | "CONS" ->
-  | "LSR" -> ok I_LSR
+      ok I_CONS
-  | "LT" -> ok I_LT
+  | "CREATE_ACCOUNT" ->
-  | "MAP" -> ok I_MAP
+      ok I_CREATE_ACCOUNT
-  | "MEM" -> ok I_MEM
+  | "CREATE_CONTRACT" ->
-  | "MUL" -> ok I_MUL
+      ok I_CREATE_CONTRACT
-  | "NEG" -> ok I_NEG
+  | "IMPLICIT_ACCOUNT" ->
-  | "NEQ" -> ok I_NEQ
+      ok I_IMPLICIT_ACCOUNT
-  | "NIL" -> ok I_NIL
+  | "DIP" ->
-  | "NONE" -> ok I_NONE
+      ok I_DIP
-  | "NOT" -> ok I_NOT
+  | "DROP" ->
-  | "NOW" -> ok I_NOW
+      ok I_DROP
-  | "OR" -> ok I_OR
+  | "DUP" ->
-  | "PAIR" -> ok I_PAIR
+      ok I_DUP
-  | "PUSH" -> ok I_PUSH
+  | "EDIV" ->
-  | "RIGHT" -> ok I_RIGHT
+      ok I_EDIV
-  | "SIZE" -> ok I_SIZE
+  | "EMPTY_BIG_MAP" ->
-  | "SOME" -> ok I_SOME
+      ok I_EMPTY_BIG_MAP
-  | "SOURCE" -> ok I_SOURCE
+  | "EMPTY_MAP" ->
-  | "SENDER" -> ok I_SENDER
+      ok I_EMPTY_MAP
-  | "SELF" -> ok I_SELF
+  | "EMPTY_SET" ->
-  | "SLICE" -> ok I_SLICE
+      ok I_EMPTY_SET
-  | "STEPS_TO_QUOTA" -> ok I_STEPS_TO_QUOTA
+  | "EQ" ->
-  | "SUB" -> ok I_SUB
+      ok I_EQ
-  | "SWAP" -> ok I_SWAP
+  | "EXEC" ->
-  | "TRANSFER_TOKENS" -> ok I_TRANSFER_TOKENS
+      ok I_EXEC
-  | "SET_DELEGATE" -> ok I_SET_DELEGATE
+  | "APPLY" ->
-  | "UNIT" -> ok I_UNIT
+      ok I_APPLY
-  | "UPDATE" -> ok I_UPDATE
+  | "FAILWITH" ->
-  | "XOR" -> ok I_XOR
+      ok I_FAILWITH
-  | "ITER" -> ok I_ITER
+  | "GE" ->
-  | "LOOP_LEFT" -> ok I_LOOP_LEFT
+      ok I_GE
-  | "ADDRESS" -> ok I_ADDRESS
+  | "GET" ->
-  | "CONTRACT" -> ok I_CONTRACT
+      ok I_GET
-  | "ISNAT" -> ok I_ISNAT
+  | "GT" ->
-  | "CAST" -> ok I_CAST
+      ok I_GT
-  | "RENAME" -> ok I_RENAME
+  | "HASH_KEY" ->
-  | "DIG" -> ok I_DIG
+      ok I_HASH_KEY
-  | "DUG" -> ok I_DUG
+  | "IF" ->
-  | "bool" -> ok T_bool
+      ok I_IF
-  | "contract" -> ok T_contract
+  | "IF_CONS" ->
-  | "int" -> ok T_int
+      ok I_IF_CONS
-  | "key" -> ok T_key
+  | "IF_LEFT" ->
-  | "key_hash" -> ok T_key_hash
+      ok I_IF_LEFT
-  | "lambda" -> ok T_lambda
+  | "IF_NONE" ->
-  | "list" -> ok T_list
+      ok I_IF_NONE
-  | "map" -> ok T_map
+  | "INT" ->
-  | "big_map" -> ok T_big_map
+      ok I_INT
-  | "nat" -> ok T_nat
+  | "LAMBDA" ->
-  | "option" -> ok T_option
+      ok I_LAMBDA
-  | "or" -> ok T_or
+  | "LE" ->
-  | "pair" -> ok T_pair
+      ok I_LE
-  | "set" -> ok T_set
+  | "LEFT" ->
-  | "signature" -> ok T_signature
+      ok I_LEFT
-  | "string" -> ok T_string
+  | "LOOP" ->
-  | "bytes" -> ok T_bytes
+      ok I_LOOP
-  | "mutez" -> ok T_mutez
+  | "LSL" ->
-  | "timestamp" -> ok T_timestamp
+      ok I_LSL
-  | "unit" -> ok T_unit
+  | "LSR" ->
-  | "operation" -> ok T_operation
+      ok I_LSR
-  | "address" -> ok T_address
+  | "LT" ->
-  | "chain_id" -> ok T_chain_id
+      ok I_LT
+  | "MAP" ->
+      ok I_MAP
+  | "MEM" ->
+      ok I_MEM
+  | "MUL" ->
+      ok I_MUL
+  | "NEG" ->
+      ok I_NEG
+  | "NEQ" ->
+      ok I_NEQ
+  | "NIL" ->
+      ok I_NIL
+  | "NONE" ->
+      ok I_NONE
+  | "NOT" ->
+      ok I_NOT
+  | "NOW" ->
+      ok I_NOW
+  | "OR" ->
+      ok I_OR
+  | "PAIR" ->
+      ok I_PAIR
+  | "PUSH" ->
+      ok I_PUSH
+  | "RIGHT" ->
+      ok I_RIGHT
+  | "SIZE" ->
+      ok I_SIZE
+  | "SOME" ->
+      ok I_SOME
+  | "SOURCE" ->
+      ok I_SOURCE
+  | "SENDER" ->
+      ok I_SENDER
+  | "SELF" ->
+      ok I_SELF
+  | "SLICE" ->
+      ok I_SLICE
+  | "STEPS_TO_QUOTA" ->
+      ok I_STEPS_TO_QUOTA
+  | "SUB" ->
+      ok I_SUB
+  | "SWAP" ->
+      ok I_SWAP
+  | "TRANSFER_TOKENS" ->
+      ok I_TRANSFER_TOKENS
+  | "SET_DELEGATE" ->
+      ok I_SET_DELEGATE
+  | "UNIT" ->
+      ok I_UNIT
+  | "UPDATE" ->
+      ok I_UPDATE
+  | "XOR" ->
+      ok I_XOR
+  | "ITER" ->
+      ok I_ITER
+  | "LOOP_LEFT" ->
+      ok I_LOOP_LEFT
+  | "ADDRESS" ->
+      ok I_ADDRESS
+  | "CONTRACT" ->
+      ok I_CONTRACT
+  | "ISNAT" ->
+      ok I_ISNAT
+  | "CAST" ->
+      ok I_CAST
+  | "RENAME" ->
+      ok I_RENAME
+  | "DIG" ->
+      ok I_DIG
+  | "DUG" ->
+      ok I_DUG
+  | "bool" ->
+      ok T_bool
+  | "contract" ->
+      ok T_contract
+  | "int" ->
+      ok T_int
+  | "key" ->
+      ok T_key
+  | "key_hash" ->
+      ok T_key_hash
+  | "lambda" ->
+      ok T_lambda
+  | "list" ->
+      ok T_list
+  | "map" ->
+      ok T_map
+  | "big_map" ->
+      ok T_big_map
+  | "nat" ->
+      ok T_nat
+  | "option" ->
+      ok T_option
+  | "or" ->
+      ok T_or
+  | "pair" ->
+      ok T_pair
+  | "set" ->
+      ok T_set
+  | "signature" ->
+      ok T_signature
+  | "string" ->
+      ok T_string
+  | "bytes" ->
+      ok T_bytes
+  | "mutez" ->
+      ok T_mutez
+  | "timestamp" ->
+      ok T_timestamp
+  | "unit" ->
+      ok T_unit
+  | "operation" ->
+      ok T_operation
+  | "address" ->
+      ok T_address
+  | "chain_id" ->
+      ok T_chain_id
   | n ->
-      if valid_case n then
+      if valid_case n then error (Unknown_primitive_name n)
-        error (Unknown_primitive_name n)
+      else error (Invalid_case n)
-      else
-        error (Invalid_case n)
 
 let prims_of_strings expr =
   let rec convert = function
-    | Int _ | String _ | Bytes _ as expr -> ok expr
+    | (Int _ | String _ | Bytes _) as expr ->
+        ok expr
     | Prim (loc, prim, args, annot) ->
         Error_monad.record_trace
           (Invalid_primitive_name (expr, loc))
-          (prim_of_string prim) >>? fun prim ->
+          (prim_of_string prim)
+        >>? fun prim ->
         List.fold_left
           (fun acc arg ->
-             acc >>? fun args ->
+            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
-             convert arg >>? fun arg ->
+          (ok [])
-             ok (arg :: args))
+          args
-          (ok []) args >>? fun args ->
+        >>? fun args -> ok (Prim (0, prim, List.rev args, annot))
-        ok (Prim (0, prim, List.rev args, annot))
     | Seq (_, args) ->
         List.fold_left
           (fun acc arg ->
-             acc >>? fun args ->
+            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
-             convert arg >>? fun arg ->
+          (ok [])
-             ok (arg :: args))
+          args
-          (ok []) args >>? fun args ->
+        >>? fun args -> ok (Seq (0, List.rev args))
-        ok (Seq (0, List.rev args)) in
+  in
-  convert (root expr) >>? fun expr ->
+  convert (root expr) >>? fun expr -> ok (strip_locations expr)
-  ok (strip_locations expr)
 
 let strings_of_prims expr =
   let rec convert = function
-    | Int _ | String _ | Bytes _ as expr -> expr
+    | (Int _ | String _ | Bytes _) as expr ->
+        expr
     | Prim (_, prim, args, annot) ->
         let prim = string_of_prim prim in
         let args = List.map convert args in
         Prim (0, prim, args, annot)
     | Seq (_, args) ->
         let args = List.map convert args in
-        Seq (0, args) in
+        Seq (0, args)
+  in
   strip_locations (convert (root expr))
 
 let prim_encoding =
   let open Data_encoding in
-  def "michelson.v1.primitives" @@
+  def "michelson.v1.primitives"
-  string_enum [
+  @@ string_enum
-    (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
+       [ (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
          ("parameter", K_parameter);
          ("storage", K_storage);
          ("code", K_code);
@@ -594,42 +829,36 @@ let () =
     `Permanent
     ~id:"michelson_v1.unknown_primitive_name"
     ~title:"Unknown primitive name"
-    ~description:
+    ~description:"In a script or data expression, a primitive was unknown."
-      "In a script or data expression, a primitive was unknown."
     ~pp:(fun ppf n -> Format.fprintf ppf "Unknown primitive %s." n)
     Data_encoding.(obj1 (req "wrong_primitive_name" string))
-    (function
+    (function Unknown_primitive_name got -> Some got | _ -> None)
-      | Unknown_primitive_name got -> Some got
+    (fun got -> Unknown_primitive_name got) ;
-      | _ -> None)
-    (fun got ->
-       Unknown_primitive_name got) ;
   register_error_kind
     `Permanent
     ~id:"michelson_v1.invalid_primitive_name_case"
     ~title:"Invalid primitive name case"
     ~description:
-      "In a script or data expression, a primitive name is \
+      "In a script or data expression, a primitive name is neither uppercase, \
-       neither uppercase, lowercase or capitalized."
+       lowercase or capitalized."
     ~pp:(fun ppf n -> Format.fprintf ppf "Primitive %s has invalid case." n)
     Data_encoding.(obj1 (req "wrong_primitive_name" string))
-    (function
+    (function Invalid_case name -> Some name | _ -> None)
-      | Invalid_case name -> Some name
+    (fun name -> Invalid_case name) ;
-      | _ -> None)
-    (fun name ->
-       Invalid_case name) ;
   register_error_kind
     `Permanent
     ~id:"michelson_v1.invalid_primitive_name"
     ~title:"Invalid primitive name"
     ~description:
-      "In a script or data expression, a primitive name is \
+      "In a script or data expression, a primitive name is unknown or has a \
-       unknown or has a wrong case."
+       wrong case."
     ~pp:(fun ppf _ -> Format.fprintf ppf "Invalid primitive.")
-    Data_encoding.(obj2
+    Data_encoding.(
-                     (req "expression" (Micheline.canonical_encoding ~variant:"generic" string))
+      obj2
+        (req
+           "expression"
+           (Micheline.canonical_encoding ~variant:"generic" string))
         (req "location" Micheline.canonical_location_encoding))
     (function
-      | Invalid_primitive_name (expr, loc) -> Some (expr, loc)
+      | Invalid_primitive_name (expr, loc) -> Some (expr, loc) | _ -> None)
-      | _ -> None)
+    (fun (expr, loc) -> Invalid_primitive_name (expr, loc))
-    (fun (expr, loc) ->
-       Invalid_primitive_name (expr, loc))

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_primitives.mli

@@ -24,8 +24,14 @@
 (*****************************************************************************)
 
 type error += Unknown_primitive_name of string (* `Permanent *)
+
 type error += Invalid_case of string (* `Permanent *)
-type error += Invalid_primitive_name of string Micheline.canonical * Micheline.canonical_location (* `Permanent *)
+
+type error +=
+  | Invalid_primitive_name of
+      string Micheline.canonical * Micheline.canonical_location
+
+(* `Permanent *)
 
 type prim =
   | K_parameter
@@ -153,6 +159,7 @@ val string_of_prim : prim -> string
 
 val prim_of_string : string -> prim tzresult
 
-val prims_of_strings : string Micheline.canonical -> prim Micheline.canonical tzresult
+val prims_of_strings :
+  string Micheline.canonical -> prim Micheline.canonical tzresult
 
 val strings_of_prims : prim Micheline.canonical -> string Micheline.canonical

vendors/ligo-utils/tezos-protocol-alpha/misc.ml

@@ -24,61 +24,56 @@
 (*****************************************************************************)
 
 type 'a lazyt = unit -> 'a
-type 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)
+
+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 = (* [i; i+1; ...; j] *)
+let rec ( --> ) i j =
-  if Compare.Int.(i > j)
+  (* [i; i+1; ...; j] *)
-  then []
+  if Compare.Int.(i > j) then [] else i :: (succ i --> j)
-  else i :: (succ i --> j)
 
-let rec (--->) i j = (* [i; i+1; ...; j] *)
+let rec ( ---> ) i j =
-  if Compare.Int32.(i > j)
+  (* [i; i+1; ...; j] *)
-  then []
+  if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j)
-  else i :: (Int32.succ i ---> j)
 
 let split delim ?(limit = max_int) path =
   let l = String.length path in
   let rec do_slashes acc limit i =
-    if Compare.Int.(i >= l) then
+    if Compare.Int.(i >= l) then List.rev acc
-      List.rev acc
+    else if Compare.Char.(path.[i] = delim) then do_slashes acc limit (i + 1)
-    else if Compare.Char.(String.get path i = delim) then
+    else do_split acc limit i
-      do_slashes acc limit (i + 1)
-    else
-      do_split acc limit i
   and do_split acc limit i =
     if Compare.Int.(limit <= 0) then
-      if Compare.Int.(i = l) then
+      if Compare.Int.(i = l) then List.rev acc
-        List.rev acc
+      else List.rev (String.sub path i (l - i) :: acc)
-      else
+    else do_component acc (pred limit) i i
-        List.rev (String.sub path i (l - i) :: acc)
-    else
-      do_component acc (pred limit) i i
   and do_component acc limit i j =
     if Compare.Int.(j >= l) then
-      if Compare.Int.(i = j) then
+      if Compare.Int.(i = j) then List.rev acc
-        List.rev acc
+      else List.rev (String.sub path i (j - i) :: acc)
-      else
+    else if Compare.Char.(path.[j] = delim) then
-        List.rev (String.sub path i (j - i) :: acc)
-    else if Compare.Char.(String.get path j = delim) then
       do_slashes (String.sub path i (j - i) :: acc) limit j
-    else
+    else do_component acc limit i (j + 1)
-      do_component acc limit i (j + 1) in
+  in
-  if Compare.Int.(limit > 0) then
+  if Compare.Int.(limit > 0) then do_slashes [] limit 0 else [path]
-    do_slashes [] limit 0
-  else
-    [ path ]
 
 let pp_print_paragraph ppf description =
-  Format.fprintf ppf "@[%a@]"
+  Format.fprintf
+    ppf
+    "@[%a@]"
     Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)
     (split ' ' description)
 
 let take n l =
   let rec loop acc n = function
-    | xs when Compare.Int.(n <= 0) -> Some (List.rev acc, xs)
+    | xs when Compare.Int.(n <= 0) ->
-    | [] -> None
+        Some (List.rev acc, xs)
-    | x :: xs -> loop (x :: acc) (n-1) xs in
+    | [] ->
+        None
+    | x :: xs ->
+        loop (x :: acc) (n - 1) xs
+  in
   loop [] n l
 
 let remove_prefix ~prefix s =
@@ -86,10 +81,12 @@ let remove_prefix ~prefix s =
   let n = String.length s in
   if Compare.Int.(n >= x) && Compare.String.(String.sub s 0 x = prefix) then
     Some (String.sub s x (n - x))
-  else
+  else None
-    None
 
 let rec remove_elem_from_list nb = function
-  | [] -> []
+  | [] ->
-  | l when Compare.Int.(nb <= 0) -> l
+      []
-  | _ :: tl -> remove_elem_from_list (nb - 1) tl
+  | l when Compare.Int.(nb <= 0) ->
+      l
+  | _ :: tl ->
+      remove_elem_from_list (nb - 1) tl

vendors/ligo-utils/tezos-protocol-alpha/misc.mli

@@ -26,18 +26,21 @@
 (** {2 Helper functions} *)
 
 type 'a lazyt = unit -> 'a
-type 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)
+
+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
 
 (** Include bounds *)
 val ( --> ) : int -> int -> int list
+
 val ( ---> ) : Int32.t -> Int32.t -> Int32.t list
 
 val pp_print_paragraph : Format.formatter -> string -> unit
 
 val take : int -> 'a list -> ('a list * 'a list) option
 
-(** Some (input with [prefix] removed), if string has [prefix], else [None] **)
+(** Some (input with [prefix] removed), if string has [prefix], else [None] *)
 val remove_prefix : prefix:string -> string -> string option
 
 (** [remove nb list] remove the first [nb] elements from the list [list]. *)

vendors/ligo-utils/tezos-protocol-alpha/nonce_hash.ml

@@ -26,12 +26,16 @@
 (* 32 *)
 let nonce_hash = "\069\220\169" (* nce(53) *)
 
-include Blake2B.Make(Base58)(struct
+include Blake2B.Make
+          (Base58)
+          (struct
             let name = "cycle_nonce"
+
             let title = "A nonce hash"
+
             let b58check_prefix = nonce_hash
+
             let size = None
           end)
 
-let () =
+let () = Base58.check_encoded_prefix b58check_encoding "nce" 53
-  Base58.check_encoded_prefix b58check_encoding "nce" 53

vendors/ligo-utils/tezos-protocol-alpha/nonce_storage.ml

@@ -24,7 +24,9 @@
 (*****************************************************************************)
 
 type t = Seed_repr.nonce
+
 type nonce = t
+
 let encoding = Seed_repr.nonce_encoding
 
 type error +=
@@ -59,8 +61,7 @@ let () =
     ~id:"nonce.previously_revealed"
     ~title:"Previously revealed nonce"
     ~description:"Duplicated revelation for a nonce."
-    ~pp: (fun ppf () ->
+    ~pp:(fun ppf () -> Format.fprintf ppf "This nonce was previously revealed")
-        Format.fprintf ppf "This nonce was previously revealed")
     Data_encoding.unit
     (function Previously_revealed_nonce -> Some () | _ -> None)
     (fun () -> Previously_revealed_nonce) ;
@@ -68,9 +69,13 @@ let () =
     `Branch
     ~id:"nonce.unexpected"
     ~title:"Unexpected nonce"
-    ~description:"The provided nonce is inconsistent with the committed nonce hash."
+    ~description:
+      "The provided nonce is inconsistent with the committed nonce hash."
     ~pp:(fun ppf () ->
-        Format.fprintf ppf "This nonce revelation is invalid (inconsistent with the committed hash)")
+      Format.fprintf
+        ppf
+        "This nonce revelation is invalid (inconsistent with the committed \
+         hash)")
     Data_encoding.unit
     (function Unexpected_nonce -> Some () | _ -> None)
     (fun () -> Unexpected_nonce)
@@ -80,28 +85,34 @@ let () =
 let get_unrevealed ctxt level =
   let cur_level = Level_storage.current ctxt in
   match Cycle_repr.pred cur_level.cycle with
-  | None -> fail Too_early_revelation (* no revelations during cycle 0 *)
+  | None ->
-  | Some revealed_cycle ->
+      fail Too_early_revelation (* no revelations during cycle 0 *)
+  | Some revealed_cycle -> (
       if Cycle_repr.(revealed_cycle < level.Level_repr.cycle) then
         fail Too_early_revelation
       else if Cycle_repr.(level.Level_repr.cycle < revealed_cycle) then
         fail Too_late_revelation
       else
-        Storage.Seed.Nonce.get ctxt level >>=? function
+        Storage.Seed.Nonce.get ctxt level
-        | Revealed _ -> fail Previously_revealed_nonce
+        >>=? function
-        | Unrevealed status -> return status
+        | Revealed _ ->
+            fail Previously_revealed_nonce
+        | Unrevealed status ->
+            return status )
 
 let record_hash ctxt unrevealed =
   let level = Level_storage.current ctxt in
   Storage.Seed.Nonce.init ctxt level (Unrevealed unrevealed)
 
 let reveal ctxt level nonce =
-  get_unrevealed ctxt level >>=? fun unrevealed ->
+  get_unrevealed ctxt level
+  >>=? fun unrevealed ->
   fail_unless
     (Seed_repr.check_hash nonce unrevealed.nonce_hash)
-    Unexpected_nonce >>=? fun () ->
+    Unexpected_nonce
-  Storage.Seed.Nonce.set ctxt level (Revealed nonce) >>=? fun ctxt ->
+  >>=? fun () ->
-  return ctxt
+  Storage.Seed.Nonce.set ctxt level (Revealed nonce)
+  >>=? fun ctxt -> return ctxt
 
 type unrevealed = Storage.Seed.unrevealed_nonce = {
   nonce_hash : Nonce_hash.t;
@@ -117,5 +128,7 @@ type status = Storage.Seed.nonce_status =
 let get = Storage.Seed.Nonce.get
 
 let of_bytes = Seed_repr.make_nonce
+
 let hash = Seed_repr.hash
+
 let check_hash = Seed_repr.check_hash

vendors/ligo-utils/tezos-protocol-alpha/nonce_storage.mli

@@ -30,7 +30,9 @@ type error +=
   | Unexpected_nonce
 
 type t = Seed_repr.nonce
+
 type nonce = t
+
 val encoding : nonce Data_encoding.t
 
 type unrevealed = Storage.Seed.unrevealed_nonce = {
@@ -40,18 +42,17 @@ type unrevealed = Storage.Seed.unrevealed_nonce = {
   fees : Tez_repr.t;
 }
 
-type status =
+type status = Unrevealed of unrevealed | Revealed of Seed_repr.nonce
-  | Unrevealed of unrevealed
-  | Revealed of Seed_repr.nonce
 
 val get : Raw_context.t -> Level_repr.t -> status tzresult Lwt.t
 
-val record_hash:
+val record_hash : Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t
-  Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t
 
 val reveal :
   Raw_context.t -> Level_repr.t -> nonce -> Raw_context.t tzresult Lwt.t
 
 val of_bytes : MBytes.t -> nonce tzresult
+
 val hash : nonce -> Nonce_hash.t
+
 val check_hash : nonce -> Nonce_hash.t -> bool

vendors/ligo-utils/tezos-protocol-alpha/operation_repr.mli

@@ -27,28 +27,35 @@
 
 module Kind : sig
   type seed_nonce_revelation = Seed_nonce_revelation_kind
+
   type double_endorsement_evidence = Double_endorsement_evidence_kind
+
   type double_baking_evidence = Double_baking_evidence_kind
+
   type activate_account = Activate_account_kind
+
   type endorsement = Endorsement_kind
+
   type proposals = Proposals_kind
+
   type ballot = Ballot_kind
+
   type reveal = Reveal_kind
+
   type transaction = Transaction_kind
+
   type origination = Origination_kind
+
   type delegation = Delegation_kind
+
   type 'a manager =
     | Reveal_manager_kind : reveal manager
     | Transaction_manager_kind : transaction manager
     | Origination_manager_kind : origination manager
     | Delegation_manager_kind : delegation manager
-
 end
 
-type raw = Operation.t = {
+type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}
-  shell: Operation.shell_header ;
-  proto: MBytes.t ;
-}
 
 val raw_encoding : raw Data_encoding.t
 
@@ -64,40 +71,45 @@ and 'kind protocol_data = {
 
 and _ contents_list =
   | Single : 'kind contents -> 'kind contents_list
-  | Cons : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->
+  | Cons :
-    (('kind * 'rest) Kind.manager ) contents_list
+      'kind Kind.manager contents * 'rest Kind.manager contents_list
+      -> ('kind * 'rest) Kind.manager contents_list
 
 and _ contents =
-  | Endorsement : {
+  | Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents
-      level: Raw_level_repr.t ;
-    } -> Kind.endorsement contents
   | Seed_nonce_revelation : {
       level : Raw_level_repr.t;
       nonce : Seed_repr.nonce;
-    } -> Kind.seed_nonce_revelation contents
+    }
+      -> Kind.seed_nonce_revelation contents
   | Double_endorsement_evidence : {
       op1 : Kind.endorsement operation;
       op2 : Kind.endorsement operation;
-    } -> Kind.double_endorsement_evidence contents
+    }
+      -> Kind.double_endorsement_evidence contents
   | Double_baking_evidence : {
       bh1 : Block_header_repr.t;
       bh2 : Block_header_repr.t;
-    } -> Kind.double_baking_evidence contents
+    }
+      -> Kind.double_baking_evidence contents
   | Activate_account : {
       id : Ed25519.Public_key_hash.t;
       activation_code : Blinded_public_key_hash.activation_code;
-    } -> Kind.activate_account contents
+    }
+      -> Kind.activate_account contents
   | Proposals : {
       source : Signature.Public_key_hash.t;
       period : Voting_period_repr.t;
       proposals : Protocol_hash.t list;
-    } -> Kind.proposals contents
+    }
+      -> Kind.proposals contents
   | Ballot : {
       source : Signature.Public_key_hash.t;
       period : Voting_period_repr.t;
       proposal : Protocol_hash.t;
       ballot : Vote_repr.ballot;
-    } -> Kind.ballot contents
+    }
+      -> Kind.ballot contents
   | Manager_operation : {
       source : Signature.Public_key_hash.t;
       fee : Tez_repr.tez;
@@ -105,7 +117,8 @@ and _ contents =
       operation : 'kind manager_operation;
       gas_limit : Z.t;
       storage_limit : Z.t;
-    } -> 'kind Kind.manager contents
+    }
+      -> 'kind Kind.manager contents
 
 and _ manager_operation =
   | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
@@ -114,15 +127,18 @@ and _ manager_operation =
       parameters : Script_repr.lazy_expr;
       entrypoint : string;
       destination : Contract_repr.contract;
-    } -> Kind.transaction manager_operation
+    }
+      -> Kind.transaction manager_operation
   | Origination : {
       delegate : Signature.Public_key_hash.t option;
       script : Script_repr.t;
       credit : Tez_repr.tez;
       preorigination : Contract_repr.t option;
-    } -> Kind.origination manager_operation
+    }
+      -> Kind.origination manager_operation
   | Delegation :
-      Signature.Public_key_hash.t option -> Kind.delegation manager_operation
+      Signature.Public_key_hash.t option
+      -> Kind.delegation manager_operation
 
 and counter = Z.t
 
@@ -135,13 +151,13 @@ type 'kind internal_operation = {
 type packed_manager_operation =
   | Manager : 'kind manager_operation -> packed_manager_operation
 
-type packed_contents =
+type packed_contents = Contents : 'kind contents -> packed_contents
-  | Contents : 'kind contents -> packed_contents
 
 type packed_contents_list =
   | Contents_list : 'kind contents_list -> packed_contents_list
 
 val of_list : packed_contents list -> packed_contents_list
+
 val to_list : packed_contents_list -> packed_contents list
 
 type packed_protocol_data =
@@ -160,71 +176,94 @@ type packed_internal_operation =
 val manager_kind : 'kind manager_operation -> 'kind Kind.manager
 
 val encoding : packed_operation Data_encoding.t
+
 val contents_encoding : packed_contents Data_encoding.t
+
 val contents_list_encoding : packed_contents_list Data_encoding.t
+
 val protocol_data_encoding : packed_protocol_data Data_encoding.t
-val unsigned_operation_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t
+
+val unsigned_operation_encoding :
+  (Operation.shell_header * packed_contents_list) Data_encoding.t
 
 val raw : _ operation -> raw
 
 val hash_raw : raw -> Operation_hash.t
+
 val hash : _ operation -> Operation_hash.t
+
 val hash_packed : packed_operation -> Operation_hash.t
 
 val acceptable_passes : packed_operation -> int list
 
 type error += Missing_signature (* `Permanent *)
+
 type error += Invalid_signature (* `Permanent *)
 
 val check_signature :
   Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult Lwt.t
+
 val check_signature_sync :
   Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult
 
-
+val internal_operation_encoding : packed_internal_operation Data_encoding.t
-val internal_operation_encoding:
-  packed_internal_operation Data_encoding.t
 
 type ('a, 'b) eq = Eq : ('a, 'a) eq
+
 val equal : 'a operation -> 'b operation -> ('a, 'b) eq option
 
 module Encoding : sig
-
   type 'b case =
-      Case : { tag: int ;
+    | Case : {
+        tag : int;
         name : string;
         encoding : 'a Data_encoding.t;
         select : packed_contents -> 'b contents option;
         proj : 'b contents -> 'a;
-               inj: 'a -> 'b contents } -> 'b case
+        inj : 'a -> 'b contents;
+      }
+        -> 'b case
 
   val endorsement_case : Kind.endorsement case
+
   val seed_nonce_revelation_case : Kind.seed_nonce_revelation case
+
   val double_endorsement_evidence_case : Kind.double_endorsement_evidence case
+
   val double_baking_evidence_case : Kind.double_baking_evidence case
+
   val activate_account_case : Kind.activate_account case
+
   val proposals_case : Kind.proposals case
+
   val ballot_case : Kind.ballot case
+
   val reveal_case : Kind.reveal Kind.manager case
+
   val transaction_case : Kind.transaction Kind.manager case
+
   val origination_case : Kind.origination Kind.manager case
+
   val delegation_case : Kind.delegation Kind.manager case
 
   module Manager_operations : sig
-
     type 'b case =
-        MCase : { tag: int ;
+      | MCase : {
+          tag : int;
           name : string;
           encoding : 'a Data_encoding.t;
           select : packed_manager_operation -> 'kind manager_operation option;
           proj : 'kind manager_operation -> 'a;
-                  inj: 'a -> 'kind manager_operation } -> 'kind case
+          inj : 'a -> 'kind manager_operation;
+        }
+          -> 'kind case
 
     val reveal_case : Kind.reveal case
+
     val transaction_case : Kind.transaction case
+
     val origination_case : Kind.origination case
+
     val delegation_case : Kind.delegation case
-
   end
-
 end

vendors/ligo-utils/tezos-protocol-alpha/parameters_repr.ml

@@ -47,33 +47,36 @@ type t = {
 let bootstrap_account_encoding =
   let open Data_encoding in
   union
-    [ case (Tag 0) ~title:"Public_key_known"
+    [ case
-        (tup2
+        (Tag 0)
-           Signature.Public_key.encoding
+        ~title:"Public_key_known"
-           Tez_repr.encoding)
+        (tup2 Signature.Public_key.encoding Tez_repr.encoding)
         (function
           | {public_key_hash; public_key = Some public_key; amount} ->
-              assert (Signature.Public_key_hash.equal
+              assert (
+                Signature.Public_key_hash.equal
                   (Signature.Public_key.hash public_key)
                   public_key_hash ) ;
               Some (public_key, amount)
-          | { public_key = None }  -> None)
+          | {public_key = None} ->
+              None)
         (fun (public_key, amount) ->
-           { public_key = Some public_key ;
+          {
+            public_key = Some public_key;
             public_key_hash = Signature.Public_key.hash public_key;
-             amount }) ;
+            amount;
-      case (Tag 1) ~title:"Public_key_unknown"
+          });
-        (tup2
+      case
-           Signature.Public_key_hash.encoding
+        (Tag 1)
-           Tez_repr.encoding)
+        ~title:"Public_key_unknown"
+        (tup2 Signature.Public_key_hash.encoding Tez_repr.encoding)
         (function
           | {public_key_hash; public_key = None; amount} ->
               Some (public_key_hash, amount)
-          | { public_key = Some _ }  -> None)
+          | {public_key = Some _} ->
+              None)
         (fun (public_key_hash, amount) ->
-           { public_key = None ;
+          {public_key = None; public_key_hash; amount}) ]
-             public_key_hash ;
-             amount }) ]
 
 let bootstrap_contract_encoding =
   let open Data_encoding in
@@ -88,16 +91,32 @@ let bootstrap_contract_encoding =
 let encoding =
   let open Data_encoding in
   conv
-    (fun { bootstrap_accounts ; bootstrap_contracts ; commitments ; constants ;
+    (fun { bootstrap_accounts;
-           security_deposit_ramp_up_cycles ; no_reward_cycles } ->
+           bootstrap_contracts;
-      ((bootstrap_accounts, bootstrap_contracts, commitments,
+           commitments;
-        security_deposit_ramp_up_cycles, no_reward_cycles),
+           constants;
+           security_deposit_ramp_up_cycles;
+           no_reward_cycles } ->
+      ( ( bootstrap_accounts,
+          bootstrap_contracts,
+          commitments,
+          security_deposit_ramp_up_cycles,
+          no_reward_cycles ),
         constants ))
-    (fun ( (bootstrap_accounts, bootstrap_contracts, commitments,
+    (fun ( ( bootstrap_accounts,
-            security_deposit_ramp_up_cycles, no_reward_cycles),
+             bootstrap_contracts,
+             commitments,
+             security_deposit_ramp_up_cycles,
+             no_reward_cycles ),
            constants ) ->
-      { bootstrap_accounts ; bootstrap_contracts ; commitments ; constants ;
+      {
-        security_deposit_ramp_up_cycles ; no_reward_cycles })
+        bootstrap_accounts;
+        bootstrap_contracts;
+        commitments;
+        constants;
+        security_deposit_ramp_up_cycles;
+        no_reward_cycles;
+      })
     (merge_objs
        (obj5
           (req "bootstrap_accounts" (list bootstrap_account_encoding))
@@ -106,253 +125,3 @@ let encoding =
           (opt "security_deposit_ramp_up_cycles" int31)
           (opt "no_reward_cycles" int31))
        Constants_repr.parametric_encoding)
-
-
-(* Only for migration from 004 to 005 *)
-
-module Proto_004 = struct
-
-  type parametric = {
-    preserved_cycles: int ;
-    blocks_per_cycle: int32 ;
-    blocks_per_commitment: int32 ;
-    blocks_per_roll_snapshot: int32 ;
-    blocks_per_voting_period: int32 ;
-    time_between_blocks: Period_repr.t list ;
-    endorsers_per_block: int ;
-    hard_gas_limit_per_operation: Z.t ;
-    hard_gas_limit_per_block: Z.t ;
-    proof_of_work_threshold: int64 ;
-    tokens_per_roll: Tez_repr.t ;
-    michelson_maximum_type_size: int;
-    seed_nonce_revelation_tip: Tez_repr.t ;
-    origination_size: int ;
-    block_security_deposit: Tez_repr.t ;
-    endorsement_security_deposit: Tez_repr.t ;
-    block_reward: Tez_repr.t ;
-    endorsement_reward: Tez_repr.t ;
-    cost_per_byte: Tez_repr.t ;
-    hard_storage_limit_per_operation: Z.t ;
-    test_chain_duration: int64 ;  (* in seconds *)
-  }
-
-  let default = {
-    preserved_cycles = 5 ;
-    blocks_per_cycle = 4096l ;
-    blocks_per_commitment = 32l ;
-    blocks_per_roll_snapshot = 256l ;
-    blocks_per_voting_period = 32768l ;
-    time_between_blocks =
-      List.map Period_repr.of_seconds_exn [ 60L ; 75L ] ;
-    endorsers_per_block = 32 ;
-    hard_gas_limit_per_operation = Z.of_int 800_000 ;
-    hard_gas_limit_per_block = Z.of_int 8_000_000 ;
-    proof_of_work_threshold =
-      Int64.(sub (shift_left 1L 46) 1L) ;
-    tokens_per_roll =
-      Tez_repr.(mul_exn one 8_000) ;
-    michelson_maximum_type_size = 1000 ;
-    seed_nonce_revelation_tip = begin
-      match Tez_repr.(one /? 8L) with
-      | Ok c -> c
-      | Error _ -> assert false
-    end ;
-    origination_size = 257 ;
-    block_security_deposit = Tez_repr.(mul_exn one 512) ;
-    endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
-    block_reward = Tez_repr.(mul_exn one 16) ;
-    endorsement_reward = Tez_repr.(mul_exn one 2) ;
-    hard_storage_limit_per_operation = Z.of_int 60_000 ;
-    cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
-    test_chain_duration = Int64.mul 32768L 60L;
-  }
-
-  (* This encoding is used to read configuration files (e.g. sandbox.json)
-     where some fields can be missing, in that case they are replaced by
-     the default. *)
-  let constants_encoding =
-    let open Data_encoding in
-    conv
-      (fun (c : parametric) ->
-         let module Compare_time_between_blocks = Compare.List (Period_repr) in
-         let module Compare_keys = Compare.List (Ed25519.Public_key) in
-         let opt (=) def v = if def = v then None else Some v in
-         let preserved_cycles =
-           opt Compare.Int.(=)
-             default.preserved_cycles c.preserved_cycles
-         and blocks_per_cycle =
-           opt Compare.Int32.(=)
-             default.blocks_per_cycle c.blocks_per_cycle
-         and blocks_per_commitment =
-           opt Compare.Int32.(=)
-             default.blocks_per_commitment c.blocks_per_commitment
-         and blocks_per_roll_snapshot =
-           opt Compare.Int32.(=)
-             default.blocks_per_roll_snapshot c.blocks_per_roll_snapshot
-         and blocks_per_voting_period =
-           opt Compare.Int32.(=)
-             default.blocks_per_voting_period c.blocks_per_voting_period
-         and time_between_blocks =
-           opt Compare_time_between_blocks.(=)
-             default.time_between_blocks c.time_between_blocks
-         and endorsers_per_block =
-           opt Compare.Int.(=)
-             default.endorsers_per_block c.endorsers_per_block
-         and hard_gas_limit_per_operation =
-           opt Compare.Z.(=)
-             default.hard_gas_limit_per_operation c.hard_gas_limit_per_operation
-         and hard_gas_limit_per_block =
-           opt Compare.Z.(=)
-             default.hard_gas_limit_per_block c.hard_gas_limit_per_block
-         and proof_of_work_threshold =
-           opt Compare.Int64.(=)
-             default.proof_of_work_threshold c.proof_of_work_threshold
-         and tokens_per_roll =
-           opt Tez_repr.(=)
-             default.tokens_per_roll c.tokens_per_roll
-         and michelson_maximum_type_size =
-           opt Compare.Int.(=)
-             default.michelson_maximum_type_size c.michelson_maximum_type_size
-         and seed_nonce_revelation_tip =
-           opt Tez_repr.(=)
-             default.seed_nonce_revelation_tip c.seed_nonce_revelation_tip
-         and origination_size =
-           opt Compare.Int.(=)
-             default.origination_size c.origination_size
-         and block_security_deposit =
-           opt Tez_repr.(=)
-             default.block_security_deposit c.block_security_deposit
-         and endorsement_security_deposit =
-           opt Tez_repr.(=)
-             default.endorsement_security_deposit c.endorsement_security_deposit
-         and block_reward =
-           opt Tez_repr.(=)
-             default.block_reward c.block_reward
-         and endorsement_reward =
-           opt Tez_repr.(=)
-             default.endorsement_reward c.endorsement_reward
-         and cost_per_byte =
-           opt Tez_repr.(=)
-             default.cost_per_byte c.cost_per_byte
-         and hard_storage_limit_per_operation =
-           opt Compare.Z.(=)
-             default.hard_storage_limit_per_operation c.hard_storage_limit_per_operation
-         and test_chain_duration =
-           opt Compare.Int64.(=)
-             default.test_chain_duration c.test_chain_duration
-         in
-         (( preserved_cycles,
-            blocks_per_cycle,
-            blocks_per_commitment,
-            blocks_per_roll_snapshot,
-            blocks_per_voting_period,
-            time_between_blocks,
-            endorsers_per_block,
-            hard_gas_limit_per_operation,
-            hard_gas_limit_per_block),
-          ((proof_of_work_threshold,
-            tokens_per_roll,
-            michelson_maximum_type_size,
-            seed_nonce_revelation_tip,
-            origination_size,
-            block_security_deposit,
-            endorsement_security_deposit,
-            block_reward),
-           (endorsement_reward,
-            cost_per_byte,
-            hard_storage_limit_per_operation,
-            test_chain_duration))))
-      (fun (( preserved_cycles,
-              blocks_per_cycle,
-              blocks_per_commitment,
-              blocks_per_roll_snapshot,
-              blocks_per_voting_period,
-              time_between_blocks,
-              endorsers_per_block,
-              hard_gas_limit_per_operation,
-              hard_gas_limit_per_block),
-            ((proof_of_work_threshold,
-              tokens_per_roll,
-              michelson_maximum_type_size,
-              seed_nonce_revelation_tip,
-              origination_size,
-              block_security_deposit,
-              endorsement_security_deposit,
-              block_reward),
-             (endorsement_reward,
-              cost_per_byte,
-              hard_storage_limit_per_operation,
-              test_chain_duration))) ->
-        let unopt def = function None -> def | Some v -> v in
-        { preserved_cycles =
-            unopt default.preserved_cycles preserved_cycles ;
-          blocks_per_cycle =
-            unopt default.blocks_per_cycle blocks_per_cycle ;
-          blocks_per_commitment =
-            unopt default.blocks_per_commitment blocks_per_commitment ;
-          blocks_per_roll_snapshot =
-            unopt default.blocks_per_roll_snapshot blocks_per_roll_snapshot ;
-          blocks_per_voting_period =
-            unopt default.blocks_per_voting_period blocks_per_voting_period ;
-          time_between_blocks =
-            unopt default.time_between_blocks @@
-            time_between_blocks ;
-          endorsers_per_block =
-            unopt default.endorsers_per_block endorsers_per_block ;
-          hard_gas_limit_per_operation =
-            unopt default.hard_gas_limit_per_operation hard_gas_limit_per_operation ;
-          hard_gas_limit_per_block =
-            unopt default.hard_gas_limit_per_block hard_gas_limit_per_block ;
-          proof_of_work_threshold =
-            unopt default.proof_of_work_threshold proof_of_work_threshold ;
-          tokens_per_roll =
-            unopt default.tokens_per_roll tokens_per_roll ;
-          michelson_maximum_type_size =
-            unopt default.michelson_maximum_type_size michelson_maximum_type_size ;
-          seed_nonce_revelation_tip =
-            unopt default.seed_nonce_revelation_tip seed_nonce_revelation_tip ;
-          origination_size =
-            unopt default.origination_size origination_size ;
-          block_security_deposit =
-            unopt default.block_security_deposit block_security_deposit ;
-          endorsement_security_deposit =
-            unopt default.endorsement_security_deposit endorsement_security_deposit ;
-          block_reward =
-            unopt default.block_reward block_reward ;
-          endorsement_reward =
-            unopt default.endorsement_reward endorsement_reward ;
-          cost_per_byte =
-            unopt default.cost_per_byte cost_per_byte ;
-          hard_storage_limit_per_operation =
-            unopt default.hard_storage_limit_per_operation hard_storage_limit_per_operation ;
-          test_chain_duration =
-            unopt default.test_chain_duration test_chain_duration ;
-        } )
-      (merge_objs
-         (obj9
-            (opt "preserved_cycles" uint8)
-            (opt "blocks_per_cycle" int32)
-            (opt "blocks_per_commitment" int32)
-            (opt "blocks_per_roll_snapshot" int32)
-            (opt "blocks_per_voting_period" int32)
-            (opt "time_between_blocks" (list Period_repr.encoding))
-            (opt "endorsers_per_block" uint16)
-            (opt "hard_gas_limit_per_operation" z)
-            (opt "hard_gas_limit_per_block" z))
-         (merge_objs
-            (obj8
-               (opt "proof_of_work_threshold" int64)
-               (opt "tokens_per_roll" Tez_repr.encoding)
-               (opt "michelson_maximum_type_size" uint16)
-               (opt "seed_nonce_revelation_tip" Tez_repr.encoding)
-               (opt "origination_size" int31)
-               (opt "block_security_deposit" Tez_repr.encoding)
-               (opt "endorsement_security_deposit" Tez_repr.encoding)
-               (opt "block_reward" Tez_repr.encoding))
-            (obj4
-               (opt "endorsement_reward" Tez_repr.encoding)
-               (opt "cost_per_byte" Tez_repr.encoding)
-               (opt "hard_storage_limit_per_operation" z)
-               (opt "test_chain_duration" int64))))
-
-end

vendors/ligo-utils/tezos-protocol-alpha/parameters_repr.mli

@@ -45,34 +45,3 @@ type t = {
 }
 
 val encoding : t Data_encoding.t
-
-
-(* Only for migration from 004 to 005 *)
-
-module Proto_004 : sig
-  type parametric = {
-    preserved_cycles: int ;
-    blocks_per_cycle: int32 ;
-    blocks_per_commitment: int32 ;
-    blocks_per_roll_snapshot: int32 ;
-    blocks_per_voting_period: int32 ;
-    time_between_blocks: Period_repr.t list ;
-    endorsers_per_block: int ;
-    hard_gas_limit_per_operation: Z.t ;
-    hard_gas_limit_per_block: Z.t ;
-    proof_of_work_threshold: int64 ;
-    tokens_per_roll: Tez_repr.t ;
-    michelson_maximum_type_size: int;
-    seed_nonce_revelation_tip: Tez_repr.t ;
-    origination_size: int ;
-    block_security_deposit: Tez_repr.t ;
-    endorsement_security_deposit: Tez_repr.t ;
-    block_reward: Tez_repr.t ;
-    endorsement_reward: Tez_repr.t ;
-    cost_per_byte: Tez_repr.t ;
-    hard_storage_limit_per_operation: Z.t ;
-    test_chain_duration: int64 ;
-  }
-
-  val constants_encoding: parametric Data_encoding.t
-end

vendors/ligo-utils/tezos-protocol-alpha/period_repr.ml

@@ -24,8 +24,11 @@
 (*****************************************************************************)
 
 type t = Int64.t
+
 type period = t
+
 include (Compare.Int64 : Compare.S with type t := t)
+
 let encoding = Data_encoding.int64
 
 let rpc_arg = RPC_arg.int64
@@ -33,8 +36,7 @@ let rpc_arg = RPC_arg.int64
 let pp ppf v = Format.fprintf ppf "%Ld" v
 
 type error += (* `Permanent *)
-  | Malformed_period
+                Malformed_period | Invalid_arg
-  | Invalid_arg
 
 let () =
   let open Data_encoding in
@@ -60,22 +62,26 @@ let () =
     (fun () -> Invalid_arg)
 
 let of_seconds t =
-  if Compare.Int64.(t >= 0L)
+  if Compare.Int64.(t >= 0L) then ok t else error Malformed_period
-  then ok t
+
-  else error Malformed_period
 let to_seconds t = t
+
 let of_seconds_exn t =
   match of_seconds t with
-  | Ok t -> t
+  | Ok t ->
-  | _ -> invalid_arg "Period.of_seconds_exn"
+      t
+  | _ ->
+      invalid_arg "Period.of_seconds_exn"
 
 let mult i p =
   (* TODO check overflow *)
-  if Compare.Int32.(i < 0l)
+  if Compare.Int32.(i < 0l) then error Invalid_arg
-  then error Invalid_arg
   else ok (Int64.mul (Int64.of_int32 i) p)
 
 let zero = of_seconds_exn 0L
+
 let one_second = of_seconds_exn 1L
+
 let one_minute = of_seconds_exn 60L
+
 let one_hour = of_seconds_exn 3600L

vendors/ligo-utils/tezos-protocol-alpha/period_repr.mli

@@ -24,12 +24,16 @@
 (*****************************************************************************)
 
 type t
-type period = t
-include Compare.S with type t := t
-val encoding : period Data_encoding.t
-val rpc_arg : period RPC_arg.t
-val pp: Format.formatter -> period -> unit
 
+type period = t
+
+include Compare.S with type t := t
+
+val encoding : period Data_encoding.t
+
+val rpc_arg : period RPC_arg.t
+
+val pp : Format.formatter -> period -> unit
 
 val to_seconds : period -> int64
 
@@ -43,6 +47,9 @@ val of_seconds_exn : int64 -> period
 val mult : int32 -> period -> period tzresult
 
 val zero : period
+
 val one_second : period
+
 val one_minute : period
+
 val one_hour : period

vendors/ligo-utils/tezos-protocol-alpha/qty_repr.ml

@@ -35,18 +35,28 @@ module type S = sig
     | Subtraction_underflow of qty * qty (* `Temporary *)
     | Multiplication_overflow of qty * int64 (* `Temporary *)
     | Negative_multiplicator of qty * int64 (* `Temporary *)
-    | Invalid_divisor of qty * int64 (* `Temporary *)
+    | Invalid_divisor of qty * int64
+
+  (* `Temporary *)
 
   val id : string
+
   val zero : qty
+
   val one_mutez : qty
+
   val one_cent : qty
+
   val fifty_cents : qty
+
   val one : qty
 
   val ( -? ) : qty -> qty -> qty tzresult
+
   val ( +? ) : qty -> qty -> qty tzresult
+
   val ( *? ) : qty -> int64 -> qty tzresult
+
   val ( /? ) : qty -> int64 -> qty tzresult
 
   val to_mutez : qty -> int64
@@ -73,12 +83,11 @@ module type S = sig
   val pp : Format.formatter -> qty -> unit
 
   val of_string : string -> qty option
-  val to_string: qty -> string
 
+  val to_string : qty -> string
 end
 
 module Make (T : QTY) : S = struct
-
   type qty = int64 (* invariant: positive *)
 
   type error +=
@@ -86,16 +95,24 @@ module Make (T: QTY) : S = struct
     | Subtraction_underflow of qty * qty (* `Temporary *)
     | Multiplication_overflow of qty * int64 (* `Temporary *)
     | Negative_multiplicator of qty * int64 (* `Temporary *)
-    | Invalid_divisor of qty * int64 (* `Temporary *)
+    | Invalid_divisor of qty * int64
+
+  (* `Temporary *)
 
   include Compare.Int64
+
   let zero = 0L
+
   (* all other constant are defined from the value of one micro tez *)
   let one_mutez = 1L
+
   let one_cent = Int64.mul one_mutez 10_000L
+
   let fifty_cents = Int64.mul one_cent 50L
+
   (* 1 tez = 100 cents = 1_000_000 mutez *)
   let one = Int64.mul one_cent 100L
+
   let id = T.id
 
   let of_string s =
@@ -103,143 +120,130 @@ module Make (T: QTY) : S = struct
       | hd :: tl ->
           let len = String.length hd in
           Compare.Int.(
-            len <= 3 && len > 0 &&
+            len <= 3 && len > 0
-            List.for_all (fun s -> String.length s = 3) tl
+            && List.for_all (fun s -> String.length s = 3) tl)
-          )
+      | [] ->
-      | [] -> false in
+          false
+    in
     let integers s = triplets (String.split_on_char ',' s) in
     let decimals s =
       let l = String.split_on_char ',' s in
-      if Compare.Int.(List.length l > 2) then
+      if Compare.Int.(List.length l > 2) then false else triplets (List.rev l)
-        false
+    in
-      else
-        triplets (List.rev l) in
     let parse left right =
       let remove_commas s = String.concat "" (String.split_on_char ',' s) in
       let pad_to_six s =
         let len = String.length s in
-        String.init 6 (fun i -> if Compare.Int.(i < len) then String.get s i else '0') in
+        String.init 6 (fun i -> if Compare.Int.(i < len) then s.[i] else '0')
+      in
       try
-        Some (Int64.of_string (remove_commas left ^ pad_to_six (remove_commas right)))
+        Some
-      with _ -> None in
+          (Int64.of_string
+             (remove_commas left ^ pad_to_six (remove_commas right)))
+      with _ -> None
+    in
     match String.split_on_char '.' s with
     | [left; right] ->
         if String.contains s ',' then
-          if integers left && decimals right then
+          if integers left && decimals right then parse left right else None
-            parse left right
+        else if
-          else
+          Compare.Int.(String.length right > 0)
-            None
+          && Compare.Int.(String.length right <= 6)
-        else if Compare.Int.(String.length right > 0)
+        then parse left right
-             && Compare.Int.(String.length right <= 6) then
-          parse left right
         else None
     | [left] ->
-        if not (String.contains s ',') || integers left then
+        if (not (String.contains s ',')) || integers left then parse left ""
-          parse left ""
         else None
-    | _ -> None
+    | _ ->
+        None
 
   let pp ppf amount =
     let mult_int = 1_000_000L in
     let rec left ppf amount =
-      let d, r = Int64.(div amount 1000L), Int64.(rem amount 1000L) in
+      let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in
-      if d > 0L then
+      if d > 0L then Format.fprintf ppf "%a%03Ld" left d r
-        Format.fprintf ppf "%a%03Ld" left d r
+      else Format.fprintf ppf "%Ld" r
-      else
+    in
-        Format.fprintf ppf "%Ld" r in
     let right ppf amount =
       let triplet ppf v =
-        if Compare.Int.(v mod 10 > 0) then
+        if Compare.Int.(v mod 10 > 0) then Format.fprintf ppf "%03d" v
-          Format.fprintf ppf "%03d" v
         else if Compare.Int.(v mod 100 > 0) then
           Format.fprintf ppf "%02d" (v / 10)
-        else
+        else Format.fprintf ppf "%d" (v / 100)
-          Format.fprintf ppf "%d" (v / 100) in
+      in
-      let hi, lo = amount / 1000, amount mod 1000 in
+      let (hi, lo) = (amount / 1000, amount mod 1000) in
-      if Compare.Int.(lo = 0) then
+      if Compare.Int.(lo = 0) then Format.fprintf ppf "%a" triplet hi
-        Format.fprintf ppf "%a" triplet hi
+      else Format.fprintf ppf "%03d%a" hi triplet lo
-      else
+    in
-        Format.fprintf ppf "%03d%a" hi triplet lo in
+    let (ints, decs) =
-    let ints, decs =
+      (Int64.(div amount mult_int), Int64.(to_int (rem amount mult_int)))
-      Int64.(div amount mult_int),
+    in
-      Int64.(to_int (rem amount mult_int)) in
     Format.fprintf ppf "%a" left ints ;
-    if Compare.Int.(decs > 0) then
+    if Compare.Int.(decs > 0) then Format.fprintf ppf ".%a" right decs
-      Format.fprintf ppf ".%a" right decs
 
-  let to_string t =
+  let to_string t = Format.asprintf "%a" pp t
-    Format.asprintf "%a" pp t
 
-  let (-) t1 t2 =
+  let ( - ) t1 t2 = if t2 <= t1 then Some (Int64.sub t1 t2) else None
-    if t2 <= t1
-    then Some (Int64.sub t1 t2)
-    else None
 
   let ( -? ) t1 t2 =
     match t1 - t2 with
-    | None -> error (Subtraction_underflow (t1, t2))
+    | None ->
-    | Some v -> ok v
+        error (Subtraction_underflow (t1, t2))
+    | Some v ->
+        ok v
 
   let ( +? ) t1 t2 =
     let t = Int64.add t1 t2 in
-    if t < t1
+    if t < t1 then error (Addition_overflow (t1, t2)) else ok t
-    then error (Addition_overflow (t1, t2))
-    else ok t
 
   let ( *? ) t m =
     let open Compare.Int64 in
     let open Int64 in
     let rec step cur pow acc =
-      if cur = 0L then
+      if cur = 0L then ok acc
-        ok acc
       else
-        pow +? pow >>? fun npow ->
+        pow +? pow
+        >>? fun npow ->
         if logand cur 1L = 1L then
-          acc +? pow >>? fun nacc ->
+          acc +? pow >>? fun nacc -> step (shift_right_logical cur 1) npow nacc
-          step (shift_right_logical cur 1) npow nacc
+        else step (shift_right_logical cur 1) npow acc
-        else
+    in
-          step (shift_right_logical cur 1) npow acc in
+    if m < 0L then error (Negative_multiplicator (t, m))
-    if m < 0L then
-      error (Negative_multiplicator (t, m))
     else
       match step m t 0L with
-      | Ok res -> Ok res
+      | Ok res ->
+          Ok res
       | Error ([Addition_overflow _] as errs) ->
           Error (Multiplication_overflow (t, m) :: errs)
-      | Error errs -> Error errs
+      | Error errs ->
+          Error errs
 
   let ( /? ) t d =
-    if d <= 0L then
+    if d <= 0L then error (Invalid_divisor (t, d)) else ok (Int64.div t d)
-      error (Invalid_divisor (t, d))
-    else
-      ok (Int64.div t d)
 
   let add_exn t1 t2 =
     let t = Int64.add t1 t2 in
-    if t <= 0L
+    if t <= 0L then invalid_arg "add_exn" else t
-    then invalid_arg "add_exn"
-    else t
 
   let mul_exn t m =
     match t *? Int64.(of_int m) with
-    | Ok v -> v
+    | Ok v ->
-    | Error _ -> invalid_arg "mul_exn"
+        v
+    | Error _ ->
+        invalid_arg "mul_exn"
 
-  let of_mutez t =
+  let of_mutez t = if t < 0L then None else Some t
-    if t < 0L then None
-    else Some t
 
   let of_mutez_exn x =
-    match of_mutez x with
+    match of_mutez x with None -> invalid_arg "Qty.of_mutez" | Some v -> v
-    | None -> invalid_arg "Qty.of_mutez"
-    | Some v -> v
 
   let to_int64 t = t
+
   let to_mutez t = t
 
   let encoding =
     let open Data_encoding in
-    (check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n))
+    check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n)
 
   let () =
     let open Data_encoding in
@@ -248,10 +252,16 @@ module Make (T: QTY) : S = struct
       ~id:(T.id ^ ".addition_overflow")
       ~title:("Overflowing " ^ T.id ^ " addition")
       ~pp:(fun ppf (opa, opb) ->
-          Format.fprintf ppf "Overflowing addition of %a %s and %a %s"
+        Format.fprintf
-            pp opa T.id pp opb T.id)
+          ppf
-      ~description:
+          "Overflowing addition of %a %s and %a %s"
-        ("An addition of two " ^ T.id ^ " amounts overflowed")
+          pp
+          opa
+          T.id
+          pp
+          opb
+          T.id)
+      ~description:("An addition of two " ^ T.id ^ " amounts overflowed")
       (obj1 (req "amounts" (tup2 encoding encoding)))
       (function Addition_overflow (a, b) -> Some (a, b) | _ -> None)
       (fun (a, b) -> Addition_overflow (a, b)) ;
@@ -260,10 +270,16 @@ module Make (T: QTY) : S = struct
       ~id:(T.id ^ ".subtraction_underflow")
       ~title:("Underflowing " ^ T.id ^ " subtraction")
       ~pp:(fun ppf (opa, opb) ->
-          Format.fprintf ppf "Underflowing subtraction of %a %s and %a %s"
+        Format.fprintf
-            pp opa T.id pp opb T.id)
+          ppf
-      ~description:
+          "Underflowing subtraction of %a %s and %a %s"
-        ("An subtraction of two " ^ T.id ^ " amounts underflowed")
+          pp
+          opa
+          T.id
+          pp
+          opb
+          T.id)
+      ~description:("An subtraction of two " ^ T.id ^ " amounts underflowed")
       (obj1 (req "amounts" (tup2 encoding encoding)))
       (function Subtraction_underflow (a, b) -> Some (a, b) | _ -> None)
       (fun (a, b) -> Subtraction_underflow (a, b)) ;
@@ -272,13 +288,16 @@ module Make (T: QTY) : S = struct
       ~id:(T.id ^ ".multiplication_overflow")
       ~title:("Overflowing " ^ T.id ^ " multiplication")
       ~pp:(fun ppf (opa, opb) ->
-          Format.fprintf ppf "Overflowing multiplication of %a %s and %Ld"
+        Format.fprintf
-            pp opa T.id opb)
+          ppf
+          "Overflowing multiplication of %a %s and %Ld"
+          pp
+          opa
+          T.id
+          opb)
       ~description:
         ("A multiplication of a " ^ T.id ^ " amount by an integer overflowed")
-      (obj2
+      (obj2 (req "amount" encoding) (req "multiplicator" int64))
-         (req "amount" encoding)
-         (req "multiplicator" int64))
       (function Multiplication_overflow (a, b) -> Some (a, b) | _ -> None)
       (fun (a, b) -> Multiplication_overflow (a, b)) ;
     register_error_kind
@@ -286,13 +305,16 @@ module Make (T: QTY) : S = struct
       ~id:(T.id ^ ".negative_multiplicator")
       ~title:("Negative " ^ T.id ^ " multiplicator")
       ~pp:(fun ppf (opa, opb) ->
-          Format.fprintf ppf "Multiplication of %a %s by negative integer %Ld"
+        Format.fprintf
-            pp opa T.id opb)
+          ppf
+          "Multiplication of %a %s by negative integer %Ld"
+          pp
+          opa
+          T.id
+          opb)
       ~description:
         ("Multiplication of a " ^ T.id ^ " amount by a negative integer")
-      (obj2
+      (obj2 (req "amount" encoding) (req "multiplicator" int64))
-         (req "amount" encoding)
-         (req "multiplicator" int64))
       (function Negative_multiplicator (a, b) -> Some (a, b) | _ -> None)
       (fun (a, b) -> Negative_multiplicator (a, b)) ;
     register_error_kind
@@ -300,14 +322,16 @@ module Make (T: QTY) : S = struct
       ~id:(T.id ^ ".invalid_divisor")
       ~title:("Invalid " ^ T.id ^ " divisor")
       ~pp:(fun ppf (opa, opb) ->
-          Format.fprintf ppf "Division of %a %s by non positive integer %Ld"
+        Format.fprintf
-            pp opa T.id opb)
+          ppf
+          "Division of %a %s by non positive integer %Ld"
+          pp
+          opa
+          T.id
+          opb)
       ~description:
         ("Multiplication of a " ^ T.id ^ " amount by a non positive integer")
-      (obj2
+      (obj2 (req "amount" encoding) (req "divisor" int64))
-         (req "amount" encoding)
-         (req "divisor" int64))
       (function Invalid_divisor (a, b) -> Some (a, b) | _ -> None)
       (fun (a, b) -> Invalid_divisor (a, b))
-
 end

vendors/ligo-utils/tezos-protocol-alpha/raw_context.ml

@@ -51,37 +51,50 @@ type t = {
 }
 
 type context = t
+
 type root_context = t
 
 let current_level ctxt = ctxt.level
+
 let predecessor_timestamp ctxt = ctxt.predecessor_timestamp
+
 let current_timestamp ctxt = ctxt.timestamp
+
 let current_fitness ctxt = ctxt.fitness
+
 let first_level ctxt = ctxt.first_level
+
 let constants ctxt = ctxt.constants
+
 let recover ctxt = ctxt.context
 
 let record_endorsement ctxt k =
   match Signature.Public_key_hash.Map.find_opt k ctxt.allowed_endorsements with
-  | None -> assert false
+  | None ->
-  | Some (_, _, true) -> assert false (* right already used *)
+      assert false
+  | Some (_, _, true) ->
+      assert false (* right already used *)
   | Some (d, s, false) ->
-      { ctxt with
+      {
-        included_endorsements = ctxt.included_endorsements + (List.length s);
+        ctxt with
+        included_endorsements = ctxt.included_endorsements + List.length s;
         allowed_endorsements =
-          Signature.Public_key_hash.Map.add k (d,s,true) ctxt.allowed_endorsements }
+          Signature.Public_key_hash.Map.add
+            k
+            (d, s, true)
+            ctxt.allowed_endorsements;
+      }
 
 let init_endorsements ctxt allowed_endorsements =
-  if Signature.Public_key_hash.Map.is_empty allowed_endorsements
+  if Signature.Public_key_hash.Map.is_empty allowed_endorsements then
-  then assert false (* can't initialize to empty *)
+    assert false (* can't initialize to empty *)
-  else begin
+  else if Signature.Public_key_hash.Map.is_empty ctxt.allowed_endorsements then
-    if Signature.Public_key_hash.Map.is_empty ctxt.allowed_endorsements
+    {ctxt with allowed_endorsements}
-    then { ctxt with allowed_endorsements }
+  else assert false
-    else assert false (* can't initialize twice *)
-  end
 
-let allowed_endorsements ctxt =
+(* can't initialize twice *)
-  ctxt.allowed_endorsements
+
+let allowed_endorsements ctxt = ctxt.allowed_endorsements
 
 let included_endorsements ctxt = ctxt.included_endorsements
 
@@ -94,8 +107,7 @@ let () =
     ~id:"too_many_internal_operations"
     ~title:"Too many internal operations"
     ~description:
-      "A transaction exceeded the hard limit \
+      "A transaction exceeded the hard limit of internal operations it can emit"
-       of internal operations it can emit"
     empty
     (function Too_many_internal_operations -> Some () | _ -> None)
     (fun () -> Too_many_internal_operations)
@@ -104,36 +116,48 @@ let fresh_internal_nonce ctxt =
   if Compare.Int.(ctxt.internal_nonce >= 65_535) then
     error Too_many_internal_operations
   else
-    ok ({ ctxt with internal_nonce = ctxt.internal_nonce + 1 }, ctxt.internal_nonce)
+    ok
+      ( {ctxt with internal_nonce = ctxt.internal_nonce + 1},
+        ctxt.internal_nonce )
+
 let reset_internal_nonce ctxt =
   {ctxt with internal_nonces_used = Int_set.empty; internal_nonce = 0}
+
 let record_internal_nonce ctxt k =
   {ctxt with internal_nonces_used = Int_set.add k ctxt.internal_nonces_used}
+
 let internal_nonce_already_recorded ctxt k =
   Int_set.mem k ctxt.internal_nonces_used
 
 let set_current_fitness ctxt fitness = {ctxt with fitness}
 
 let add_fees ctxt fees =
-  Lwt.return Tez_repr.(ctxt.fees +? fees) >>=? fun fees ->
+  Lwt.return Tez_repr.(ctxt.fees +? fees)
-  return { ctxt with fees}
+  >>=? fun fees -> return {ctxt with fees}
 
 let add_rewards ctxt rewards =
-  Lwt.return Tez_repr.(ctxt.rewards +? rewards) >>=? fun rewards ->
+  Lwt.return Tez_repr.(ctxt.rewards +? rewards)
-  return { ctxt with rewards}
+  >>=? fun rewards -> return {ctxt with rewards}
 
 let add_deposit ctxt delegate deposit =
   let previous =
     match Signature.Public_key_hash.Map.find_opt delegate ctxt.deposits with
-    | Some tz -> tz
+    | Some tz ->
-    | None -> Tez_repr.zero in
+        tz
-  Lwt.return Tez_repr.(previous +? deposit) >>=? fun deposit ->
+    | None ->
+        Tez_repr.zero
+  in
+  Lwt.return Tez_repr.(previous +? deposit)
+  >>=? fun deposit ->
   let deposits =
-    Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits in
+    Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits
+  in
   return {ctxt with deposits}
 
 let get_deposits ctxt = ctxt.deposits
+
 let get_rewards ctxt = ctxt.rewards
+
 let get_fees ctxt = ctxt.fees
 
 type error += Undefined_operation_nonce (* `Permanent *)
@@ -152,24 +176,28 @@ let () =
 
 let init_origination_nonce ctxt operation_hash =
   let origination_nonce =
-    Some (Contract_repr.initial_origination_nonce operation_hash) in
+    Some (Contract_repr.initial_origination_nonce operation_hash)
+  in
   {ctxt with origination_nonce}
 
 let origination_nonce ctxt =
   match ctxt.origination_nonce with
-  | None -> error Undefined_operation_nonce
+  | None ->
-  | Some origination_nonce -> ok origination_nonce
+      error Undefined_operation_nonce
+  | Some origination_nonce ->
+      ok origination_nonce
 
 let increment_origination_nonce ctxt =
   match ctxt.origination_nonce with
-  | None -> error Undefined_operation_nonce
+  | None ->
+      error Undefined_operation_nonce
   | Some cur_origination_nonce ->
       let origination_nonce =
-        Some (Contract_repr.incr_origination_nonce cur_origination_nonce) in
+        Some (Contract_repr.incr_origination_nonce cur_origination_nonce)
+      in
       ok ({ctxt with origination_nonce}, cur_origination_nonce)
 
-let unset_origination_nonce ctxt =
+let unset_origination_nonce ctxt = {ctxt with origination_nonce = None}
-  { ctxt with origination_nonce = None }
 
 type error += Gas_limit_too_high (* `Permanent *)
 
@@ -179,46 +207,64 @@ let () =
     `Permanent
     ~id:"gas_limit_too_high"
     ~title:"Gas limit out of protocol hard bounds"
-    ~description:
+    ~description:"A transaction tried to exceed the hard limit on gas"
-      "A transaction tried to exceed the hard limit on gas"
     empty
     (function Gas_limit_too_high -> Some () | _ -> None)
     (fun () -> Gas_limit_too_high)
 
 let check_gas_limit ctxt remaining =
-  if Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation)
+  if
-  || Compare.Z.(remaining < Z.zero) then
+    Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation)
-    error Gas_limit_too_high
+    || Compare.Z.(remaining < Z.zero)
-  else
+  then error Gas_limit_too_high
-    ok ()
+  else ok ()
+
 let set_gas_limit ctxt remaining =
-  { ctxt with operation_gas = Limited { remaining } ;
+  {
-              internal_gas = Gas_limit_repr.internal_gas_zero }
+    ctxt with
-let set_gas_unlimited ctxt =
+    operation_gas = Limited {remaining};
-  { ctxt with operation_gas = Unaccounted }
+    internal_gas = Gas_limit_repr.internal_gas_zero;
+  }
+
+let set_gas_unlimited ctxt = {ctxt with operation_gas = Unaccounted}
+
 let consume_gas ctxt cost =
   Gas_limit_repr.consume
     ctxt.block_gas
     ctxt.operation_gas
     ctxt.internal_gas
-    cost >>? fun (block_gas, operation_gas, internal_gas) ->
+    cost
+  >>? fun (block_gas, operation_gas, internal_gas) ->
   ok {ctxt with block_gas; operation_gas; internal_gas}
+
 let check_enough_gas ctxt cost =
-  Gas_limit_repr.check_enough ctxt.block_gas ctxt.operation_gas ctxt.internal_gas cost
+  Gas_limit_repr.check_enough
+    ctxt.block_gas
+    ctxt.operation_gas
+    ctxt.internal_gas
+    cost
+
 let gas_level ctxt = ctxt.operation_gas
+
 let block_gas_level ctxt = ctxt.block_gas
 
 let gas_consumed ~since ~until =
-  match gas_level since, gas_level until with
+  match (gas_level since, gas_level until) with
-  | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after
+  | (Limited {remaining = before}, Limited {remaining = after}) ->
-  | _, _ -> Z.zero
+      Z.sub before after
+  | (_, _) ->
+      Z.zero
 
 let init_storage_space_to_pay ctxt =
   match ctxt.storage_space_to_pay with
   | Some _ ->
       assert false
   | None ->
-      { ctxt with storage_space_to_pay = Some Z.zero ; allocated_contracts = Some 0 }
+      {
+        ctxt with
+        storage_space_to_pay = Some Z.zero;
+        allocated_contracts = Some 0;
+      }
 
 let update_storage_space_to_pay ctxt n =
   match ctxt.storage_space_to_pay with
@@ -235,14 +281,13 @@ let update_allocated_contracts_count ctxt =
       {ctxt with allocated_contracts = Some (succ allocated_contracts)}
 
 let clear_storage_space_to_pay ctxt =
-  match ctxt.storage_space_to_pay, ctxt.allocated_contracts with
+  match (ctxt.storage_space_to_pay, ctxt.allocated_contracts) with
-  | None, _ | _, None ->
+  | (None, _) | (_, None) ->
       assert false
-  | Some storage_space_to_pay, Some allocated_contracts ->
+  | (Some storage_space_to_pay, Some allocated_contracts) ->
-      { ctxt with storage_space_to_pay = None ;
+      ( {ctxt with storage_space_to_pay = None; allocated_contracts = None},
-                  allocated_contracts = None},
         storage_space_to_pay,
-      allocated_contracts
+        allocated_contracts )
 
 type storage_error =
   | Incompatible_protocol_version of string
@@ -252,58 +297,68 @@ type storage_error =
 
 let storage_error_encoding =
   let open Data_encoding in
-  union [
+  union
-    case (Tag 0)
+    [ case
+        (Tag 0)
         ~title:"Incompatible_protocol_version"
         (obj1 (req "incompatible_protocol_version" string))
         (function Incompatible_protocol_version arg -> Some arg | _ -> None)
         (fun arg -> Incompatible_protocol_version arg);
-    case (Tag 1)
+      case
+        (Tag 1)
         ~title:"Missing_key"
         (obj2
            (req "missing_key" (list string))
-         (req "function" (string_enum ["get", `Get ; "set", `Set ; "del", `Del ; "copy", `Copy ])))
+           (req
+              "function"
+              (string_enum
+                 [("get", `Get); ("set", `Set); ("del", `Del); ("copy", `Copy)])))
         (function Missing_key (key, f) -> Some (key, f) | _ -> None)
         (fun (key, f) -> Missing_key (key, f));
-    case (Tag 2)
+      case
+        (Tag 2)
         ~title:"Existing_key"
         (obj1 (req "existing_key" (list string)))
         (function Existing_key key -> Some key | _ -> None)
         (fun key -> Existing_key key);
-    case (Tag 3)
+      case
+        (Tag 3)
         ~title:"Corrupted_data"
         (obj1 (req "corrupted_data" (list string)))
         (function Corrupted_data key -> Some key | _ -> None)
-      (fun key -> Corrupted_data key) ;
+        (fun key -> Corrupted_data key) ]
-  ]
 
 let pp_storage_error ppf = function
   | Incompatible_protocol_version version ->
-      Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Found a context with an unexpected version '%s'."
         version
   | Missing_key (key, `Get) ->
-      Format.fprintf ppf
+      Format.fprintf ppf "Missing key '%s'." (String.concat "/" key)
-        "Missing key '%s'."
-        (String.concat "/" key)
   | Missing_key (key, `Set) ->
-      Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Cannot set undefined key '%s'."
         (String.concat "/" key)
   | Missing_key (key, `Del) ->
-      Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Cannot delete undefined key '%s'."
         (String.concat "/" key)
   | Missing_key (key, `Copy) ->
-      Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Cannot copy undefined key '%s'."
         (String.concat "/" key)
   | Existing_key key ->
-      Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Cannot initialize defined key '%s'."
         (String.concat "/" key)
   | Corrupted_data key ->
-      Format.fprintf ppf
+      Format.fprintf
+        ppf
         "Failed to parse the data at '%s'."
         (String.concat "/" key)
 
@@ -315,12 +370,10 @@ let () =
     ~id:"context.storage_error"
     ~title:"Storage error (fatal internal error)"
     ~description:
-      "An error that should never happen unless something \
+      "An error that should never happen unless something has been deleted or \
-       has been deleted or corrupted in the database."
+       corrupted in the database."
     ~pp:(fun ppf err ->
-        Format.fprintf ppf
+      Format.fprintf ppf "@[<v 2>Storage error:@ %a@]" pp_storage_error err)
-          "@[<v 2>Storage error:@ %a@]"
-          pp_storage_error err)
     storage_error_encoding
     (function Storage_error err -> Some err | _ -> None)
     (fun err -> Storage_error err)
@@ -330,32 +383,39 @@ let storage_error err = fail (Storage_error err)
 (* Initialization *********************************************************)
 
 (* This key should always be populated for every version of the
-   protocol.  Its absence meaning that the context is empty. *)
+   protocol.  It's absence meaning that the context is empty. *)
 let version_key = ["version"]
-let version_value = "babylon_005"
+
+let version_value = "carthage_006"
 
 let version = "v1"
+
 let first_level_key = [version; "first_level"]
+
 let constants_key = [version; "constants"]
+
 let protocol_param_key = ["protocol_parameters"]
 
 let get_first_level ctxt =
-  Context.get ctxt first_level_key >>= function
+  Context.get ctxt first_level_key
-  | None -> storage_error (Missing_key (first_level_key, `Get))
+  >>= function
-  | Some bytes ->
+  | None ->
-      match
+      storage_error (Missing_key (first_level_key, `Get))
-        Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes
+  | Some bytes -> (
-      with
+    match Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes with
-      | None -> storage_error (Corrupted_data first_level_key)
+    | None ->
-      | Some level -> return level
+        storage_error (Corrupted_data first_level_key)
+    | Some level ->
+        return level )
 
 let set_first_level ctxt level =
   let bytes =
-    Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level in
+    Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level
-  Context.set ctxt first_level_key bytes >>= fun ctxt ->
+  in
-  return ctxt
+  Context.set ctxt first_level_key bytes >>= fun ctxt -> return ctxt
 
 type error += Failed_to_parse_parameter of MBytes.t
+
 type error += Failed_to_decode_parameter of Data_encoding.json * string
 
 let () =
@@ -363,13 +423,12 @@ let () =
     `Temporary
     ~id:"context.failed_to_parse_parameter"
     ~title:"Failed to parse parameter"
-    ~description:
+    ~description:"The protocol parameters are not valid JSON."
-      "The protocol parameters are not valid JSON."
+    ~pp:(fun ppf bytes ->
-    ~pp:begin fun ppf bytes ->
+      Format.fprintf
-      Format.fprintf ppf
+        ppf
         "@[<v 2>Cannot parse the protocol parameter:@ %s@]"
-        (MBytes.to_string bytes)
+        (MBytes.to_string bytes))
-    end
     Data_encoding.(obj1 (req "contents" bytes))
     (function Failed_to_parse_parameter data -> Some data | _ -> None)
     (fun data -> Failed_to_parse_parameter data) ;
@@ -377,104 +436,126 @@ let () =
     `Temporary
     ~id:"context.failed_to_decode_parameter"
     ~title:"Failed to decode parameter"
-    ~description:
+    ~description:"Unexpected JSON object."
-      "Unexpected JSON object."
+    ~pp:(fun ppf (json, msg) ->
-    ~pp:begin fun ppf (json, msg) ->
+      Format.fprintf
-      Format.fprintf ppf
+        ppf
         "@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]"
         msg
-        Data_encoding.Json.pp json
+        Data_encoding.Json.pp
-    end
+        json)
-    Data_encoding.(obj2
+    Data_encoding.(obj2 (req "contents" json) (req "error" string))
-                     (req "contents" json)
-                     (req "error" string))
     (function
-      | Failed_to_decode_parameter (json, msg) -> Some (json, msg)
+      | Failed_to_decode_parameter (json, msg) -> Some (json, msg) | _ -> None)
-      | _ -> None)
     (fun (json, msg) -> Failed_to_decode_parameter (json, msg))
 
 let get_proto_param ctxt =
-  Context.get ctxt protocol_param_key >>= function
+  Context.get ctxt protocol_param_key
+  >>= function
   | None ->
       failwith "Missing protocol parameters."
-  | Some bytes ->
+  | Some bytes -> (
     match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
-      | None -> fail (Failed_to_parse_parameter bytes)
+    | None ->
-      | Some json -> begin
+        fail (Failed_to_parse_parameter bytes)
-          Context.del ctxt protocol_param_key >>= fun ctxt ->
+    | Some json -> (
+        Context.del ctxt protocol_param_key
+        >>= fun ctxt ->
         match Data_encoding.Json.destruct Parameters_repr.encoding json with
         | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->
             Format.kasprintf
-                failwith "Invalid protocol_parameters: %a %a"
+              failwith
-                (fun ppf -> Data_encoding.Json.print_error ppf) exn
+              "Invalid protocol_parameters: %a %a"
-                Data_encoding.Json.pp json
+              (fun ppf -> Data_encoding.Json.print_error ppf)
-          | param -> return (param, ctxt)
+              exn
-        end
+              Data_encoding.Json.pp
+              json
+        | param ->
+            return (param, ctxt) ) )
 
 let set_constants ctxt constants =
   let bytes =
     Data_encoding.Binary.to_bytes_exn
-      Constants_repr.parametric_encoding constants in
+      Constants_repr.parametric_encoding
+      constants
+  in
   Context.set ctxt constants_key bytes
 
 let get_constants ctxt =
-  Context.get ctxt constants_key >>= function
+  Context.get ctxt constants_key
+  >>= function
   | None ->
       failwith "Internal error: cannot read constants in context."
-  | Some bytes ->
+  | Some bytes -> (
     match
       Data_encoding.Binary.of_bytes Constants_repr.parametric_encoding bytes
     with
     | None ->
         failwith "Internal error: cannot parse constants in context."
-      | Some constants -> return constants
+    | Some constants ->
+        return constants )
 
-(* only for migration from 004 to 005 *)
+(* only for migration from 005 to 006 *)
-let get_004_constants ctxt =
+let get_005_constants ctxt =
-  Context.get ctxt constants_key >>= function
+  Context.get ctxt constants_key
+  >>= function
   | None ->
-      failwith "Internal error: cannot read constants in context."
+      failwith "Internal error: cannot read 005 constants in context."
-  | Some bytes ->
+  | Some bytes -> (
     match
-        Data_encoding.Binary.of_bytes Parameters_repr.Proto_004.constants_encoding bytes
+      Data_encoding.Binary.of_bytes
+        Constants_repr.Proto_005.parametric_encoding
+        bytes
     with
     | None ->
-          failwith "Internal error: cannot parse constants in context."
+        failwith "Internal error: cannot parse 005 constants in context."
-      | Some constants -> return constants
+    | Some constants ->
+        return constants )
 
 let patch_constants ctxt f =
   let constants = f ctxt.constants in
-  set_constants ctxt.context constants >>= fun context ->
+  set_constants ctxt.context constants
-  Lwt.return { ctxt with context ; constants }
+  >>= fun context -> Lwt.return {ctxt with context; constants}
 
 let check_inited ctxt =
-  Context.get ctxt version_key >>= function
+  Context.get ctxt version_key
+  >>= function
   | None ->
       failwith "Internal error: un-initialized context."
   | Some bytes ->
       let s = MBytes.to_string bytes in
-      if Compare.String.(s = version_value) then
+      if Compare.String.(s = version_value) then return_unit
-        return_unit
+      else storage_error (Incompatible_protocol_version s)
-      else
-        storage_error (Incompatible_protocol_version s)
 
 let prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt =
-  Lwt.return (Raw_level_repr.of_int32 level) >>=? fun level ->
+  Lwt.return (Raw_level_repr.of_int32 level)
-  Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness ->
+  >>=? fun level ->
-  check_inited ctxt >>=? fun () ->
+  Lwt.return (Fitness_repr.to_int64 fitness)
-  get_constants ctxt >>=? fun constants ->
+  >>=? fun fitness ->
-  get_first_level ctxt >>=? fun first_level ->
+  check_inited ctxt
+  >>=? fun () ->
+  get_constants ctxt
+  >>=? fun constants ->
+  get_first_level ctxt
+  >>=? fun first_level ->
   let level =
     Level_repr.from_raw
       ~first_level
       ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle
-      ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period
+      ~blocks_per_voting_period:
+        constants.Constants_repr.blocks_per_voting_period
       ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
-      level in
+      level
-  return {
+  in
-    context = ctxt ; constants ; level ;
+  return
+    {
+      context = ctxt;
+      constants;
+      level;
       predecessor_timestamp;
-    timestamp ; fitness ; first_level ;
+      timestamp;
+      fitness;
+      first_level;
       allowed_endorsements = Signature.Public_key_hash.Map.empty;
       included_endorsements = 0;
       fees = Tez_repr.zero;
@@ -491,53 +572,53 @@ let prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt =
       internal_nonces_used = Int_set.empty;
     }
 
-type previous_protocol =
+type previous_protocol = Genesis of Parameters_repr.t | Babylon_005
-  | Genesis of Parameters_repr.t
-  | Athens_004
 
 let check_and_update_protocol_version ctxt =
-  begin
+  Context.get ctxt version_key
-    Context.get ctxt version_key >>= function
+  >>= (function
         | None ->
-        failwith "Internal error: un-initialized context in check_first_block."
+            failwith
+              "Internal error: un-initialized context in check_first_block."
         | Some bytes ->
             let s = MBytes.to_string bytes in
             if Compare.String.(s = version_value) then
               failwith "Internal error: previously initialized context."
             else if Compare.String.(s = "genesis") then
-          get_proto_param ctxt >>=? fun (param, ctxt) ->
+              get_proto_param ctxt
-          return (Genesis param, ctxt)
+              >>=? fun (param, ctxt) -> return (Genesis param, ctxt)
-        else if Compare.String.(s = "athens_004") then
+            else if Compare.String.(s = "babylon_005") then
-          return (Athens_004, ctxt)
+              return (Babylon_005, ctxt)
-        else
+            else storage_error (Incompatible_protocol_version s))
-          storage_error (Incompatible_protocol_version s)
+  >>=? fun (previous_proto, ctxt) ->
-  end >>=? fun (previous_proto, ctxt) ->
+  Context.set ctxt version_key (MBytes.of_string version_value)
-  Context.set ctxt version_key
+  >>= fun ctxt -> return (previous_proto, ctxt)
-    (MBytes.of_string version_value) >>= fun ctxt ->
-  return (previous_proto, ctxt)
 
 let prepare_first_block ~level ~timestamp ~fitness ctxt =
-  check_and_update_protocol_version ctxt >>=? fun (previous_proto, ctxt) ->
+  check_and_update_protocol_version ctxt
-  begin
+  >>=? fun (previous_proto, ctxt) ->
-    match previous_proto with
+  ( match previous_proto with
   | Genesis param ->
-        Lwt.return (Raw_level_repr.of_int32 level) >>=? fun first_level ->
+      Lwt.return (Raw_level_repr.of_int32 level)
-        set_first_level ctxt first_level >>=? fun ctxt ->
+      >>=? fun first_level ->
-        set_constants ctxt param.constants >>= fun ctxt ->
+      set_first_level ctxt first_level
-        return ctxt
+      >>=? fun ctxt ->
-    | Athens_004 ->
+      set_constants ctxt param.constants >>= fun ctxt -> return ctxt
-        get_004_constants ctxt >>=? fun c ->
+  | Babylon_005 ->
-        let constants = Constants_repr.{
+      get_005_constants ctxt
+      >>=? fun c ->
+      let constants =
+        Constants_repr.
+          {
             preserved_cycles = c.preserved_cycles;
             blocks_per_cycle = c.blocks_per_cycle;
             blocks_per_commitment = c.blocks_per_commitment;
             blocks_per_roll_snapshot = c.blocks_per_roll_snapshot;
             blocks_per_voting_period = c.blocks_per_voting_period;
-            time_between_blocks =
+            time_between_blocks = c.time_between_blocks;
-              List.map Period_repr.of_seconds_exn [ 60L ; 40L ] ;
             endorsers_per_block = c.endorsers_per_block;
-            hard_gas_limit_per_operation = c.hard_gas_limit_per_operation ;
+            hard_gas_limit_per_operation = Z.of_int 1_040_000;
-            hard_gas_limit_per_block = c.hard_gas_limit_per_block ;
+            hard_gas_limit_per_block = Z.of_int 10_400_000;
             proof_of_work_threshold = c.proof_of_work_threshold;
             tokens_per_roll = c.tokens_per_roll;
             michelson_maximum_type_size = c.michelson_maximum_type_size;
@@ -545,29 +626,32 @@ let prepare_first_block ~level ~timestamp ~fitness ctxt =
             origination_size = c.origination_size;
             block_security_deposit = c.block_security_deposit;
             endorsement_security_deposit = c.endorsement_security_deposit;
-            block_reward = c.block_reward ;
+            baking_reward_per_endorsement =
-            endorsement_reward = c.endorsement_reward ;
+              Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 187_500L];
+            endorsement_reward =
+              Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 833_333L];
             cost_per_byte = c.cost_per_byte;
-            hard_storage_limit_per_operation = c.hard_storage_limit_per_operation ;
+            hard_storage_limit_per_operation =
+              c.hard_storage_limit_per_operation;
             test_chain_duration = c.test_chain_duration;
-            quorum_min = 20_00l ; (* quorum is in centile of a percentage *)
+            quorum_min = c.quorum_min;
-            quorum_max = 70_00l ;
+            quorum_max = c.quorum_max;
-            min_proposal_quorum = 5_00l ;
+            min_proposal_quorum = c.min_proposal_quorum;
-            initial_endorsers = 24 ;
+            initial_endorsers = c.initial_endorsers;
-            delay_per_missing_endorsement = Period_repr.of_seconds_exn 8L ;
+            delay_per_missing_endorsement = c.delay_per_missing_endorsement;
-          } in
+          }
-        set_constants ctxt constants >>= fun ctxt ->
+      in
-        return ctxt
+      set_constants ctxt constants >>= fun ctxt -> return ctxt )
-  end >>=? fun ctxt ->
+  >>=? fun ctxt ->
-  prepare ctxt ~level ~predecessor_timestamp:timestamp ~timestamp ~fitness >>=? fun ctxt ->
+  prepare ctxt ~level ~predecessor_timestamp:timestamp ~timestamp ~fitness
-  return (previous_proto, ctxt)
+  >>=? fun ctxt -> return (previous_proto, ctxt)
 
 let activate ({context = c; _} as s) h =
   Updater.activate c h >>= fun c -> Lwt.return {s with context = c}
 
 let fork_test_chain ({context = c; _} as s) protocol expiration =
-  Updater.fork_test_chain c ~protocol ~expiration >>= fun c ->
+  Updater.fork_test_chain c ~protocol ~expiration
-  Lwt.return { s with context = c }
+  >>= fun c -> Lwt.return {s with context = c}
 
 (* Generic context ********************************************************)
 
@@ -576,25 +660,38 @@ type key = string list
 type value = MBytes.t
 
 module type T = sig
-
   type t
+
   type context = t
 
   val mem : context -> key -> bool Lwt.t
+
   val dir_mem : context -> key -> bool Lwt.t
+
   val get : context -> key -> value tzresult Lwt.t
+
   val get_option : context -> key -> value option Lwt.t
+
   val init : context -> key -> value -> context tzresult Lwt.t
+
   val set : context -> key -> value -> context tzresult Lwt.t
+
   val init_set : context -> key -> value -> context Lwt.t
+
   val set_option : context -> key -> value option -> context Lwt.t
+
   val delete : context -> key -> context tzresult Lwt.t
+
   val remove : context -> key -> context Lwt.t
+
   val remove_rec : context -> key -> context Lwt.t
+
   val copy : context -> from:key -> to_:key -> context tzresult Lwt.t
 
   val fold :
-    context -> key -> init:'a ->
+    context ->
+    key ->
+    init:'a ->
     f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) ->
     'a Lwt.t
 
@@ -612,76 +709,80 @@ module type T = sig
   val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult
 
   val description : context Storage_description.t
-
 end
 
 let mem ctxt k = Context.mem ctxt.context k
+
 let dir_mem ctxt k = Context.dir_mem ctxt.context k
 
 let get ctxt k =
-  Context.get ctxt.context k >>= function
-  | None -> storage_error (Missing_key (k, `Get))
-  | Some v -> return v
-
-let get_option ctxt k =
   Context.get ctxt.context k
+  >>= function
+  | None -> storage_error (Missing_key (k, `Get)) | Some v -> return v
+
+let get_option ctxt k = Context.get ctxt.context k
 
 (* Verify that the k is present before modifying *)
 let set ctxt k v =
-  Context.mem ctxt.context k >>= function
+  Context.mem ctxt.context k
-  | false -> storage_error (Missing_key (k, `Set))
+  >>= function
+  | false ->
+      storage_error (Missing_key (k, `Set))
   | true ->
-      Context.set ctxt.context k v >>= fun context ->
+      Context.set ctxt.context k v
-      return { ctxt with context }
+      >>= fun context -> return {ctxt with context}
 
 (* Verify that the k is not present before inserting *)
 let init ctxt k v =
-  Context.mem ctxt.context k >>= function
+  Context.mem ctxt.context k
-  | true -> storage_error (Existing_key k)
+  >>= function
+  | true ->
+      storage_error (Existing_key k)
   | false ->
-      Context.set ctxt.context k v >>= fun context ->
+      Context.set ctxt.context k v
-      return { ctxt with context }
+      >>= fun context -> return {ctxt with context}
 
 (* Does not verify that the key is present or not *)
 let init_set ctxt k v =
-  Context.set ctxt.context k v >>= fun context ->
+  Context.set ctxt.context k v
-  Lwt.return { ctxt with context }
+  >>= fun context -> Lwt.return {ctxt with context}
 
 (* Verify that the key is present before deleting *)
 let delete ctxt k =
-  Context.mem ctxt.context k >>= function
+  Context.mem ctxt.context k
-  | false -> storage_error (Missing_key (k, `Del))
+  >>= function
+  | false ->
+      storage_error (Missing_key (k, `Del))
   | true ->
-      Context.del ctxt.context k >>= fun context ->
+      Context.del ctxt.context k >>= fun context -> return {ctxt with context}
-      return { ctxt with context }
 
 (* Do not verify before deleting *)
 let remove ctxt k =
-  Context.del ctxt.context k >>= fun context ->
+  Context.del ctxt.context k >>= fun context -> Lwt.return {ctxt with context}
-  Lwt.return { ctxt with context }
 
 let set_option ctxt k = function
-  | None -> remove ctxt k
+  | None ->
-  | Some v -> init_set ctxt k v
+      remove ctxt k
+  | Some v ->
+      init_set ctxt k v
 
 let remove_rec ctxt k =
-  Context.remove_rec ctxt.context k >>= fun context ->
+  Context.remove_rec ctxt.context k
-  Lwt.return { ctxt with context }
+  >>= fun context -> Lwt.return {ctxt with context}
 
 let copy ctxt ~from ~to_ =
-  Context.copy ctxt.context ~from ~to_ >>= function
+  Context.copy ctxt.context ~from ~to_
-  | None -> storage_error (Missing_key (from, `Copy))
+  >>= function
+  | None ->
+      storage_error (Missing_key (from, `Copy))
   | Some context ->
       return {ctxt with context}
 
-let fold ctxt k ~init ~f =
+let fold ctxt k ~init ~f = Context.fold ctxt.context k ~init ~f
-  Context.fold ctxt.context k ~init ~f
 
-let keys ctxt k =
+let keys ctxt k = Context.keys ctxt.context k
-  Context.keys ctxt.context k
 
-let fold_keys ctxt k ~init ~f =
+let fold_keys ctxt k ~init ~f = Context.fold_keys ctxt.context k ~init ~f
-  Context.fold_keys ctxt.context k ~init ~f
 
 let project x = x
 
@@ -690,17 +791,15 @@ let absolute_key _ k = k
 let description = Storage_description.create ()
 
 let fresh_temporary_big_map ctxt =
-  { ctxt with temporary_big_map = Z.sub ctxt.temporary_big_map Z.one },
+  ( {ctxt with temporary_big_map = Z.sub ctxt.temporary_big_map Z.one},
-  ctxt.temporary_big_map
+    ctxt.temporary_big_map )
 
 let reset_temporary_big_map ctxt =
   {ctxt with temporary_big_map = Z.sub Z.zero Z.one}
 
 let temporary_big_maps ctxt f acc =
   let rec iter acc id =
-    if Z.equal id ctxt.temporary_big_map then
+    if Z.equal id ctxt.temporary_big_map then Lwt.return acc
-      Lwt.return acc
+    else f acc id >>= fun acc -> iter acc (Z.sub id Z.one)
-    else
+  in
-      f acc id >>= fun acc ->
-      iter acc (Z.sub id Z.one) in
   iter acc (Z.sub Z.zero Z.one)

vendors/ligo-utils/tezos-protocol-alpha/raw_context.mli

@@ -35,7 +35,9 @@ type storage_error =
   | Corrupted_data of string list
 
 type error += Storage_error of storage_error
+
 type error += Failed_to_parse_parameter of MBytes.t
+
 type error += Failed_to_decode_parameter of Data_encoding.json * string
 
 val storage_error : storage_error -> 'a tzresult Lwt.t
@@ -45,6 +47,7 @@ val storage_error: storage_error -> 'a tzresult Lwt.t
 (** Abstract view of the context.
     Includes a handle to the functional key-value database
     ({!Context.t}) along with some in-memory values (gas, etc.). *)
+
 module Int_set : sig
   type t
 end
@@ -74,6 +77,7 @@ type t = {
 }
 
 type context = t
+
 type root_context = t
 
 (** Retrieves the state of the database and gives its abstract view.
@@ -84,19 +88,20 @@ val prepare:
   predecessor_timestamp:Time.t ->
   timestamp:Time.t ->
   fitness:Fitness.t ->
-  Context.t -> context tzresult Lwt.t
+  Context.t ->
+  context tzresult Lwt.t
 
-type previous_protocol =
+type previous_protocol = Genesis of Parameters_repr.t | Babylon_005
-  | Genesis of Parameters_repr.t
-  | Athens_004
 
 val prepare_first_block :
   level:int32 ->
   timestamp:Time.t ->
   fitness:Fitness.t ->
-  Context.t -> (previous_protocol * context) tzresult Lwt.t
+  Context.t ->
+  (previous_protocol * context) tzresult Lwt.t
 
 val activate : context -> Protocol_hash.t -> t Lwt.t
+
 val fork_test_chain : context -> Protocol_hash.t -> Time.t -> t Lwt.t
 
 (** Returns the state of the database resulting of operations on its
@@ -104,17 +109,22 @@ val fork_test_chain: context -> Protocol_hash.t -> Time.t -> t Lwt.t
 val recover : context -> Context.t
 
 val current_level : context -> Level_repr.t
+
 val predecessor_timestamp : context -> Time.t
+
 val current_timestamp : context -> Time.t
 
 val current_fitness : context -> Int64.t
+
 val set_current_fitness : context -> Int64.t -> t
 
 val constants : context -> Constants_repr.parametric
+
 val patch_constants :
   context ->
   (Constants_repr.parametric -> Constants_repr.parametric) ->
   context Lwt.t
+
 val first_level : context -> Raw_level_repr.t
 
 (** Increment the current block fee stash that will be credited to baker's
@@ -128,31 +138,48 @@ val add_rewards: context -> Tez_repr.t -> context tzresult Lwt.t
 (** Increment the current block deposit stash for a specific delegate. All the
     delegates' frozen_deposit accounts are credited at finalize_application *)
 val add_deposit :
-  context -> Signature.Public_key_hash.t -> Tez_repr.t -> context tzresult Lwt.t
+  context ->
+  Signature.Public_key_hash.t ->
+  Tez_repr.t ->
+  context tzresult Lwt.t
 
 val get_fees : context -> Tez_repr.t
+
 val get_rewards : context -> Tez_repr.t
+
 val get_deposits : context -> Tez_repr.t Signature.Public_key_hash.Map.t
 
 type error += Gas_limit_too_high (* `Permanent *)
 
 val check_gas_limit : t -> Z.t -> unit tzresult
+
 val set_gas_limit : t -> Z.t -> t
+
 val set_gas_unlimited : t -> t
+
 val gas_level : t -> Gas_limit_repr.t
+
 val gas_consumed : since:t -> until:t -> Z.t
+
 val block_gas_level : t -> Z.t
 
 val init_storage_space_to_pay : t -> t
+
 val update_storage_space_to_pay : t -> Z.t -> t
+
 val update_allocated_contracts_count : t -> t
+
 val clear_storage_space_to_pay : t -> t * Z.t * int
 
 type error += Undefined_operation_nonce (* `Permanent *)
 
 val init_origination_nonce : t -> Operation_hash.t -> t
+
 val origination_nonce : t -> Contract_repr.origination_nonce tzresult
-val increment_origination_nonce: t -> (t * Contract_repr.origination_nonce) tzresult
+
+val increment_origination_nonce :
+  t -> (t * Contract_repr.origination_nonce) tzresult
+
 val unset_origination_nonce : t -> t
 
 (** {1 Generic accessors} *)
@@ -165,8 +192,8 @@ type value = MBytes.t
     as-is for direct context accesses, and used in {!Storage_functors}
     to provide restricted views to the context. *)
 module type T = sig
-
   type t
+
   type context = t
 
   (** Tells if the key is already defined as a value. *)
@@ -217,7 +244,9 @@ module type T = sig
 
   (** Iterator on all the items of a given directory. *)
   val fold :
-    context -> key -> init:'a ->
+    context ->
+    key ->
+    init:'a ->
     f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) ->
     'a Lwt.t
 
@@ -243,7 +272,6 @@ module type T = sig
   val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult
 
   val description : context Storage_description.t
-
 end
 
 include T with type t := t and type context := context
@@ -278,8 +306,7 @@ val init_endorsements:
   context
 
 (** Marks an endorsment in the map as used. *)
-val record_endorsement:
+val record_endorsement : context -> Signature.Public_key_hash.t -> context
-  context -> Signature.Public_key_hash.t -> context
 
 (** Provide a fresh identifier for a temporary big map (negative index). *)
 val fresh_temporary_big_map : context -> context * Z.t

vendors/ligo-utils/tezos-protocol-alpha/raw_level_repr.ml

@@ -24,16 +24,24 @@
 (*****************************************************************************)
 
 type t = int32
+
 type raw_level = t
+
 include (Compare.Int32 : Compare.S with type t := t)
+
 let encoding = Data_encoding.int32
+
 let pp ppf level = Format.fprintf ppf "%ld" level
+
 let rpc_arg =
   let construct raw_level = Int32.to_string raw_level in
   let destruct str =
     match Int32.of_string str with
-    | exception _ -> Error "Cannot parse level"
+    | exception _ ->
-    | raw_level -> Ok raw_level in
+        Error "Cannot parse level"
+    | raw_level ->
+        Ok raw_level
+  in
   RPC_arg.make
     ~descr:"A level integer"
     ~name:"block_level"
@@ -42,19 +50,17 @@ let rpc_arg =
     ()
 
 let root = 0l
+
 let succ = Int32.succ
-let pred l =
+
-  if l = 0l
+let pred l = if l = 0l then None else Some (Int32.pred l)
-  then None
-  else Some (Int32.pred l)
 
 let diff = Int32.sub
 
 let to_int32 l = l
+
 let of_int32_exn l =
-  if Compare.Int32.(l >= 0l)
+  if Compare.Int32.(l >= 0l) then l else invalid_arg "Level_repr.of_int32"
-  then l
-  else invalid_arg "Level_repr.of_int32"
 
 type error += Unexpected_level of Int32.t (* `Permanent *)
 
@@ -65,26 +71,32 @@ let () =
     ~title:"Unexpected level"
     ~description:"Level must be non-negative."
     ~pp:(fun ppf l ->
-        Format.fprintf ppf "The level is %s but should be non-negative." (Int32.to_string l))
+      Format.fprintf
+        ppf
+        "The level is %s but should be non-negative."
+        (Int32.to_string l))
     Data_encoding.(obj1 (req "level" int32))
     (function Unexpected_level l -> Some l | _ -> None)
     (fun l -> Unexpected_level l)
 
-let of_int32 l =
+let of_int32 l = try Ok (of_int32_exn l) with _ -> error (Unexpected_level l)
-  try Ok (of_int32_exn l)
-  with _ -> error (Unexpected_level l)
 
 module Index = struct
   type t = raw_level
+
   let path_length = 1
+
   let to_path level l = Int32.to_string level :: l
+
   let of_path = function
-    | [s] -> begin
+    | [s] -> (
-        try Some (Int32.of_string s)
+      try Some (Int32.of_string s) with _ -> None )
-        with _ -> None
+    | _ ->
-      end
+        None
-    | _ -> None
+
   let rpc_arg = rpc_arg
+
   let encoding = encoding
+
   let compare = compare
 end

vendors/ligo-utils/tezos-protocol-alpha/raw_level_repr.mli

@@ -27,14 +27,21 @@
     since genesis: genesis is 0, all other blocks have increasing levels from
     there. *)
 type t
+
 type raw_level = t
+
 val encoding : raw_level Data_encoding.t
+
 val rpc_arg : raw_level RPC_arg.arg
+
 val pp : Format.formatter -> raw_level -> unit
+
 include Compare.S with type t := raw_level
 
 val to_int32 : raw_level -> int32
+
 val of_int32_exn : int32 -> raw_level
+
 val of_int32 : int32 -> raw_level tzresult
 
 val diff : raw_level -> raw_level -> int32
@@ -42,6 +49,7 @@ val diff: raw_level -> raw_level -> int32
 val root : raw_level
 
 val succ : raw_level -> raw_level
+
 val pred : raw_level -> raw_level option
 
 module Index : Storage_description.INDEX with type t = raw_level

vendors/ligo-utils/tezos-protocol-alpha/roll_repr.ml

@@ -24,38 +24,42 @@
 (*****************************************************************************)
 
 include Compare.Int32
+
 type roll = t
 
 let encoding = Data_encoding.int32
 
 let first = 0l
+
 let succ i = Int32.succ i
 
-let random sequence ~bound =
+let random sequence ~bound = Seed_repr.take_int32 sequence bound
-  Seed_repr.take_int32 sequence bound
 
-let rpc_arg =
+let rpc_arg = RPC_arg.like RPC_arg.int32 "roll"
-  RPC_arg.like
-    RPC_arg.int32
-    "roll"
 
 let to_int32 v = v
 
-
 module Index = struct
   type t = roll
+
   let path_length = 3
+
   let to_path roll l =
-    (Int32.to_string @@ Int32.logand roll (Int32.of_int 0xff)) ::
+    (Int32.to_string @@ Int32.logand roll (Int32.of_int 0xff))
-    (Int32.to_string @@ Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 0xff)) ::
+    :: ( Int32.to_string
-    Int32.to_string roll :: l
+       @@ Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 0xff)
+       )
+    :: Int32.to_string roll :: l
+
   let of_path = function
-    | _ :: _ :: s :: _ -> begin
+    | _ :: _ :: s :: _ -> (
-        try Some (Int32.of_string s)
+      try Some (Int32.of_string s) with _ -> None )
-        with _ -> None
+    | _ ->
-      end
+        None
-    | _ -> None
+
   let rpc_arg = rpc_arg
+
   let encoding = encoding
+
   let compare = compare
 end

vendors/ligo-utils/tezos-protocol-alpha/roll_repr.mli

@@ -24,15 +24,17 @@
 (*****************************************************************************)
 
 type t = private int32
+
 type roll = t
 
 val encoding : roll Data_encoding.t
+
 val rpc_arg : roll RPC_arg.t
 
-val random:
+val random : Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence
-  Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence
 
 val first : roll
+
 val succ : roll -> roll
 
 val to_int32 : roll -> Int32.t

vendors/ligo-utils/tezos-protocol-alpha/roll_storage.ml

@@ -29,7 +29,9 @@ type error +=
   | Consume_roll_change (* `Permanent *)
   | No_roll_for_delegate (* `Permanent *)
   | No_roll_snapshot_for_cycle of Cycle_repr.t (* `Permanent *)
-  | Unregistered_delegate of Signature.Public_key_hash.t (* `Permanent *)
+  | Unregistered_delegate of Signature.Public_key_hash.t
+
+(* `Permanent *)
 
 let () =
   let open Data_encoding in
@@ -59,10 +61,14 @@ let () =
     `Permanent
     ~id:"contract.manager.no_roll_snapshot_for_cycle"
     ~title:"No roll snapshot for cycle"
-    ~description:"A snapshot of the rolls distribution does not exist for this cycle."
+    ~description:
+      "A snapshot of the rolls distribution does not exist for this cycle."
     ~pp:(fun ppf c ->
-        Format.fprintf ppf
+      Format.fprintf
-          "A snapshot of the rolls distribution does not exist for cycle %a" Cycle_repr.pp c)
+        ppf
+        "A snapshot of the rolls distribution does not exist for cycle %a"
+        Cycle_repr.pp
+        c)
     (obj1 (req "cycle" Cycle_repr.encoding))
     (function No_roll_snapshot_for_cycle c -> Some c | _ -> None)
     (fun c -> No_roll_snapshot_for_cycle c) ;
@@ -73,9 +79,12 @@ let () =
     ~title:"Unregistered delegate"
     ~description:"A contract cannot be delegated to an unregistered delegate"
     ~pp:(fun ppf k ->
-        Format.fprintf ppf "The provided public key (with hash %a) is \
+      Format.fprintf
-                           \ not registered as valid delegate key."
+        ppf
-          Signature.Public_key_hash.pp k)
+        "The provided public key (with hash %a) is  not registered as valid \
+         delegate key."
+        Signature.Public_key_hash.pp
+        k)
     (obj1 (req "hash" Signature.Public_key_hash.encoding))
     (function Unregistered_delegate k -> Some k | _ -> None)
     (fun k -> Unregistered_delegate k)
@@ -84,96 +93,109 @@ let get_contract_delegate c contract =
   Storage.Contract.Delegate.get_option c contract
 
 let delegate_pubkey ctxt delegate =
-  Storage.Contract.Manager.get_option ctxt
+  Storage.Contract.Manager.get_option
-    (Contract_repr.implicit_contract delegate) >>=? function
+    ctxt
+    (Contract_repr.implicit_contract delegate)
+  >>=? function
   | None | Some (Manager_repr.Hash _) ->
       fail (Unregistered_delegate delegate)
   | Some (Manager_repr.Public_key pk) ->
       return pk
 
 let clear_cycle c cycle =
-  Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->
+  Storage.Roll.Snapshot_for_cycle.get c cycle
-  Storage.Roll.Snapshot_for_cycle.delete c cycle >>=? fun c ->
+  >>=? fun index ->
-  Storage.Roll.Last_for_snapshot.delete (c, cycle) index >>=? fun c ->
+  Storage.Roll.Snapshot_for_cycle.delete c cycle
-  Storage.Roll.Owner.delete_snapshot c (cycle, index) >>= fun c ->
+  >>=? fun c ->
-  return c
+  Storage.Roll.Last_for_snapshot.delete (c, cycle) index
+  >>=? fun c ->
+  Storage.Roll.Owner.delete_snapshot c (cycle, index) >>= fun c -> return c
 
 let fold ctxt ~f init =
-  Storage.Roll.Next.get ctxt >>=? fun last ->
+  Storage.Roll.Next.get ctxt
+  >>=? fun last ->
   let rec loop ctxt roll acc =
-    acc >>=? fun acc ->
+    acc
-    if Roll_repr.(roll = last) then
+    >>=? fun acc ->
-      return acc
+    if Roll_repr.(roll = last) then return acc
     else
-      Storage.Roll.Owner.get_option ctxt roll >>=? function
+      Storage.Roll.Owner.get_option ctxt roll
+      >>=? function
       | None ->
           loop ctxt (Roll_repr.succ roll) (return acc)
       | Some delegate ->
-          loop ctxt (Roll_repr.succ roll) (f roll delegate acc) in
+          loop ctxt (Roll_repr.succ roll) (f roll delegate acc)
+  in
   loop ctxt Roll_repr.first (return init)
 
 let snapshot_rolls_for_cycle ctxt cycle =
-  Storage.Roll.Snapshot_for_cycle.get ctxt cycle >>=? fun index ->
+  Storage.Roll.Snapshot_for_cycle.get ctxt cycle
-  Storage.Roll.Snapshot_for_cycle.set ctxt cycle (index + 1) >>=? fun ctxt ->
+  >>=? fun index ->
-  Storage.Roll.Owner.snapshot ctxt (cycle, index) >>=? fun ctxt ->
+  Storage.Roll.Snapshot_for_cycle.set ctxt cycle (index + 1)
-  Storage.Roll.Next.get ctxt >>=? fun last ->
+  >>=? fun ctxt ->
-  Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last >>=? fun ctxt ->
+  Storage.Roll.Owner.snapshot ctxt (cycle, index)
-  return ctxt
+  >>=? fun ctxt ->
+  Storage.Roll.Next.get ctxt
+  >>=? fun last ->
+  Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last
+  >>=? fun ctxt -> return ctxt
 
 let freeze_rolls_for_cycle ctxt cycle =
-  Storage.Roll.Snapshot_for_cycle.get ctxt cycle >>=? fun max_index ->
+  Storage.Roll.Snapshot_for_cycle.get ctxt cycle
-  Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed ->
+  >>=? fun max_index ->
+  Storage.Seed.For_cycle.get ctxt cycle
+  >>=? fun seed ->
   let rd = Seed_repr.initialize_new seed [MBytes.of_string "roll_snapshot"] in
   let seq = Seed_repr.sequence rd 0l in
   let selected_index =
-    Seed_repr.take_int32 seq (Int32.of_int max_index) |> fst |> Int32.to_int in
+    Seed_repr.take_int32 seq (Int32.of_int max_index) |> fst |> Int32.to_int
-  Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index >>=? fun ctxt ->
+  in
+  Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index
+  >>=? fun ctxt ->
   fold_left_s
     (fun ctxt index ->
-       if Compare.Int.(index = selected_index) then
+      if Compare.Int.(index = selected_index) then return ctxt
-         return ctxt
       else
-         Storage.Roll.Owner.delete_snapshot ctxt (cycle, index) >>= fun ctxt ->
+        Storage.Roll.Owner.delete_snapshot ctxt (cycle, index)
-         Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index >>=? fun ctxt ->
+        >>= fun ctxt ->
-         return ctxt
+        Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index
-    )
+        >>=? fun ctxt -> return ctxt)
     ctxt
-    Misc.(0 --> (max_index - 1)) >>=? fun ctxt ->
+    Misc.(0 --> (max_index - 1))
-  return ctxt
+  >>=? fun ctxt -> return ctxt
 
 (* Roll selection *)
 
 module Random = struct
-
   let int32_to_bytes i =
     let b = MBytes.create 4 in
-    MBytes.set_int32 b 0 i;
+    MBytes.set_int32 b 0 i ; b
-    b
 
   let level_random seed use level =
     let position = level.Level_repr.cycle_position in
-    Seed_repr.initialize_new seed
+    Seed_repr.initialize_new
-      [MBytes.of_string ("level "^use^":");
+      seed
-       int32_to_bytes position]
+      [MBytes.of_string ("level " ^ use ^ ":"); int32_to_bytes position]
 
   let owner c kind level offset =
     let cycle = level.Level_repr.cycle in
-    Seed_storage.for_cycle c cycle >>=? fun random_seed ->
+    Seed_storage.for_cycle c cycle
+    >>=? fun random_seed ->
     let rd = level_random random_seed kind level in
     let sequence = Seed_repr.sequence rd (Int32.of_int offset) in
-    Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->
+    Storage.Roll.Snapshot_for_cycle.get c cycle
-    Storage.Roll.Last_for_snapshot.get (c, cycle) index >>=? fun bound ->
+    >>=? fun index ->
+    Storage.Roll.Last_for_snapshot.get (c, cycle) index
+    >>=? fun bound ->
     let rec loop sequence =
-      let roll, sequence = Roll_repr.random sequence ~bound in
+      let (roll, sequence) = Roll_repr.random sequence ~bound in
-      Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll) >>=? function
+      Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll)
-      | None ->
+      >>=? function None -> loop sequence | Some delegate -> return delegate
-          loop sequence
+    in
-      | Some delegate ->
+    Storage.Roll.Owner.snapshot_exists c (cycle, index)
-          return delegate in
+    >>= fun snapshot_exists ->
-    Storage.Roll.Owner.snapshot_exists c (cycle, index) >>= fun snapshot_exists ->
+    fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle)
-    fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle) >>=? fun () ->
+    >>=? fun () -> loop sequence
-    loop sequence
-
 end
 
 let baking_rights_owner c level ~priority =
@@ -184,125 +206,153 @@ let endorsement_rights_owner c level ~slot =
 
 let traverse_rolls ctxt head =
   let rec loop acc roll =
-    Storage.Roll.Successor.get_option ctxt roll >>=? function
+    Storage.Roll.Successor.get_option ctxt roll
-    | None -> return (List.rev acc)
+    >>=? function
-    | Some next -> loop (next :: acc) next in
+    | None -> return (List.rev acc) | Some next -> loop (next :: acc) next
+  in
   loop [head] head
 
 let get_rolls ctxt delegate =
-  Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function
+  Storage.Roll.Delegate_roll_list.get_option ctxt delegate
-  | None -> return_nil
+  >>=? function
-  | Some head_roll -> traverse_rolls ctxt head_roll
+  | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll
 
 let count_rolls ctxt delegate =
-  Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function
+  Storage.Roll.Delegate_roll_list.get_option ctxt delegate
-  | None -> return 0
+  >>=? function
+  | None ->
+      return 0
   | Some head_roll ->
       let rec loop acc roll =
-        Storage.Roll.Successor.get_option ctxt roll >>=? function
+        Storage.Roll.Successor.get_option ctxt roll
-        | None -> return acc
+        >>=? function None -> return acc | Some next -> loop (succ acc) next
-        | Some next -> loop (succ acc) next in
+      in
       loop 1 head_roll
 
 let get_change c delegate =
-  Storage.Roll.Delegate_change.get_option c delegate >>=? function
+  Storage.Roll.Delegate_change.get_option c delegate
-  | None -> return Tez_repr.zero
+  >>=? function None -> return Tez_repr.zero | Some change -> return change
-  | Some change -> return change
 
 module Delegate = struct
-
   let fresh_roll c =
-    Storage.Roll.Next.get c >>=? fun roll ->
+    Storage.Roll.Next.get c
-    Storage.Roll.Next.set c (Roll_repr.succ roll) >>=? fun c ->
+    >>=? fun roll ->
-    return (roll, c)
+    Storage.Roll.Next.set c (Roll_repr.succ roll) >>=? fun c -> return (roll, c)
 
   let get_limbo_roll c =
-    Storage.Roll.Limbo.get_option c >>=? function
+    Storage.Roll.Limbo.get_option c
+    >>=? function
     | None ->
-        fresh_roll c >>=? fun (roll, c) ->
+        fresh_roll c
-        Storage.Roll.Limbo.init c roll >>=? fun c ->
+        >>=? fun (roll, c) ->
-        return (roll, c)
+        Storage.Roll.Limbo.init c roll >>=? fun c -> return (roll, c)
     | Some roll ->
         return (roll, c)
 
   let consume_roll_change c delegate =
     let tokens_per_roll = Constants_storage.tokens_per_roll c in
-    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+    Storage.Roll.Delegate_change.get c delegate
-    trace Consume_roll_change
+    >>=? fun change ->
-      (Lwt.return Tez_repr.(change -? tokens_per_roll)) >>=? fun new_change ->
+    trace Consume_roll_change (Lwt.return Tez_repr.(change -? tokens_per_roll))
+    >>=? fun new_change ->
     Storage.Roll.Delegate_change.set c delegate new_change
 
   let recover_roll_change c delegate =
     let tokens_per_roll = Constants_storage.tokens_per_roll c in
-    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+    Storage.Roll.Delegate_change.get c delegate
-    Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun new_change ->
+    >>=? fun change ->
+    Lwt.return Tez_repr.(change +? tokens_per_roll)
+    >>=? fun new_change ->
     Storage.Roll.Delegate_change.set c delegate new_change
 
   let pop_roll_from_delegate c delegate =
-    recover_roll_change c delegate >>=? fun c ->
+    recover_roll_change c delegate
+    >>=? fun c ->
     (* beginning:
        delegate : roll -> successor_roll -> ...
        limbo : limbo_head -> ...
     *)
-    Storage.Roll.Limbo.get_option c >>=? fun limbo_head ->
+    Storage.Roll.Limbo.get_option c
-    Storage.Roll.Delegate_roll_list.get_option c delegate >>=? function
+    >>=? fun limbo_head ->
-    | None -> fail No_roll_for_delegate
+    Storage.Roll.Delegate_roll_list.get_option c delegate
+    >>=? function
+    | None ->
+        fail No_roll_for_delegate
     | Some roll ->
-        Storage.Roll.Owner.delete c roll >>=? fun c ->
+        Storage.Roll.Owner.delete c roll
-        Storage.Roll.Successor.get_option c roll >>=? fun successor_roll ->
+        >>=? fun c ->
-        Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll >>= fun c ->
+        Storage.Roll.Successor.get_option c roll
+        >>=? fun successor_roll ->
+        Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll
+        >>= fun c ->
         (* delegate : successor_roll -> ...
            roll ------^
            limbo : limbo_head -> ... *)
-        Storage.Roll.Successor.set_option c roll limbo_head >>= fun c ->
+        Storage.Roll.Successor.set_option c roll limbo_head
+        >>= fun c ->
         (* delegate : successor_roll -> ...
            roll ------v
            limbo : limbo_head -> ... *)
-        Storage.Roll.Limbo.init_set c roll >>= fun c ->
+        Storage.Roll.Limbo.init_set c roll
+        >>= fun c ->
         (* delegate : successor_roll -> ...
            limbo : roll -> limbo_head -> ... *)
         return (roll, c)
 
   let create_roll_in_delegate c delegate delegate_pk =
-    consume_roll_change c delegate >>=? fun c ->
+    consume_roll_change c delegate
-
+    >>=? fun c ->
     (* beginning:
        delegate : delegate_head -> ...
        limbo : roll -> limbo_successor -> ...
     *)
-    Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun delegate_head ->
+    Storage.Roll.Delegate_roll_list.get_option c delegate
-    get_limbo_roll c >>=? fun (roll, c) ->
+    >>=? fun delegate_head ->
-    Storage.Roll.Owner.init c roll delegate_pk >>=? fun c ->
+    get_limbo_roll c
-    Storage.Roll.Successor.get_option c roll >>=? fun limbo_successor ->
+    >>=? fun (roll, c) ->
-    Storage.Roll.Limbo.set_option c limbo_successor >>= fun c ->
+    Storage.Roll.Owner.init c roll delegate_pk
+    >>=? fun c ->
+    Storage.Roll.Successor.get_option c roll
+    >>=? fun limbo_successor ->
+    Storage.Roll.Limbo.set_option c limbo_successor
+    >>= fun c ->
     (* delegate : delegate_head -> ...
        roll ------v
        limbo : limbo_successor -> ... *)
-    Storage.Roll.Successor.set_option c roll delegate_head >>= fun c ->
+    Storage.Roll.Successor.set_option c roll delegate_head
+    >>= fun c ->
     (* delegate : delegate_head -> ...
        roll ------^
        limbo : limbo_successor -> ... *)
-    Storage.Roll.Delegate_roll_list.init_set c delegate roll >>= fun c ->
+    Storage.Roll.Delegate_roll_list.init_set c delegate roll
+    >>= fun c ->
     (* delegate : roll -> delegate_head -> ...
        limbo : limbo_successor -> ... *)
     return c
 
   let ensure_inited c delegate =
-    Storage.Roll.Delegate_change.mem c delegate >>= function
+    Storage.Roll.Delegate_change.mem c delegate
-    | true -> return c
+    >>= function
+    | true ->
+        return c
     | false ->
         Storage.Roll.Delegate_change.init c delegate Tez_repr.zero
 
   let is_inactive c delegate =
-    Storage.Contract.Inactive_delegate.mem c
+    Storage.Contract.Inactive_delegate.mem
-      (Contract_repr.implicit_contract delegate) >>= fun inactive ->
+      c
-    if inactive then
+      (Contract_repr.implicit_contract delegate)
-      return inactive
+    >>= fun inactive ->
+    if inactive then return inactive
     else
-      Storage.Contract.Delegate_desactivation.get_option c
+      Storage.Contract.Delegate_desactivation.get_option
-        (Contract_repr.implicit_contract delegate) >>=? function
+        c
+        (Contract_repr.implicit_contract delegate)
+      >>=? function
       | Some last_active_cycle ->
-          let { Level_repr.cycle = current_cycle } = Raw_context.current_level c in
+          let {Level_repr.cycle = current_cycle} =
+            Raw_context.current_level c
+          in
           return Cycle_repr.(last_active_cycle < current_cycle)
       | None ->
           (* This case is only when called from `set_active`, when creating
@@ -310,79 +360,101 @@ module Delegate = struct
           return_false
 
   let add_amount c delegate amount =
-    ensure_inited c delegate >>=? fun c ->
+    ensure_inited c delegate
+    >>=? fun c ->
     let tokens_per_roll = Constants_storage.tokens_per_roll c in
-    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+    Storage.Roll.Delegate_change.get c delegate
-    Lwt.return Tez_repr.(amount +? change) >>=? fun change ->
+    >>=? fun change ->
-    Storage.Roll.Delegate_change.set c delegate change >>=? fun c ->
+    Lwt.return Tez_repr.(amount +? change)
-    delegate_pubkey c delegate >>=? fun delegate_pk ->
+    >>=? fun change ->
+    Storage.Roll.Delegate_change.set c delegate change
+    >>=? fun c ->
+    delegate_pubkey c delegate
+    >>=? fun delegate_pk ->
     let rec loop c change =
-      if Tez_repr.(change < tokens_per_roll) then
+      if Tez_repr.(change < tokens_per_roll) then return c
-        return c
       else
-        Lwt.return Tez_repr.(change -? tokens_per_roll) >>=? fun  change ->
+        Lwt.return Tez_repr.(change -? tokens_per_roll)
-        create_roll_in_delegate c delegate delegate_pk >>=? fun c ->
+        >>=? fun change ->
-        loop c change in
+        create_roll_in_delegate c delegate delegate_pk
-    is_inactive c delegate >>=? fun inactive ->
+        >>=? fun c -> loop c change
-    if inactive then
+    in
-      return c
+    is_inactive c delegate
+    >>=? fun inactive ->
+    if inactive then return c
     else
-      loop c change >>=? fun c ->
+      loop c change
-      Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun rolls ->
+      >>=? fun c ->
+      Storage.Roll.Delegate_roll_list.get_option c delegate
+      >>=? fun rolls ->
       match rolls with
       | None ->
           return c
       | Some _ ->
-          Storage.Active_delegates_with_rolls.add c delegate >>= fun c ->
+          Storage.Active_delegates_with_rolls.add c delegate
-          return c
+          >>= fun c -> return c
 
   let remove_amount c delegate amount =
     let tokens_per_roll = Constants_storage.tokens_per_roll c in
     let rec loop c change =
-      if Tez_repr.(amount <= change)
+      if Tez_repr.(amount <= change) then return (c, change)
-      then return (c, change)
       else
-        pop_roll_from_delegate c delegate >>=? fun (_, c) ->
+        pop_roll_from_delegate c delegate
-        Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun change ->
+        >>=? fun (_, c) ->
-        loop c change in
+        Lwt.return Tez_repr.(change +? tokens_per_roll)
-    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->
+        >>=? fun change -> loop c change
-    is_inactive c delegate >>=? fun inactive ->
+    in
-    begin
+    Storage.Roll.Delegate_change.get c delegate
-      if inactive then
+    >>=? fun change ->
-        return (c, change)
+    is_inactive c delegate
+    >>=? fun inactive ->
+    ( if inactive then return (c, change)
     else
-        loop c change >>=? fun (c, change) ->
+      loop c change
-        Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun rolls ->
+      >>=? fun (c, change) ->
+      Storage.Roll.Delegate_roll_list.get_option c delegate
+      >>=? fun rolls ->
       match rolls with
       | None ->
-            Storage.Active_delegates_with_rolls.del c delegate >>= fun c ->
+          Storage.Active_delegates_with_rolls.del c delegate
-            return (c, change)
+          >>= fun c -> return (c, change)
       | Some _ ->
-            return (c, change)
+          return (c, change) )
-    end >>=? fun (c, change) ->
+    >>=? fun (c, change) ->
-    Lwt.return Tez_repr.(change -? amount) >>=? fun change ->
+    Lwt.return Tez_repr.(change -? amount)
-    Storage.Roll.Delegate_change.set c delegate change
+    >>=? fun change -> Storage.Roll.Delegate_change.set c delegate change
 
   let set_inactive ctxt delegate =
-    ensure_inited ctxt delegate >>=? fun ctxt ->
+    ensure_inited ctxt delegate
+    >>=? fun ctxt ->
     let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
-    Storage.Roll.Delegate_change.get ctxt delegate >>=? fun change ->
+    Storage.Roll.Delegate_change.get ctxt delegate
-    Storage.Contract.Inactive_delegate.add ctxt
+    >>=? fun change ->
-      (Contract_repr.implicit_contract delegate) >>= fun ctxt ->
+    Storage.Contract.Inactive_delegate.add
-    Storage.Active_delegates_with_rolls.del ctxt delegate >>= fun ctxt ->
+      ctxt
+      (Contract_repr.implicit_contract delegate)
+    >>= fun ctxt ->
+    Storage.Active_delegates_with_rolls.del ctxt delegate
+    >>= fun ctxt ->
     let rec loop ctxt change =
-      Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function
+      Storage.Roll.Delegate_roll_list.get_option ctxt delegate
-      | None -> return (ctxt, change)
+      >>=? function
+      | None ->
+          return (ctxt, change)
       | Some _roll ->
-          pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) ->
+          pop_roll_from_delegate ctxt delegate
-          Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun change ->
+          >>=? fun (_, ctxt) ->
-          loop ctxt change in
+          Lwt.return Tez_repr.(change +? tokens_per_roll)
-    loop ctxt change >>=? fun (ctxt, change) ->
+          >>=? fun change -> loop ctxt change
-    Storage.Roll.Delegate_change.set ctxt delegate change >>=? fun ctxt ->
+    in
-    return ctxt
+    loop ctxt change
+    >>=? fun (ctxt, change) ->
+    Storage.Roll.Delegate_change.set ctxt delegate change
+    >>=? fun ctxt -> return ctxt
 
   let set_active ctxt delegate =
-    is_inactive ctxt delegate >>=? fun inactive ->
+    is_inactive ctxt delegate
+    >>=? fun inactive ->
     let current_cycle = (Raw_context.current_level ctxt).cycle in
     let preserved_cycles = Constants_storage.preserved_cycles ctxt in
     (* When the delegate is new or inactive, she will become active in
@@ -390,86 +462,102 @@ module Delegate = struct
        delegate to start baking. When the delegate is active, we only
        give her at least `preserved_cycles` after the current cycle
        before to be deactivated.  *)
-    Storage.Contract.Delegate_desactivation.get_option ctxt
+    Storage.Contract.Delegate_desactivation.get_option
-      (Contract_repr.implicit_contract delegate) >>=? fun current_expiration ->
+      ctxt
-    let expiration = match current_expiration with
+      (Contract_repr.implicit_contract delegate)
+    >>=? fun current_expiration ->
+    let expiration =
+      match current_expiration with
       | None ->
-          Cycle_repr.add current_cycle (1+2*preserved_cycles)
+          Cycle_repr.add current_cycle (1 + (2 * preserved_cycles))
       | Some current_expiration ->
           let delay =
-            if inactive then (1+2*preserved_cycles) else 1+preserved_cycles in
+            if inactive then 1 + (2 * preserved_cycles)
-          let updated =
+            else 1 + preserved_cycles
-            Cycle_repr.add current_cycle delay in
+          in
-          Cycle_repr.max current_expiration updated in
+          let updated = Cycle_repr.add current_cycle delay in
-    Storage.Contract.Delegate_desactivation.init_set ctxt
+          Cycle_repr.max current_expiration updated
+    in
+    Storage.Contract.Delegate_desactivation.init_set
+      ctxt
       (Contract_repr.implicit_contract delegate)
-      expiration >>= fun ctxt ->
+      expiration
-    if not inactive then
+    >>= fun ctxt ->
-      return ctxt
+    if not inactive then return ctxt
-    else begin
-      ensure_inited ctxt delegate >>=? fun ctxt ->
-      let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
-      Storage.Roll.Delegate_change.get ctxt delegate >>=? fun change ->
-      Storage.Contract.Inactive_delegate.del ctxt
-        (Contract_repr.implicit_contract delegate) >>= fun ctxt ->
-      delegate_pubkey ctxt delegate >>=? fun delegate_pk ->
-      let rec loop ctxt change =
-        if Tez_repr.(change < tokens_per_roll) then
-          return ctxt
     else
-          Lwt.return Tez_repr.(change -? tokens_per_roll) >>=? fun  change ->
+      ensure_inited ctxt delegate
-          create_roll_in_delegate ctxt delegate delegate_pk >>=? fun ctxt ->
+      >>=? fun ctxt ->
-          loop ctxt change in
+      let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
-      loop ctxt change >>=? fun ctxt ->
+      Storage.Roll.Delegate_change.get ctxt delegate
-      Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? fun rolls ->
+      >>=? fun change ->
+      Storage.Contract.Inactive_delegate.del
+        ctxt
+        (Contract_repr.implicit_contract delegate)
+      >>= fun ctxt ->
+      delegate_pubkey ctxt delegate
+      >>=? fun delegate_pk ->
+      let rec loop ctxt change =
+        if Tez_repr.(change < tokens_per_roll) then return ctxt
+        else
+          Lwt.return Tez_repr.(change -? tokens_per_roll)
+          >>=? fun change ->
+          create_roll_in_delegate ctxt delegate delegate_pk
+          >>=? fun ctxt -> loop ctxt change
+      in
+      loop ctxt change
+      >>=? fun ctxt ->
+      Storage.Roll.Delegate_roll_list.get_option ctxt delegate
+      >>=? fun rolls ->
       match rolls with
       | None ->
           return ctxt
       | Some _ ->
-          Storage.Active_delegates_with_rolls.add ctxt delegate >>= fun ctxt ->
+          Storage.Active_delegates_with_rolls.add ctxt delegate
-          return ctxt
+          >>= fun ctxt -> return ctxt
-    end
-
 end
 
 module Contract = struct
-
   let add_amount c contract amount =
-    get_contract_delegate c contract >>=? function
+    get_contract_delegate c contract
-    | None -> return c
+    >>=? function
-    | Some delegate ->
+    | None -> return c | Some delegate -> Delegate.add_amount c delegate amount
-        Delegate.add_amount c delegate amount
 
   let remove_amount c contract amount =
-    get_contract_delegate c contract >>=? function
+    get_contract_delegate c contract
-    | None -> return c
+    >>=? function
+    | None ->
+        return c
     | Some delegate ->
         Delegate.remove_amount c delegate amount
-
 end
 
-let init ctxt =
+let init ctxt = Storage.Roll.Next.init ctxt Roll_repr.first
-  Storage.Roll.Next.init ctxt Roll_repr.first
 
 let init_first_cycles ctxt =
   let preserved = Constants_storage.preserved_cycles ctxt in
   (* Precompute rolls for cycle (0 --> preserved_cycles) *)
   List.fold_left
     (fun ctxt c ->
-       ctxt >>=? fun ctxt ->
+      ctxt
+      >>=? fun ctxt ->
       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
-       Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->
+      Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
-       snapshot_rolls_for_cycle ctxt cycle >>=? fun ctxt ->
+      >>=? fun ctxt ->
-       freeze_rolls_for_cycle ctxt cycle)
+      snapshot_rolls_for_cycle ctxt cycle
-    (return ctxt) (0 --> preserved) >>=? fun ctxt ->
+      >>=? fun ctxt -> freeze_rolls_for_cycle ctxt cycle)
+    (return ctxt)
+    (0 --> preserved)
+  >>=? fun ctxt ->
   let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 1)) in
   (* Precomputed a snapshot for cycle (preserved_cycles + 1) *)
-  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->
+  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
-  snapshot_rolls_for_cycle ctxt cycle >>=? fun ctxt ->
+  >>=? fun ctxt ->
+  snapshot_rolls_for_cycle ctxt cycle
+  >>=? fun ctxt ->
   (* Prepare storage for storing snapshots for cycle (preserved_cycles+2) *)
   let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 2)) in
-  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->
+  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
-  return ctxt
+  >>=? fun ctxt -> return ctxt
 
 let snapshot_rolls ctxt =
   let current_level = Raw_context.current_level ctxt in
@@ -479,37 +567,38 @@ let snapshot_rolls ctxt =
 
 let cycle_end ctxt last_cycle =
   let preserved = Constants_storage.preserved_cycles ctxt in
-  begin
+  ( match Cycle_repr.sub last_cycle preserved with
-    match Cycle_repr.sub last_cycle preserved with
+  | None ->
-    | None -> return ctxt
-    | Some cleared_cycle ->
-        clear_cycle ctxt cleared_cycle
-  end >>=? fun ctxt ->
-  let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved+1) in
-  freeze_rolls_for_cycle ctxt frozen_roll_cycle >>=? fun ctxt ->
-  Storage.Roll.Snapshot_for_cycle.init
-    ctxt (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle)) 0 >>=? fun ctxt ->
       return ctxt
+  | Some cleared_cycle ->
+      clear_cycle ctxt cleared_cycle )
+  >>=? fun ctxt ->
+  let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved + 1) in
+  freeze_rolls_for_cycle ctxt frozen_roll_cycle
+  >>=? fun ctxt ->
+  Storage.Roll.Snapshot_for_cycle.init
+    ctxt
+    (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle))
+    0
+  >>=? fun ctxt -> return ctxt
 
 let update_tokens_per_roll ctxt new_tokens_per_roll =
   let constants = Raw_context.constants ctxt in
   let old_tokens_per_roll = constants.tokens_per_roll in
-  Raw_context.patch_constants ctxt begin fun constants ->
+  Raw_context.patch_constants ctxt (fun constants ->
-    { constants with Constants_repr.tokens_per_roll = new_tokens_per_roll }
+      {constants with Constants_repr.tokens_per_roll = new_tokens_per_roll})
-  end >>= fun ctxt ->
+  >>= fun ctxt ->
   let decrease = Tez_repr.(new_tokens_per_roll < old_tokens_per_roll) in
-  begin
+  ( if decrease then
-    if decrease then
     Lwt.return Tez_repr.(old_tokens_per_roll -? new_tokens_per_roll)
-    else
+  else Lwt.return Tez_repr.(new_tokens_per_roll -? old_tokens_per_roll) )
-      Lwt.return Tez_repr.(new_tokens_per_roll -? old_tokens_per_roll)
+  >>=? fun abs_diff ->
-  end >>=? fun abs_diff ->
+  Storage.Delegates.fold ctxt (Ok ctxt) (fun pkh ctxt ->
-  Storage.Delegates.fold ctxt (Ok ctxt) begin fun pkh ctxt ->
+      Lwt.return ctxt
-    Lwt.return ctxt >>=? fun ctxt ->
+      >>=? fun ctxt ->
-    count_rolls ctxt pkh >>=? fun rolls ->
+      count_rolls ctxt pkh
-    Lwt.return Tez_repr.(abs_diff *? Int64.of_int rolls) >>=? fun amount ->
+      >>=? fun rolls ->
-    if decrease then
+      Lwt.return Tez_repr.(abs_diff *? Int64.of_int rolls)
-      Delegate.add_amount ctxt pkh amount
+      >>=? fun amount ->
-    else
+      if decrease then Delegate.add_amount ctxt pkh amount
-      Delegate.remove_amount ctxt pkh amount
+      else Delegate.remove_amount ctxt pkh amount)
-  end

vendors/ligo-utils/tezos-protocol-alpha/roll_storage.mli

@@ -37,61 +37,87 @@ type error +=
   | Consume_roll_change
   | No_roll_for_delegate
   | No_roll_snapshot_for_cycle of Cycle_repr.t
-  | Unregistered_delegate of Signature.Public_key_hash.t (* `Permanent *)
+  | Unregistered_delegate of Signature.Public_key_hash.t
+
+(* `Permanent *)
 
 val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
+
 val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t
 
 val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
-val snapshot_rolls : Raw_context.t -> Raw_context.t tzresult Lwt.t
 
+val snapshot_rolls : Raw_context.t -> Raw_context.t tzresult Lwt.t
 
 val fold :
   Raw_context.t ->
   f:(Roll_repr.roll -> Signature.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->
-  'a -> 'a tzresult Lwt.t
+  'a ->
+  'a tzresult Lwt.t
 
 val baking_rights_owner :
-  Raw_context.t -> Level_repr.t -> priority:int ->
+  Raw_context.t ->
+  Level_repr.t ->
+  priority:int ->
   Signature.Public_key.t tzresult Lwt.t
 
 val endorsement_rights_owner :
-  Raw_context.t -> Level_repr.t -> slot:int ->
+  Raw_context.t ->
+  Level_repr.t ->
+  slot:int ->
   Signature.Public_key.t tzresult Lwt.t
 
 module Delegate : sig
-
   val is_inactive :
     Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
   val add_amount :
-    Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+    Raw_context.t ->
+    Signature.Public_key_hash.t ->
+    Tez_repr.t ->
+    Raw_context.t tzresult Lwt.t
 
   val remove_amount :
-    Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+    Raw_context.t ->
+    Signature.Public_key_hash.t ->
+    Tez_repr.t ->
+    Raw_context.t tzresult Lwt.t
 
-  val set_inactive : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
+  val set_inactive :
-
+    Raw_context.t ->
-  val set_active : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
+    Signature.Public_key_hash.t ->
+    Raw_context.t tzresult Lwt.t
 
+  val set_active :
+    Raw_context.t ->
+    Signature.Public_key_hash.t ->
+    Raw_context.t tzresult Lwt.t
 end
 
 module Contract : sig
-
   val add_amount :
-    Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+    Raw_context.t ->
+    Contract_repr.t ->
+    Tez_repr.t ->
+    Raw_context.t tzresult Lwt.t
 
   val remove_amount :
-    Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+    Raw_context.t ->
-
+    Contract_repr.t ->
+    Tez_repr.t ->
+    Raw_context.t tzresult Lwt.t
 end
 
 val delegate_pubkey :
-  Raw_context.t -> Signature.Public_key_hash.t ->
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
   Signature.Public_key.t tzresult Lwt.t
 
 val get_rolls :
-  Raw_context.t -> Signature.Public_key_hash.t -> Roll_repr.t list tzresult Lwt.t
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Roll_repr.t list tzresult Lwt.t
+
 val get_change :
   Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
 
@@ -101,4 +127,6 @@ val update_tokens_per_roll:
 (**/**)
 
 val get_contract_delegate :
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option tzresult Lwt.t
+  Raw_context.t ->
+  Contract_repr.t ->
+  Signature.Public_key_hash.t option tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/script_expr_hash.ml

@@ -25,12 +25,16 @@
 
 let script_expr_hash = "\013\044\064\027" (* expr(54) *)
 
-include Blake2B.Make(Base58)(struct
+include Blake2B.Make
+          (Base58)
+          (struct
             let name = "script_expr"
+
             let title = "A script expression ID"
+
             let b58check_prefix = script_expr_hash
+
             let size = None
           end)
 
-let () =
+let () = Base58.check_encoded_prefix b58check_encoding "expr" 54
-  Base58.check_encoded_prefix b58check_encoding "expr" 54

vendors/ligo-utils/tezos-protocol-alpha/script_int_repr.ml

@@ -24,28 +24,37 @@
 (*****************************************************************************)
 
 type n = Natural_tag
+
 type z = Integer_tag
+
 type 't num = Z.t
 
 let compare x y = Z.compare x y
 
 let zero = Z.zero
+
 let zero_n = Z.zero
 
 let to_string x = Z.to_string x
+
 let of_string s = try Some (Z.of_string s) with _ -> None
 
 let to_int64 x = try Some (Z.to_int64 x) with _ -> None
+
 let of_int64 n = Z.of_int64 n
 
 let to_int x = try Some (Z.to_int x) with _ -> None
+
 let of_int n = Z.of_int n
 
 let of_zint x = x
+
 let to_zint x = x
 
 let add x y = Z.add x y
+
 let sub x y = Z.sub x y
+
 let mul x y = Z.mul x y
 
 let ediv x y =
@@ -55,33 +64,39 @@ let ediv x y =
   with _ -> None
 
 let add_n = add
+
 let mul_n = mul
+
 let ediv_n = ediv
 
 let abs x = Z.abs x
-let is_nat x =
+
-  if Compare.Z.(x < Z.zero) then None else Some x
+let is_nat x = if Compare.Z.(x < Z.zero) then None else Some x
+
 let neg x = Z.neg x
+
 let int x = x
 
 let shift_left x y =
-  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then
+  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None
-    None
   else
     let y = Z.to_int y in
     Some (Z.shift_left x y)
 
 let shift_right x y =
-  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then
+  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None
-    None
   else
     let y = Z.to_int y in
     Some (Z.shift_right x y)
 
 let shift_left_n = shift_left
+
 let shift_right_n = shift_right
 
 let logor x y = Z.logor x y
+
 let logxor x y = Z.logxor x y
+
 let logand x y = Z.logand x y
+
 let lognot x = Z.lognot x

vendors/ligo-utils/tezos-protocol-alpha/script_interpreter.mli

@@ -28,26 +28,35 @@ open Alpha_context
 type execution_trace =
   (Script.location * Gas.t * (Script.expr * string option) list) list
 
-type error += Reject of Script.location * Script.expr * execution_trace option
+type error +=
+  | Reject of Script.location * Script.expr * execution_trace option
+
 type error += Overflow of Script.location * execution_trace option
+
 type error += Runtime_contract_error : Contract.t * Script.expr -> error
+
 type error += Bad_contract_parameter of Contract.t (* `Permanent *)
+
 type error += Cannot_serialize_log
+
 type error += Cannot_serialize_failure
+
 type error += Cannot_serialize_storage
 
-type execution_result =
+type execution_result = {
-  { ctxt : context ;
+  ctxt : context;
   storage : Script.expr;
   big_map_diff : Contract.big_map_diff option;
-    operations : packed_internal_operation list }
+  operations : packed_internal_operation list;
+}
 
-type step_constants =
+type step_constants = {
-  { source : Contract.t ;
+  source : Contract.t;
   payer : Contract.t;
   self : Contract.t;
   amount : Tez.t;
-    chain_id : Chain_id.t }
+  chain_id : Chain_id.t;
+}
 
 type 'tys stack =
   | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
@@ -55,7 +64,8 @@ type 'tys stack =
 
 val step :
   ?log:execution_trace ref ->
-  context -> step_constants ->
+  context ->
+  step_constants ->
   ('bef, 'aft) Script_typed_ir.descr ->
   'bef stack ->
   ('aft stack * context) tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/script_ir_annot.ml

@@ -29,384 +29,517 @@ open Script_tc_errors
 open Script_typed_ir
 
 let default_now_annot = Some (`Var_annot "now")
+
 let default_amount_annot = Some (`Var_annot "amount")
+
 let default_balance_annot = Some (`Var_annot "balance")
+
 let default_steps_annot = Some (`Var_annot "steps")
+
 let default_source_annot = Some (`Var_annot "source")
+
 let default_sender_annot = Some (`Var_annot "sender")
+
 let default_self_annot = Some (`Var_annot "self")
+
 let default_arg_annot = Some (`Var_annot "arg")
+
 let default_param_annot = Some (`Var_annot "parameter")
+
 let default_storage_annot = Some (`Var_annot "storage")
 
 let default_car_annot = Some (`Field_annot "car")
+
 let default_cdr_annot = Some (`Field_annot "cdr")
+
 let default_contract_annot = Some (`Field_annot "contract")
+
 let default_addr_annot = Some (`Field_annot "address")
+
 let default_manager_annot = Some (`Field_annot "manager")
+
 let default_pack_annot = Some (`Field_annot "packed")
+
 let default_unpack_annot = Some (`Field_annot "unpacked")
+
 let default_slice_annot = Some (`Field_annot "slice")
 
 let default_elt_annot = Some (`Field_annot "elt")
+
 let default_key_annot = Some (`Field_annot "key")
+
 let default_hd_annot = Some (`Field_annot "hd")
+
 let default_tl_annot = Some (`Field_annot "tl")
+
 let default_some_annot = Some (`Field_annot "some")
+
 let default_left_annot = Some (`Field_annot "left")
+
 let default_right_annot = Some (`Field_annot "right")
+
 let default_binding_annot = Some (`Field_annot "bnd")
 
 let unparse_type_annot : type_annot option -> string list = function
-  | None -> []
+  | None ->
-  | Some `Type_annot a -> [ ":" ^ a ]
+      []
+  | Some (`Type_annot a) ->
+      [":" ^ a]
 
 let unparse_var_annot : var_annot option -> string list = function
-  | None -> []
+  | None ->
-  | Some `Var_annot a -> [ "@" ^ a ]
+      []
+  | Some (`Var_annot a) ->
+      ["@" ^ a]
 
 let unparse_field_annot : field_annot option -> string list = function
-  | None -> []
+  | None ->
-  | Some `Field_annot a -> [ "%" ^ a ]
+      []
+  | Some (`Field_annot a) ->
+      ["%" ^ a]
 
-let field_to_var_annot : field_annot option -> var_annot option =
+let field_to_var_annot : field_annot option -> var_annot option = function
-  function
+  | None ->
-  | None -> None
+      None
-  | Some (`Field_annot s) -> Some (`Var_annot s)
+  | Some (`Field_annot s) ->
+      Some (`Var_annot s)
 
-let type_to_var_annot : type_annot option -> var_annot option =
+let type_to_var_annot : type_annot option -> var_annot option = function
-  function
+  | None ->
-  | None -> None
+      None
-  | Some (`Type_annot s) -> Some (`Var_annot s)
+  | Some (`Type_annot s) ->
+      Some (`Var_annot s)
 
-let var_to_field_annot : var_annot option -> field_annot option =
+let var_to_field_annot : var_annot option -> field_annot option = function
-  function
+  | None ->
-  | None -> None
+      None
-  | Some (`Var_annot s) -> Some (`Field_annot s)
+  | Some (`Var_annot s) ->
+      Some (`Field_annot s)
 
-let default_annot ~default = function
+let default_annot ~default = function None -> default | annot -> annot
-  | None -> default
-  | annot -> annot
 
-let gen_access_annot
+let gen_access_annot :
-  : var_annot option -> ?default:field_annot option -> field_annot option -> var_annot option
+    var_annot option ->
-  = fun value_annot ?(default=None) field_annot ->
+    ?default:field_annot option ->
-    match value_annot, field_annot, default with
+    field_annot option ->
-    | None, None, _ | Some _, None, None | None, Some `Field_annot "", _ -> None
+    var_annot option =
-    | None, Some `Field_annot f, _ ->
+ fun value_annot ?(default = None) field_annot ->
+  match (value_annot, field_annot, default) with
+  | (None, None, _) | (Some _, None, None) | (None, Some (`Field_annot ""), _)
+    ->
+      None
+  | (None, Some (`Field_annot f), _) ->
       Some (`Var_annot f)
-    | Some `Var_annot v, (None | Some `Field_annot ""), Some `Field_annot f ->
+  | ( Some (`Var_annot v),
+      (None | Some (`Field_annot "")),
+      Some (`Field_annot f) ) ->
       Some (`Var_annot (String.concat "." [v; f]))
-    | Some `Var_annot v, Some `Field_annot f, _ ->
+  | (Some (`Var_annot v), Some (`Field_annot f), _) ->
       Some (`Var_annot (String.concat "." [v; f]))
 
-let merge_type_annot
+let merge_type_annot :
-  : legacy: bool -> type_annot option -> type_annot option -> type_annot option tzresult
+    legacy:bool ->
-  = fun ~legacy annot1 annot2 ->
+    type_annot option ->
-    match annot1, annot2 with
+    type_annot option ->
-    | None, None
+    type_annot option tzresult =
-    | Some _, None
+ fun ~legacy annot1 annot2 ->
-    | None, Some _ -> ok None
+  match (annot1, annot2) with
-    | Some `Type_annot a1, Some `Type_annot a2 ->
+  | (None, None) | (Some _, None) | (None, Some _) ->
-        if legacy || String.equal a1 a2
+      ok None
-        then ok annot1
+  | (Some (`Type_annot a1), Some (`Type_annot a2)) ->
+      if legacy || String.equal a1 a2 then ok annot1
       else error (Inconsistent_annotations (":" ^ a1, ":" ^ a2))
 
-let merge_field_annot
+let merge_field_annot :
-  : legacy: bool -> field_annot option -> field_annot option -> field_annot option tzresult
+    legacy:bool ->
-  = fun ~legacy annot1 annot2 ->
+    field_annot option ->
-    match annot1, annot2 with
+    field_annot option ->
-    | None, None
+    field_annot option tzresult =
-    | Some _, None
+ fun ~legacy annot1 annot2 ->
-    | None, Some _ -> ok None
+  match (annot1, annot2) with
-    | Some `Field_annot a1, Some `Field_annot a2 ->
+  | (None, None) | (Some _, None) | (None, Some _) ->
-        if legacy || String.equal a1 a2
+      ok None
-        then ok annot1
+  | (Some (`Field_annot a1), Some (`Field_annot a2)) ->
+      if legacy || String.equal a1 a2 then ok annot1
       else error (Inconsistent_annotations ("%" ^ a1, "%" ^ a2))
 
-let merge_var_annot
+let merge_var_annot : var_annot option -> var_annot option -> var_annot option
-  : var_annot option -> var_annot option -> var_annot option
+    =
-  = fun annot1 annot2 ->
+ fun annot1 annot2 ->
-    match annot1, annot2 with
+  match (annot1, annot2) with
-    | None, None
+  | (None, None) | (Some _, None) | (None, Some _) ->
-    | Some _, None
+      None
-    | None, Some _ -> None
+  | (Some (`Var_annot a1), Some (`Var_annot a2)) ->
-    | Some `Var_annot a1, Some `Var_annot a2 ->
       if String.equal a1 a2 then annot1 else None
 
 let error_unexpected_annot loc annot =
-  match annot with
+  match annot with [] -> ok () | _ :: _ -> error (Unexpected_annotation loc)
-  | [] -> ok ()
-  | _ :: _ -> error (Unexpected_annotation loc)
 
 let fail_unexpected_annot loc annot =
   Lwt.return (error_unexpected_annot loc annot)
 
-let parse_annots loc ?(allow_special_var = false) ?(allow_special_field = false) l =
+(* Check that the predicate p holds on all s.[k] for k >= i *)
+let string_iter p s i =
+  let len = String.length s in
+  let rec aux i =
+    if Compare.Int.(i >= len) then ok () else p s.[i] >>? fun () -> aux (i + 1)
+  in
+  aux i
+
+(* Valid annotation characters as defined by the allowed_annot_char function from lib_micheline/micheline_parser *)
+let check_char loc = function
+  | 'a' .. 'z' | 'A' .. 'Z' | '_' | '.' | '%' | '@' | '0' .. '9' ->
+      ok ()
+  | _ ->
+      error (Unexpected_annotation loc)
+
+(* This constant is defined in lib_micheline/micheline_parser which is not available in the environment. *)
+let max_annot_length = 255
+
+let parse_annots loc ?(allow_special_var = false)
+    ?(allow_special_field = false) l =
   (* allow emtpty annotations as wildcards but otherwise only accept
      annotations that start with [a-zA-Z_] *)
   let sub_or_wildcard ~specials wrap s acc =
     let len = String.length s in
-    if Compare.Int.(len = 1) then ok @@ wrap None :: acc
+    ( if Compare.Int.(len > max_annot_length) then
-    else match s.[1] with
+      error (Unexpected_annotation loc)
+    else ok () )
+    >>? fun () ->
+    if Compare.Int.(len = 1) then ok @@ (wrap None :: acc)
+    else
+      match s.[1] with
       | 'a' .. 'z' | 'A' .. 'Z' | '_' ->
-          ok @@ wrap (Some (String.sub s 1 (len - 1))) :: acc
+          (* check that all characters are valid*)
+          string_iter (check_char loc) s 2
+          >>? fun () -> ok @@ (wrap (Some (String.sub s 1 (len - 1))) :: acc)
       | '@' when Compare.Int.(len = 2) && List.mem '@' specials ->
-          ok @@ wrap (Some "@") :: acc
+          ok @@ (wrap (Some "@") :: acc)
       | '%' when List.mem '%' specials ->
-          if Compare.Int.(len = 2)
+          if Compare.Int.(len = 2) then ok @@ (wrap (Some "%") :: acc)
-          then ok @@ wrap (Some "%") :: acc
+          else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%') then
-          else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%')
+            ok @@ (wrap (Some "%%") :: acc)
-          then ok @@ wrap (Some "%%") :: acc
           else error (Unexpected_annotation loc)
-      | _ -> error (Unexpected_annotation loc) in
+      | _ ->
-  List.fold_left (fun acc s ->
+          error (Unexpected_annotation loc)
-      acc >>? fun acc ->
+  in
+  List.fold_left
+    (fun acc s ->
+      acc
+      >>? fun acc ->
       if Compare.Int.(String.length s = 0) then
         error (Unexpected_annotation loc)
-      else match s.[0] with
+      else
-        | ':' -> sub_or_wildcard ~specials:[] (fun a -> `Type_annot a) s acc
+        match s.[0] with
+        | ':' ->
+            sub_or_wildcard ~specials:[] (fun a -> `Type_annot a) s acc
         | '@' ->
             sub_or_wildcard
               ~specials:(if allow_special_var then ['%'] else [])
-              (fun a -> `Var_annot a) s acc
+              (fun a -> `Var_annot a)
-        | '%' -> sub_or_wildcard
+              s
+              acc
+        | '%' ->
+            sub_or_wildcard
               ~specials:(if allow_special_field then ['@'] else [])
-                   (fun a -> `Field_annot a) s acc
+              (fun a -> `Field_annot a)
-        | _ -> error (Unexpected_annotation loc)
+              s
-    ) (ok []) l
+              acc
+        | _ ->
+            error (Unexpected_annotation loc))
+    (ok [])
+    l
   >|? List.rev
 
 let opt_var_of_var_opt = function
-  | `Var_annot None -> None
+  | `Var_annot None ->
-  | `Var_annot Some a -> Some (`Var_annot a)
+      None
+  | `Var_annot (Some a) ->
+      Some (`Var_annot a)
 
 let opt_field_of_field_opt = function
-  | `Field_annot None -> None
+  | `Field_annot None ->
-  | `Field_annot Some a -> Some (`Field_annot a)
+      None
+  | `Field_annot (Some a) ->
+      Some (`Field_annot a)
 
 let opt_type_of_type_opt = function
-  | `Type_annot None -> None
+  | `Type_annot None ->
-  | `Type_annot Some a -> Some (`Type_annot a)
+      None
+  | `Type_annot (Some a) ->
+      Some (`Type_annot a)
 
-let classify_annot loc l
+let classify_annot loc l :
-  : (var_annot option list * type_annot option list * field_annot option list) tzresult
+    (var_annot option list * type_annot option list * field_annot option list)
-  =
+    tzresult =
   try
-    let _, rv, _, rt, _, rf =
+    let (_, rv, _, rt, _, rf) =
       List.fold_left
         (fun (in_v, rv, in_t, rt, in_f, rf) a ->
-           match a, in_v, rv, in_t, rt, in_f, rf with
+          match (a, in_v, rv, in_t, rt, in_f, rf) with
-           | (`Var_annot _ as a), true, _, _, _, _, _
+          | ((`Var_annot _ as a), true, _, _, _, _, _)
-           | (`Var_annot _ as a), false, [], _, _, _, _ ->
+          | ((`Var_annot _ as a), false, [], _, _, _, _) ->
-               true, opt_var_of_var_opt a :: rv,
+              (true, opt_var_of_var_opt a :: rv, false, rt, false, rf)
-               false, rt,
+          | ((`Type_annot _ as a), _, _, true, _, _, _)
-               false, rf
+          | ((`Type_annot _ as a), _, _, false, [], _, _) ->
-           | (`Type_annot _ as a), _, _, true, _, _, _
+              (false, rv, true, opt_type_of_type_opt a :: rt, false, rf)
-           | (`Type_annot _ as a), _, _, false, [], _, _ ->
+          | ((`Field_annot _ as a), _, _, _, _, true, _)
-               false, rv,
+          | ((`Field_annot _ as a), _, _, _, _, false, []) ->
-               true, opt_type_of_type_opt a :: rt,
+              (false, rv, false, rt, true, opt_field_of_field_opt a :: rf)
-               false, rf
+          | _ ->
-           | (`Field_annot _ as a), _, _, _, _, true, _
+              raise Exit)
-           | (`Field_annot _ as a), _, _, _, _, false, [] ->
+        (false, [], false, [], false, [])
-               false, rv,
+        l
-               false, rt,
+    in
-               true, opt_field_of_field_opt a :: rf
-           | _ -> raise Exit
-        ) (false, [], false, [], false, []) l in
     ok (List.rev rv, List.rev rt, List.rev rf)
   with Exit -> error (Ungrouped_annotations loc)
 
 let get_one_annot loc = function
-  | [] -> ok None
+  | [] ->
-  | [ a ] -> ok a
+      ok None
-  | _ -> error (Unexpected_annotation loc)
+  | [a] ->
+      ok a
+  | _ ->
+      error (Unexpected_annotation loc)
 
 let get_two_annot loc = function
-  | [] -> ok (None, None)
+  | [] ->
-  | [ a ] -> ok (a, None)
+      ok (None, None)
-  | [ a; b ] -> ok (a, b)
+  | [a] ->
-  | _ -> error (Unexpected_annotation loc)
+      ok (a, None)
+  | [a; b] ->
+      ok (a, b)
+  | _ ->
+      error (Unexpected_annotation loc)
 
-let parse_type_annot
+let parse_type_annot : int -> string list -> type_annot option tzresult =
-  : int -> string list -> type_annot option tzresult
+ fun loc annot ->
-  = fun loc annot ->
+  parse_annots loc annot >>? classify_annot loc
-    parse_annots loc annot >>?
+  >>? fun (vars, types, fields) ->
-    classify_annot loc >>? fun (vars, types, fields) ->
+  error_unexpected_annot loc vars
-    error_unexpected_annot loc vars >>? fun () ->
+  >>? fun () ->
-    error_unexpected_annot loc fields >>? fun () ->
+  error_unexpected_annot loc fields >>? fun () -> get_one_annot loc types
+
+let parse_type_field_annot :
+    int -> string list -> (type_annot option * field_annot option) tzresult =
+ fun loc annot ->
+  parse_annots loc annot >>? classify_annot loc
+  >>? fun (vars, types, fields) ->
+  error_unexpected_annot loc vars
+  >>? fun () ->
   get_one_annot loc types
+  >>? fun t -> get_one_annot loc fields >|? fun f -> (t, f)
 
-let parse_type_field_annot
+let parse_composed_type_annot :
-  : int -> string list -> (type_annot option * field_annot option) tzresult
+    int ->
-  = fun loc annot ->
+    string list ->
-    parse_annots loc annot >>?
+    (type_annot option * field_annot option * field_annot option) tzresult =
-    classify_annot loc >>? fun (vars, types, fields) ->
+ fun loc annot ->
-    error_unexpected_annot loc vars >>? fun () ->
+  parse_annots loc annot >>? classify_annot loc
-    get_one_annot loc types >>? fun t ->
+  >>? fun (vars, types, fields) ->
-    get_one_annot loc fields >|? fun f ->
+  error_unexpected_annot loc vars
-    (t, f)
+  >>? fun () ->
+  get_one_annot loc types
+  >>? fun t -> get_two_annot loc fields >|? fun (f1, f2) -> (t, f1, f2)
 
-let parse_composed_type_annot
+let parse_field_annot : int -> string list -> field_annot option tzresult =
-  : int -> string list -> (type_annot option * field_annot option * field_annot option) tzresult
+ fun loc annot ->
-  = fun loc annot ->
+  parse_annots loc annot >>? classify_annot loc
-    parse_annots loc annot >>?
+  >>? fun (vars, types, fields) ->
-    classify_annot loc >>? fun (vars, types, fields) ->
+  error_unexpected_annot loc vars
-    error_unexpected_annot loc vars >>? fun () ->
+  >>? fun () ->
-    get_one_annot loc types >>? fun t ->
+  error_unexpected_annot loc types >>? fun () -> get_one_annot loc fields
-    get_two_annot loc fields >|? fun (f1, f2) ->
-    (t, f1, f2)
 
-let parse_field_annot
+let extract_field_annot :
-  : int -> string list -> field_annot option tzresult
+    Script.node -> (Script.node * field_annot option) tzresult = function
-  = fun loc annot ->
-    parse_annots loc annot >>?
-    classify_annot loc >>? fun (vars, types, fields) ->
-    error_unexpected_annot loc vars >>? fun () ->
-    error_unexpected_annot loc types >>? fun () ->
-    get_one_annot loc fields
-
-let extract_field_annot
-  : Script.node -> (Script.node * field_annot option) tzresult
-  = function
   | Prim (loc, prim, args, annot) ->
       let rec extract_first acc = function
-          | [] -> None, annot
+        | [] ->
+            (None, annot)
         | s :: rest ->
-              if Compare.Int.(String.length s > 0) &&
+            if Compare.Int.(String.length s > 0) && Compare.Char.(s.[0] = '%')
-                 Compare.Char.(s.[0] = '%') then
+            then (Some s, List.rev_append acc rest)
-                Some s, List.rev_append acc rest
+            else extract_first (s :: acc) rest
-              else extract_first (s :: acc) rest in
+      in
-        let field_annot, annot = extract_first [] annot in
+      let (field_annot, annot) = extract_first [] annot in
-        let field_annot = match field_annot with
+      let field_annot =
-          | None -> None
+        match field_annot with
-          | Some field_annot -> Some (`Field_annot (String.sub field_annot 1 (String.length field_annot - 1))) in
+        | None ->
+            None
+        | Some field_annot ->
+            Some
+              (`Field_annot
+                (String.sub field_annot 1 (String.length field_annot - 1)))
+      in
       ok (Prim (loc, prim, args, annot), field_annot)
-    | expr -> ok (expr, None)
+  | expr ->
+      ok (expr, None)
 
-let check_correct_field
+let check_correct_field :
-  : field_annot option -> field_annot option -> unit tzresult
+    field_annot option -> field_annot option -> unit tzresult =
-  = fun f1 f2 ->
+ fun f1 f2 ->
-    match f1, f2 with
+  match (f1, f2) with
-    | None, _ | _, None -> ok ()
+  | (None, _) | (_, None) ->
-    | Some `Field_annot s1, Some `Field_annot s2 ->
+      ok ()
+  | (Some (`Field_annot s1), Some (`Field_annot s2)) ->
       if String.equal s1 s2 then ok ()
       else error (Inconsistent_field_annotations ("%" ^ s1, "%" ^ s2))
 
-
+let parse_var_annot :
-let parse_var_annot
+    int ->
-  : int -> ?default:var_annot option -> string list ->
+    ?default:var_annot option ->
-    var_annot option tzresult
+    string list ->
-  = fun loc ?default annot ->
+    var_annot option tzresult =
-    parse_annots loc annot >>?
+ fun loc ?default annot ->
-    classify_annot loc >>? fun (vars, types, fields) ->
+  parse_annots loc annot >>? classify_annot loc
-    error_unexpected_annot loc types >>? fun () ->
+  >>? fun (vars, types, fields) ->
-    error_unexpected_annot loc fields >>? fun () ->
+  error_unexpected_annot loc types
-    get_one_annot loc vars >|? function
+  >>? fun () ->
-    | Some _ as a -> a
+  error_unexpected_annot loc fields
-    | None -> match default with
+  >>? fun () ->
-      | Some a -> a
+  get_one_annot loc vars
-      | None -> None
+  >|? function
+  | Some _ as a ->
+      a
+  | None -> (
+    match default with Some a -> a | None -> None )
 
 let split_last_dot = function
-  | None -> None, None
+  | None ->
-  | Some `Field_annot s ->
+      (None, None)
+  | Some (`Field_annot s) -> (
     match String.rindex_opt s '.' with
-      | None -> None, Some (`Field_annot s)
+    | None ->
+        (None, Some (`Field_annot s))
     | Some i ->
         let s1 = String.sub s 0 i in
         let s2 = String.sub s (i + 1) (String.length s - i - 1) in
         let f =
-            if Compare.String.equal s2 "car"
+          if Compare.String.equal s2 "car" || Compare.String.equal s2 "cdr"
-            || Compare.String.equal s2 "cdr" then
+          then None
-              None
+          else Some (`Field_annot s2)
-            else
+        in
-              Some (`Field_annot s2) in
+        (Some (`Var_annot s1), f) )
-          Some (`Var_annot s1), f
 
 let common_prefix v1 v2 =
-  match v1, v2 with
+  match (v1, v2) with
-  | Some (`Var_annot s1), Some (`Var_annot s2) when Compare.String.equal s1 s2 -> v1
+  | (Some (`Var_annot s1), Some (`Var_annot s2))
-  | Some _, None -> v1
+    when Compare.String.equal s1 s2 ->
-  | None, Some _ -> v2
+      v1
-  | _, _ -> None
+  | (Some _, None) ->
+      v1
+  | (None, Some _) ->
+      v2
+  | (_, _) ->
+      None
 
-let parse_constr_annot
+let parse_constr_annot :
-  : int ->
+    int ->
     ?if_special_first:field_annot option ->
     ?if_special_second:field_annot option ->
     string list ->
-    (var_annot option * type_annot option * field_annot option * field_annot option) tzresult
+    ( var_annot option
-  = fun loc ?if_special_first ?if_special_second annot ->
+    * type_annot option
-    parse_annots ~allow_special_field:true loc annot >>?
+    * field_annot option
-    classify_annot loc >>? fun (vars, types, fields) ->
+    * field_annot option )
-    get_one_annot loc vars >>? fun v ->
+    tzresult =
-    get_one_annot loc types >>? fun t ->
+ fun loc ?if_special_first ?if_special_second annot ->
-    get_two_annot loc fields >>? fun (f1, f2) ->
+  parse_annots ~allow_special_field:true loc annot
-    begin match if_special_first, f1 with
+  >>? classify_annot loc
-      | Some special_var, Some `Field_annot "@" ->
+  >>? fun (vars, types, fields) ->
+  get_one_annot loc vars
+  >>? fun v ->
+  get_one_annot loc types
+  >>? fun t ->
+  get_two_annot loc fields
+  >>? fun (f1, f2) ->
+  ( match (if_special_first, f1) with
+  | (Some special_var, Some (`Field_annot "@")) ->
       ok (split_last_dot special_var)
-      | None, Some `Field_annot "@" -> error (Unexpected_annotation loc)
+  | (None, Some (`Field_annot "@")) ->
-      | _, _ -> ok (v, f1)
+      error (Unexpected_annotation loc)
-    end >>? fun (v1, f1) ->
+  | (_, _) ->
-    begin match if_special_second, f2 with
+      ok (v, f1) )
-      | Some special_var, Some `Field_annot "@" ->
+  >>? fun (v1, f1) ->
+  ( match (if_special_second, f2) with
+  | (Some special_var, Some (`Field_annot "@")) ->
       ok (split_last_dot special_var)
-      | None, Some `Field_annot "@" -> error (Unexpected_annotation loc)
+  | (None, Some (`Field_annot "@")) ->
-      | _, _ -> ok (v, f2)
+      error (Unexpected_annotation loc)
-    end >|? fun (v2, f2) ->
+  | (_, _) ->
-    let v = match v with
+      ok (v, f2) )
-      | None -> common_prefix v1 v2
+  >|? fun (v2, f2) ->
-      | Some _ -> v in
+  let v = match v with None -> common_prefix v1 v2 | Some _ -> v in
   (v, t, f1, f2)
 
-let parse_two_var_annot
+let parse_two_var_annot :
-  : int -> string list -> (var_annot option * var_annot option) tzresult
+    int -> string list -> (var_annot option * var_annot option) tzresult =
-  = fun loc annot ->
+ fun loc annot ->
-    parse_annots loc annot >>?
+  parse_annots loc annot >>? classify_annot loc
-    classify_annot loc >>? fun (vars, types, fields) ->
+  >>? fun (vars, types, fields) ->
-    error_unexpected_annot loc types >>? fun () ->
+  error_unexpected_annot loc types
-    error_unexpected_annot loc fields >>? fun () ->
+  >>? fun () ->
-    get_two_annot loc vars
+  error_unexpected_annot loc fields >>? fun () -> get_two_annot loc vars
 
-let parse_destr_annot
+let parse_destr_annot :
-  : int -> string list -> default_accessor:field_annot option ->
+    int ->
+    string list ->
+    default_accessor:field_annot option ->
     field_name:field_annot option ->
-  pair_annot:var_annot option -> value_annot:var_annot option ->
+    pair_annot:var_annot option ->
-  (var_annot option * field_annot option) tzresult
+    value_annot:var_annot option ->
-  = fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot ->
+    (var_annot option * field_annot option) tzresult =
-    parse_annots loc ~allow_special_var:true annot >>?
+ fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot ->
-    classify_annot loc >>? fun (vars, types, fields) ->
+  parse_annots loc ~allow_special_var:true annot
-    error_unexpected_annot loc types >>? fun () ->
+  >>? classify_annot loc
-    get_one_annot loc vars >>? fun v ->
+  >>? fun (vars, types, fields) ->
-    get_one_annot loc fields >|? fun f ->
+  error_unexpected_annot loc types
-    let default = gen_access_annot pair_annot field_name ~default:default_accessor in
+  >>? fun () ->
-    let v = match v with
+  get_one_annot loc vars
-      | Some `Var_annot "%" -> field_to_var_annot field_name
+  >>? fun v ->
-      | Some `Var_annot "%%" -> default
+  get_one_annot loc fields
-      | Some _ -> v
+  >|? fun f ->
-      | None -> value_annot in
+  let default =
+    gen_access_annot pair_annot field_name ~default:default_accessor
+  in
+  let v =
+    match v with
+    | Some (`Var_annot "%") ->
+        field_to_var_annot field_name
+    | Some (`Var_annot "%%") ->
+        default
+    | Some _ ->
+        v
+    | None ->
+        value_annot
+  in
   (v, f)
 
-let parse_entrypoint_annot
+let parse_entrypoint_annot :
-  : int -> ?default:var_annot option -> string list -> (var_annot option * field_annot option) tzresult
+    int ->
-  = fun loc ?default annot ->
+    ?default:var_annot option ->
-    parse_annots loc annot >>?
+    string list ->
-    classify_annot loc >>? fun (vars, types, fields) ->
+    (var_annot option * field_annot option) tzresult =
-    error_unexpected_annot loc types >>? fun () ->
+ fun loc ?default annot ->
-    get_one_annot loc fields >>? fun f ->
+  parse_annots loc annot >>? classify_annot loc
-    get_one_annot loc vars >|? function
+  >>? fun (vars, types, fields) ->
-    | Some _ as a -> (a, f)
+  error_unexpected_annot loc types
-    | None -> match default with
+  >>? fun () ->
-      | Some a -> (a, f)
+  get_one_annot loc fields
-      | None -> (None, f)
+  >>? fun f ->
+  get_one_annot loc vars
+  >|? function
+  | Some _ as a ->
+      (a, f)
+  | None -> (
+    match default with Some a -> (a, f) | None -> (None, f) )
 
-let parse_var_type_annot
+let parse_var_type_annot :
-  : int -> string list -> (var_annot option * type_annot option) tzresult
+    int -> string list -> (var_annot option * type_annot option) tzresult =
-  = fun loc annot ->
+ fun loc annot ->
-    parse_annots loc annot >>?
+  parse_annots loc annot >>? classify_annot loc
-    classify_annot loc >>? fun (vars, types, fields) ->
+  >>? fun (vars, types, fields) ->
-    error_unexpected_annot loc fields >>? fun () ->
+  error_unexpected_annot loc fields
-    get_one_annot loc vars >>? fun v ->
+  >>? fun () ->
-    get_one_annot loc types >|? fun t ->
+  get_one_annot loc vars
-    (v, t)
+  >>? fun v -> get_one_annot loc types >|? fun t -> (v, t)

vendors/ligo-utils/tezos-protocol-alpha/script_ir_annot.mli

@@ -29,44 +29,71 @@ open Script_typed_ir
 (** Default annotations *)
 
 val default_now_annot : var_annot option
+
 val default_amount_annot : var_annot option
+
 val default_balance_annot : var_annot option
+
 val default_steps_annot : var_annot option
+
 val default_source_annot : var_annot option
+
 val default_sender_annot : var_annot option
+
 val default_self_annot : var_annot option
+
 val default_arg_annot : var_annot option
+
 val default_param_annot : var_annot option
+
 val default_storage_annot : var_annot option
 
 val default_car_annot : field_annot option
+
 val default_cdr_annot : field_annot option
+
 val default_contract_annot : field_annot option
+
 val default_addr_annot : field_annot option
+
 val default_manager_annot : field_annot option
+
 val default_pack_annot : field_annot option
+
 val default_unpack_annot : field_annot option
+
 val default_slice_annot : field_annot option
 
 val default_elt_annot : field_annot option
+
 val default_key_annot : field_annot option
+
 val default_hd_annot : field_annot option
+
 val default_tl_annot : field_annot option
+
 val default_some_annot : field_annot option
+
 val default_left_annot : field_annot option
+
 val default_right_annot : field_annot option
+
 val default_binding_annot : field_annot option
 
 (** Unparse annotations to their string representation *)
 
 val unparse_type_annot : type_annot option -> string list
+
 val unparse_var_annot : var_annot option -> string list
+
 val unparse_field_annot : field_annot option -> string list
 
 (** Convertions functions between different annotation kinds *)
 
 val field_to_var_annot : field_annot option -> var_annot option
+
 val type_to_var_annot : type_annot option -> var_annot option
+
 val var_to_field_annot : var_annot option -> field_annot option
 
 (** Replace an annotation by its default value if it is [None] *)
@@ -75,23 +102,30 @@ val default_annot : default:'a option -> 'a option -> 'a option
 (** Generate annotation for field accesses, of the form [var.field1.field2] *)
 val gen_access_annot :
   var_annot option ->
-  ?default:field_annot option -> field_annot option -> var_annot option
+  ?default:field_annot option ->
+  field_annot option ->
+  var_annot option
 
 (** Merge type annotations.
     @return an error {!Inconsistent_type_annotations} if they are both present
     and different, unless [legacy] *)
 val merge_type_annot :
-  legacy: bool -> type_annot option -> type_annot option -> type_annot option tzresult
+  legacy:bool ->
+  type_annot option ->
+  type_annot option ->
+  type_annot option tzresult
 
 (** Merge field annotations.
     @return an error {!Inconsistent_type_annotations} if they are both present
     and different, unless [legacy] *)
 val merge_field_annot :
-  legacy: bool -> field_annot option -> field_annot option -> field_annot option tzresult
+  legacy:bool ->
+  field_annot option ->
+  field_annot option ->
+  field_annot option tzresult
 
 (** Merge variable annotations, does not fail ([None] if different). *)
-val merge_var_annot :
+val merge_var_annot : var_annot option -> var_annot option -> var_annot option
-  var_annot option -> var_annot option -> var_annot option
 
 (** @return an error {!Unexpected_annotation} in the monad the list is not empty. *)
 val error_unexpected_annot : int -> 'a list -> unit tzresult
@@ -103,8 +137,7 @@ val fail_unexpected_annot : int -> 'a list -> unit tzresult Lwt.t
 val parse_type_annot : int -> string list -> type_annot option tzresult
 
 (** Parse a field annotation only. *)
-val parse_field_annot :
+val parse_field_annot : int -> string list -> field_annot option tzresult
-  int -> string list -> field_annot option tzresult
 
 (** Parse an annotation for composed types, of the form
     [:ty_name %field] in any order. *)
@@ -114,7 +147,8 @@ val parse_type_field_annot :
 (** Parse an annotation for composed types, of the form
     [:ty_name %field1 %field2] in any order. *)
 val parse_composed_type_annot :
-  int -> string list ->
+  int ->
+  string list ->
   (type_annot option * field_annot option * field_annot option) tzresult
 
 (** Extract and remove a field annotation from a node *)
@@ -129,23 +163,25 @@ val check_correct_field :
 
 (** Parse a variable annotation, replaced by a default value if [None]. *)
 val parse_var_annot :
-  int ->
+  int -> ?default:var_annot option -> string list -> var_annot option tzresult
-  ?default:var_annot option ->
-  string list -> var_annot option tzresult
 
 val parse_constr_annot :
   int ->
   ?if_special_first:field_annot option ->
   ?if_special_second:field_annot option ->
   string list ->
-  (var_annot option * type_annot option *
+  ( var_annot option
-   field_annot option * field_annot option) tzresult
+  * type_annot option
+  * field_annot option
+  * field_annot option )
+  tzresult
 
 val parse_two_var_annot :
   int -> string list -> (var_annot option * var_annot option) tzresult
 
 val parse_destr_annot :
-  int -> string list ->
+  int ->
+  string list ->
   default_accessor:field_annot option ->
   field_name:field_annot option ->
   pair_annot:var_annot option ->

vendors/ligo-utils/tezos-protocol-alpha/script_ir_translator.mli

@@ -28,92 +28,146 @@ open Script_tc_errors
 
 type ('ta, 'tb) eq = Eq : ('same, 'same) eq
 
-type ex_comparable_ty = Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty
+type ex_comparable_ty =
+  | Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty
+
 type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty
+
 type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty
+
 type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script
+
 type tc_context =
   | Lambda : tc_context
   | Dip : 'a Script_typed_ir.stack_ty * tc_context -> tc_context
-  | Toplevel : { storage_type : 'sto Script_typed_ir.ty ;
+  | Toplevel : {
+      storage_type : 'sto Script_typed_ir.ty;
       param_type : 'param Script_typed_ir.ty;
       root_name : string option;
-                 legacy_create_contract_literal : bool } -> tc_context
+      legacy_create_contract_literal : bool;
+    }
+      -> tc_context
+
 type 'bef judgement =
   | Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement
-  | Failed :
+  | Failed : {
-      { descr : 'aft. 'aft Script_typed_ir.stack_ty -> ('bef, 'aft) Script_typed_ir.descr } -> 'bef judgement
+      descr :
+        'aft. 'aft Script_typed_ir.stack_ty ->
+        ('bef, 'aft) Script_typed_ir.descr;
+    }
+      -> 'bef judgement
 
 type unparsing_mode = Optimized | Readable
 
 type type_logger =
-  int -> (Script.expr * Script.annot) list -> (Script.expr * Script.annot)  list -> unit
+  int ->
+  (Script.expr * Script.annot) list ->
+  (Script.expr * Script.annot) list ->
+  unit
 
 (* ---- Sets and Maps -------------------------------------------------------*)
 
 val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set
+
 val set_fold :
-  ('elt -> 'acc -> 'acc) ->
+  ('elt -> 'acc -> 'acc) -> 'elt Script_typed_ir.set -> 'acc -> 'acc
-  'elt Script_typed_ir.set -> 'acc -> 'acc
+
 val set_update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set
+
 val set_mem : 'elt -> 'elt Script_typed_ir.set -> bool
+
 val set_size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num
 
-val empty_map : 'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map
+val empty_map :
+  'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map
+
 val map_fold :
   ('key -> 'value -> 'acc -> 'acc) ->
-  ('key, 'value) Script_typed_ir.map -> 'acc -> 'acc
+  ('key, 'value) Script_typed_ir.map ->
-val map_update :
+  'acc ->
-  'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> ('a, 'b) Script_typed_ir.map
+  'acc
-val map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool
-val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option
-val map_key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty
-val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num
 
-val empty_big_map : 'a Script_typed_ir.comparable_ty -> 'b Script_typed_ir.ty -> ('a, 'b) Script_typed_ir.big_map
+val map_update :
-val big_map_mem :
+  'a ->
-  context -> 'key ->
+  'b option ->
-  ('key, 'value) Script_typed_ir.big_map ->
+  ('a, 'b) Script_typed_ir.map ->
-  (bool * context) tzresult Lwt.t
+  ('a, 'b) Script_typed_ir.map
-val big_map_get :
-  context -> 'key ->
-  ('key, 'value) Script_typed_ir.big_map ->
-  ('value option * context) tzresult Lwt.t
-val big_map_update :
-  'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map ->
-  ('key, 'value) Script_typed_ir.big_map
 
 val has_big_map : 't Script_typed_ir.ty -> bool
+val ty_of_comparable_ty : ('a, 's) Script_typed_ir.comparable_struct -> 'a Script_typed_ir.ty
 
+val map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool
+
+val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option
+
+val map_key_ty :
+  ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty
+
+val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num
+
+val empty_big_map :
+  'a Script_typed_ir.comparable_ty ->
+  'b Script_typed_ir.ty ->
+  ('a, 'b) Script_typed_ir.big_map
+
+val big_map_mem :
+  context ->
+  'key ->
+  ('key, 'value) Script_typed_ir.big_map ->
+  (bool * context) tzresult Lwt.t
+
+val big_map_get :
+  context ->
+  'key ->
+  ('key, 'value) Script_typed_ir.big_map ->
+  ('value option * context) tzresult Lwt.t
+
+val big_map_update :
+  'key ->
+  'value option ->
+  ('key, 'value) Script_typed_ir.big_map ->
+  ('key, 'value) Script_typed_ir.big_map
 
 val ty_eq :
   context ->
-  'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->
+  'ta Script_typed_ir.ty ->
+  'tb Script_typed_ir.ty ->
   (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult
 
 val compare_comparable : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> int
 
-val ty_of_comparable_ty : ('a, 's) Script_typed_ir.comparable_struct -> 'a Script_typed_ir.ty
-
 val parse_data :
   ?type_logger:type_logger ->
-  context -> legacy: bool ->
+  context ->
-  'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t
+  legacy:bool ->
+  'a Script_typed_ir.ty ->
+  Script.node ->
+  ('a * context) tzresult Lwt.t
+
 val unparse_data :
-  context -> unparsing_mode -> 'a Script_typed_ir.ty -> 'a ->
+  context ->
+  unparsing_mode ->
+  'a Script_typed_ir.ty ->
+  'a ->
   (Script.node * context) tzresult Lwt.t
 
 val parse_instr :
   ?type_logger:type_logger ->
-  tc_context -> context -> legacy: bool ->
+  tc_context ->
-  Script.node -> 'bef Script_typed_ir.stack_ty -> ('bef judgement * context) tzresult Lwt.t
+  context ->
+  legacy:bool ->
+  Script.node ->
+  'bef Script_typed_ir.stack_ty ->
+  ('bef judgement * context) tzresult Lwt.t
 
 val parse_ty :
-  context -> legacy: bool ->
+  context ->
+  legacy:bool ->
   allow_big_map:bool ->
   allow_operation:bool ->
   allow_contract:bool ->
-  Script.node -> (ex_ty * context) tzresult
+  Script.node ->
+  (ex_ty * context) tzresult
 
 val parse_packable_ty :
   context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult
@@ -122,39 +176,62 @@ val unparse_ty :
   context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t
 
 val parse_toplevel :
-  legacy: bool -> Script.expr -> (Script.node * Script.node * Script.node * string option) tzresult
+  legacy:bool ->
+  Script.expr ->
+  (Script.node * Script.node * Script.node * string option) tzresult
 
 val add_field_annot :
-  [ `Field_annot of string ] option -> [ `Var_annot of string ] option -> Script.node -> Script.node
+  [`Field_annot of string] option ->
+  [`Var_annot of string] option ->
+  Script.node ->
+  Script.node
 
 val typecheck_code :
   context -> Script.expr -> (type_map * context) tzresult Lwt.t
 
 val typecheck_data :
   ?type_logger:type_logger ->
-  context -> Script.expr * Script.expr -> context tzresult Lwt.t
+  context ->
+  Script.expr * Script.expr ->
+  context tzresult Lwt.t
 
 val parse_script :
   ?type_logger:type_logger ->
-  context -> legacy: bool -> Script.t -> (ex_script * context) tzresult Lwt.t
+  context ->
+  legacy:bool ->
+  Script.t ->
+  (ex_script * context) tzresult Lwt.t
 
 (* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
 val unparse_script :
-  context -> unparsing_mode ->
+  context ->
-  ('a, 'b) Script_typed_ir.script -> (Script.t * context) tzresult Lwt.t
+  unparsing_mode ->
+  ('a, 'b) Script_typed_ir.script ->
+  (Script.t * context) tzresult Lwt.t
 
 val parse_contract :
-  legacy: bool -> context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  legacy:bool ->
+  context ->
+  Script.location ->
+  'a Script_typed_ir.ty ->
+  Contract.t ->
   entrypoint:string ->
   (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t
 
 val parse_contract_for_script :
-  legacy: bool -> context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->
+  legacy:bool ->
+  context ->
+  Script.location ->
+  'a Script_typed_ir.ty ->
+  Contract.t ->
   entrypoint:string ->
   (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t
 
 val find_entrypoint :
-  't Script_typed_ir.ty -> root_name: string option -> string -> ((Script.node -> Script.node) * ex_ty) tzresult
+  't Script_typed_ir.ty ->
+  root_name:string option ->
+  string ->
+  ((Script.node -> Script.node) * ex_ty) tzresult
 
 module Entrypoints_map : S.MAP with type key = string
 
@@ -162,26 +239,37 @@ val list_entrypoints :
   't Script_typed_ir.ty ->
   context ->
   root_name:string option ->
-  (Michelson_v1_primitives.prim list list *
+  ( Michelson_v1_primitives.prim list list
-   (Michelson_v1_primitives.prim list * Script.node) Entrypoints_map.t)
+  * (Michelson_v1_primitives.prim list * Script.node) Entrypoints_map.t )
   tzresult
 
-val pack_data : context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t
+val pack_data :
-val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (Script_expr_hash.t * context) tzresult Lwt.t
+  context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t
+
+val hash_data :
+  context ->
+  'a Script_typed_ir.ty ->
+  'a ->
+  (Script_expr_hash.t * context) tzresult Lwt.t
 
 type big_map_ids
 
 val no_big_map_id : big_map_ids
 
 val collect_big_maps :
-  context -> 'a Script_typed_ir.ty -> 'a -> (big_map_ids * context) tzresult Lwt.t
+  context ->
+  'a Script_typed_ir.ty ->
+  'a ->
+  (big_map_ids * context) tzresult Lwt.t
 
 val list_of_big_map_ids : big_map_ids -> Z.t list
 
 val extract_big_map_diff :
-  context -> unparsing_mode ->
+  context ->
+  unparsing_mode ->
   temporary:bool ->
   to_duplicate:big_map_ids ->
   to_update:big_map_ids ->
-  'a Script_typed_ir.ty -> 'a ->
+  'a Script_typed_ir.ty ->
+  'a ->
   ('a * Contract.big_map_diff option * context) tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/script_repr.ml

@@ -35,8 +35,6 @@ type lazy_expr = expr Data_encoding.lazy_t
 
 type node = (location, Michelson_v1_primitives.prim) Micheline.node
 
-
-
 let expr_encoding =
   Micheline.canonical_encoding_v1
     ~variant:"michelson_v1"
@@ -45,60 +43,57 @@ let expr_encoding =
 type error += Lazy_script_decode (* `Permanent *)
 
 let () =
-  register_error_kind `Permanent
+  register_error_kind
+    `Permanent
     ~id:"invalid_binary_format"
     ~title:"Invalid binary format"
-    ~description:"Could not deserialize some piece of data \
+    ~description:
-                  from its binary representation"
+      "Could not deserialize some piece of data from its binary representation"
     Data_encoding.empty
     (function Lazy_script_decode -> Some () | _ -> None)
     (fun () -> Lazy_script_decode)
 
-let lazy_expr_encoding =
+let lazy_expr_encoding = Data_encoding.lazy_encoding expr_encoding
-  Data_encoding.lazy_encoding expr_encoding
 
-let lazy_expr expr =
+let lazy_expr expr = Data_encoding.make_lazy expr_encoding expr
-  Data_encoding.make_lazy expr_encoding expr
 
-type t = {
+type t = {code : lazy_expr; storage : lazy_expr}
-  code : lazy_expr ;
-  storage : lazy_expr ;
-}
 
 let encoding =
   let open Data_encoding in
-  def "scripted.contracts" @@
+  def "scripted.contracts"
-  conv
+  @@ conv
        (fun {code; storage} -> (code, storage))
        (fun (code, storage) -> {code; storage})
-    (obj2
+       (obj2 (req "code" lazy_expr_encoding) (req "storage" lazy_expr_encoding))
-       (req "code" lazy_expr_encoding)
+
-       (req "storage" lazy_expr_encoding))
+let int_node_size_of_numbits n = (1, 1 + ((n + 63) / 64))
+
+let int_node_size n = int_node_size_of_numbits (Z.numbits n)
+
+let string_node_size_of_length s = (1, 1 + ((s + 7) / 8))
+
+let string_node_size s = string_node_size_of_length (String.length s)
 
-let int_node_size_of_numbits n =
-  (1, 1 + (n + 63) / 64)
-let int_node_size n =
-  int_node_size_of_numbits (Z.numbits n)
-let string_node_size_of_length s =
-  (1, 1 + (s + 7) / 8)
-let string_node_size s =
-  string_node_size_of_length (String.length s)
 let bytes_node_size_of_length s =
   (* approx cost of indirection to the C heap *)
-  (2, 1 + (s + 7) / 8 + 12)
+  (2, 1 + ((s + 7) / 8) + 12)
-let bytes_node_size s =
+
-  bytes_node_size_of_length (MBytes.length s)
+let bytes_node_size s = bytes_node_size_of_length (MBytes.length s)
+
 let prim_node_size_nonrec_of_lengths n_args annots =
-  let annots_length = List.fold_left (fun acc s -> acc + String.length s) 0 annots in
+  let annots_length =
-  if Compare.Int.(annots_length = 0) then
+    List.fold_left (fun acc s -> acc + String.length s) 0 annots
-    (1 + n_args, 2 + 2 * n_args)
+  in
-  else
+  if Compare.Int.(annots_length = 0) then (1 + n_args, 2 + (2 * n_args))
-    (2 + n_args, 4 + 2 * n_args + (annots_length + 7) / 8)
+  else (2 + n_args, 4 + (2 * n_args) + ((annots_length + 7) / 8))
+
 let prim_node_size_nonrec args annots =
   let n_args = List.length args in
   prim_node_size_nonrec_of_lengths n_args annots
-let seq_node_size_nonrec_of_length n_args =
+
-  (1 + n_args, 2 + 2 * n_args)
+let seq_node_size_nonrec_of_length n_args = (1 + n_args, 2 + (2 * n_args))
+
 let seq_node_size_nonrec args =
   let n_args = List.length args in
   seq_node_size_nonrec_of_length n_args
@@ -106,9 +101,12 @@ let seq_node_size_nonrec args =
 let rec node_size node =
   let open Micheline in
   match node with
-  | Int (_, n) -> int_node_size n
+  | Int (_, n) ->
-  | String (_, s) -> string_node_size s
+      int_node_size n
-  | Bytes (_, s) -> bytes_node_size s
+  | String (_, s) ->
+      string_node_size s
+  | Bytes (_, s) ->
+      bytes_node_size s
   | Prim (_, _, args, annot) ->
       List.fold_left
         (fun (blocks, words) node ->
@@ -124,35 +122,43 @@ let rec node_size node =
         (seq_node_size_nonrec args)
         args
 
-let expr_size expr =
+let expr_size expr = node_size (Micheline.root expr)
-  node_size (Micheline.root expr)
 
 let traversal_cost node =
-  let blocks, _words = node_size node in
+  let (blocks, _words) = node_size node in
   Gas_limit_repr.step_cost blocks
 
 let cost_of_size (blocks, words) =
   let open Gas_limit_repr in
-  ((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@
+  (Compare.Int.max 0 (blocks - 1) *@ alloc_cost 0)
-  alloc_cost words +@
+  +@ alloc_cost words +@ step_cost blocks
-  step_cost blocks
 
-let node_cost node =
+let node_cost node = cost_of_size (node_size node)
-  cost_of_size (node_size node)
 
 let int_node_cost n = cost_of_size (int_node_size n)
-let int_node_cost_of_numbits n = cost_of_size (int_node_size_of_numbits n)
-let string_node_cost s = cost_of_size (string_node_size s)
-let string_node_cost_of_length s = cost_of_size (string_node_size_of_length s)
-let bytes_node_cost s = cost_of_size (bytes_node_size s)
-let bytes_node_cost_of_length s = cost_of_size (bytes_node_size_of_length s)
-let prim_node_cost_nonrec args annot = cost_of_size (prim_node_size_nonrec args annot)
-let prim_node_cost_nonrec_of_length n_args annot = cost_of_size (prim_node_size_nonrec_of_lengths n_args annot)
-let seq_node_cost_nonrec args = cost_of_size (seq_node_size_nonrec args)
-let seq_node_cost_nonrec_of_length n_args = cost_of_size (seq_node_size_nonrec_of_length n_args)
 
-let deserialized_cost expr =
+let int_node_cost_of_numbits n = cost_of_size (int_node_size_of_numbits n)
-  cost_of_size (expr_size expr)
+
+let string_node_cost s = cost_of_size (string_node_size s)
+
+let string_node_cost_of_length s = cost_of_size (string_node_size_of_length s)
+
+let bytes_node_cost s = cost_of_size (bytes_node_size s)
+
+let bytes_node_cost_of_length s = cost_of_size (bytes_node_size_of_length s)
+
+let prim_node_cost_nonrec args annot =
+  cost_of_size (prim_node_size_nonrec args annot)
+
+let prim_node_cost_nonrec_of_length n_args annot =
+  cost_of_size (prim_node_size_nonrec_of_lengths n_args annot)
+
+let seq_node_cost_nonrec args = cost_of_size (seq_node_size_nonrec args)
+
+let seq_node_cost_nonrec_of_length n_args =
+  cost_of_size (seq_node_size_nonrec_of_length n_args)
+
+let deserialized_cost expr = cost_of_size (expr_size expr)
 
 let serialized_cost bytes =
   let open Gas_limit_repr in
@@ -164,14 +170,14 @@ let force_decode lexpr =
       ~fun_value:(fun _ -> false)
       ~fun_bytes:(fun _ -> true)
       ~fun_combine:(fun _ _ -> false)
-      lexpr in
+      lexpr
+  in
   match Data_encoding.force_decode lexpr with
   | Some v ->
-      if account_deserialization_cost then
+      if account_deserialization_cost then ok (v, deserialized_cost v)
-        ok (v, deserialized_cost v)
+      else ok (v, Gas_limit_repr.free)
-      else
+  | None ->
-        ok (v, Gas_limit_repr.free)
+      error Lazy_script_decode
-  | None -> error Lazy_script_decode
 
 let force_bytes expr =
   let open Gas_limit_repr in
@@ -180,14 +186,17 @@ let force_bytes expr =
       ~fun_value:(fun v -> Some v)
       ~fun_bytes:(fun _ -> None)
       ~fun_combine:(fun _ _ -> None)
-      expr in
+      expr
+  in
   match Data_encoding.force_bytes expr with
-  | bytes ->
+  | bytes -> (
-      begin match account_serialization_cost with
+    match account_serialization_cost with
-        | Some v -> ok (bytes, traversal_cost (Micheline.root v) +@ serialized_cost bytes)
+    | Some v ->
-        | None -> ok (bytes, Gas_limit_repr.free)
+        ok (bytes, traversal_cost (Micheline.root v) +@ serialized_cost bytes)
-      end
+    | None ->
-  | exception _ -> error Lazy_script_decode
+        ok (bytes, Gas_limit_repr.free) )
+  | exception _ ->
+      error Lazy_script_decode
 
 let minimal_deserialize_cost lexpr =
   Data_encoding.apply_lazy
@@ -199,20 +208,25 @@ let minimal_deserialize_cost lexpr =
 let unit =
   Micheline.strip_locations (Prim (0, Michelson_v1_primitives.D_Unit, [], []))
 
-let unit_parameter =
+let unit_parameter = lazy_expr unit
-  lazy_expr unit
 
 let is_unit_parameter =
   let unit_bytes = Data_encoding.force_bytes unit_parameter in
   Data_encoding.apply_lazy
-    ~fun_value:(fun v -> match Micheline.root v with Prim (_, Michelson_v1_primitives.D_Unit, [], []) -> true | _ -> false)
+    ~fun_value:(fun v ->
+      match Micheline.root v with
+      | Prim (_, Michelson_v1_primitives.D_Unit, [], []) ->
+          true
+      | _ ->
+          false)
     ~fun_bytes:(fun b -> MBytes.( = ) b unit_bytes)
     ~fun_combine:(fun res _ -> res)
 
 let rec strip_annotations node =
   let open Micheline in
   match node with
-  | Int (_, _) | String (_, _) | Bytes (_, _) as leaf -> leaf
+  | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf ->
+      leaf
   | Prim (loc, name, args, _) ->
       Prim (loc, name, List.map strip_annotations args, [])
   | Seq (loc, args) ->

vendors/ligo-utils/tezos-protocol-alpha/script_repr.mli

@@ -50,18 +50,29 @@ val encoding : t Data_encoding.encoding
 val deserialized_cost : expr -> Gas_limit_repr.cost
 
 val serialized_cost : MBytes.t -> Gas_limit_repr.cost
+
 val traversal_cost : node -> Gas_limit_repr.cost
+
 val node_cost : node -> Gas_limit_repr.cost
 
 val int_node_cost : Z.t -> Gas_limit_repr.cost
+
 val int_node_cost_of_numbits : int -> Gas_limit_repr.cost
+
 val string_node_cost : string -> Gas_limit_repr.cost
+
 val string_node_cost_of_length : int -> Gas_limit_repr.cost
+
 val bytes_node_cost : MBytes.t -> Gas_limit_repr.cost
+
 val bytes_node_cost_of_length : int -> Gas_limit_repr.cost
+
 val prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost
+
 val prim_node_cost_nonrec_of_length : int -> annot -> Gas_limit_repr.cost
+
 val seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost
+
 val seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost
 
 val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult

vendors/ligo-utils/tezos-protocol-alpha/script_tc_errors.ml

@@ -26,65 +26,133 @@
 open Alpha_context
 open Script
 
-
 (* ---- Error definitions ---------------------------------------------------*)
 
 (* Auxiliary types for error documentation *)
-type namespace = Type_namespace | Constant_namespace | Instr_namespace | Keyword_namespace
+type namespace =
+  | Type_namespace
+  | Constant_namespace
+  | Instr_namespace
+  | Keyword_namespace
+
 type kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind
+
 type unparsed_stack_ty = (Script.expr * Script.annot) list
+
 type type_map = (int * (unparsed_stack_ty * unparsed_stack_ty)) list
 
 (* Structure errors *)
 type error += Invalid_arity of Script.location * prim * int * int
-type error += Invalid_namespace of Script.location * prim * namespace * namespace
+
+type error +=
+  | Invalid_namespace of Script.location * prim * namespace * namespace
+
 type error += Invalid_primitive of Script.location * prim list * prim
+
 type error += Invalid_kind of Script.location * kind list * kind
+
 type error += Missing_field of prim
+
 type error += Duplicate_field of Script.location * prim
+
 type error += Unexpected_big_map of Script.location
+
 type error += Unexpected_operation of Script.location
+
 type error += Unexpected_contract of Script.location
+
 type error += No_such_entrypoint of string
+
 type error += Duplicate_entrypoint of string
+
 type error += Unreachable_entrypoint of prim list
+
 type error += Entrypoint_name_too_long of string
 
 (* Instruction typing errors *)
 type error += Fail_not_in_tail_position of Script.location
-type error += Undefined_binop : Script.location * prim * Script.expr * Script.expr -> error
+
+type error +=
+  | Undefined_binop :
+      Script.location * prim * Script.expr * Script.expr
+      -> error
+
 type error += Undefined_unop : Script.location * prim * Script.expr -> error
-type error += Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error
+
-type error += Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error
+type error +=
-type error += Unmatched_branches : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error
+  | Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error
+
+type error +=
+  | Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error
+
+type error +=
+  | Unmatched_branches :
+      Script.location * unparsed_stack_ty * unparsed_stack_ty
+      -> error
+
 type error += Self_in_lambda of Script.location
+
 type error += Bad_stack_length
+
 type error += Bad_stack_item of int
+
 type error += Inconsistent_annotations of string * string
-type error += Inconsistent_type_annotations : Script.location * Script.expr * Script.expr -> error
+
+type error +=
+  | Inconsistent_type_annotations :
+      Script.location * Script.expr * Script.expr
+      -> error
+
 type error += Inconsistent_field_annotations of string * string
+
 type error += Unexpected_annotation of Script.location
+
 type error += Ungrouped_annotations of Script.location
+
 type error += Invalid_map_body : Script.location * unparsed_stack_ty -> error
+
 type error += Invalid_map_block_fail of Script.location
-type error += Invalid_iter_body : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error
+
+type error +=
+  | Invalid_iter_body :
+      Script.location * unparsed_stack_ty * unparsed_stack_ty
+      -> error
+
 type error += Type_too_large : Script.location * int * int -> error
 
 (* Value typing errors *)
-type error += Invalid_constant : Script.location * Script.expr * Script.expr -> error
+type error +=
-type error += Invalid_syntactic_constant : Script.location * Script.expr * string -> error
+  | Invalid_constant : Script.location * Script.expr * Script.expr -> error
+
+type error +=
+  | Invalid_syntactic_constant :
+      Script.location * Script.expr * string
+      -> error
+
 type error += Invalid_contract of Script.location * Contract.t
+
 type error += Invalid_big_map of Script.location * Big_map.id
-type error += Comparable_type_expected : Script.location * Script.expr -> error
+
+type error +=
+  | Comparable_type_expected : Script.location * Script.expr -> error
+
 type error += Inconsistent_types : Script.expr * Script.expr -> error
+
 type error += Unordered_map_keys of Script.location * Script.expr
+
 type error += Unordered_set_values of Script.location * Script.expr
+
 type error += Duplicate_map_keys of Script.location * Script.expr
+
 type error += Duplicate_set_values of Script.location * Script.expr
 
 (* Toplevel errors *)
-type error += Ill_typed_data : string option * Script.expr * Script.expr -> error
+type error +=
-type error += Ill_formed_type of string option * Script.expr * Script.location
+  | Ill_typed_data : string option * Script.expr * Script.expr -> error
+
+type error +=
+  | Ill_formed_type of string option * Script.expr * Script.location
+
 type error += Ill_typed_contract : Script.expr * type_map -> error
 
 (* Gas related errors *)

vendors/ligo-utils/tezos-protocol-alpha/script_tc_errors_registration.ml

@@ -42,40 +42,41 @@ let type_map_enc =
 
 let stack_ty_enc =
   let open Data_encoding in
-  (list
+  list (obj2 (req "type" Script.expr_encoding) (dft "annots" (list string) []))
-     (obj2
-        (req "type" Script.expr_encoding)
-        (dft "annots" (list string) [])))
 
 (* main registration *)
 let () =
   let open Data_encoding in
   let located enc =
-    merge_objs
+    merge_objs (obj1 (req "location" Script.location_encoding)) enc
-      (obj1 (req "location" Script.location_encoding))
+  in
-      enc in
+  let arity_enc = int8 in
-  let arity_enc =
-    int8 in
   let namespace_enc =
-    def "primitiveNamespace"
+    def
+      "primitiveNamespace"
       ~title:"Primitive namespace"
       ~description:
-        "One of the three possible namespaces of primitive \
+        "One of the three possible namespaces of primitive (data constructor, \
-         (data constructor, type name or instruction)." @@
+         type name or instruction)."
-    string_enum [ "type", Type_namespace ;
+    @@ string_enum
-                  "constant", Constant_namespace ;
+         [ ("type", Type_namespace);
-                  "instruction", Instr_namespace ] in
+           ("constant", Constant_namespace);
+           ("instruction", Instr_namespace) ]
+  in
   let kind_enc =
-    def "expressionKind"
+    def
+      "expressionKind"
       ~title:"Expression kind"
       ~description:
-        "One of the four possible kinds of expression \
+        "One of the four possible kinds of expression (integer, string, \
-         (integer, string, primitive application or sequence)." @@
+         primitive application or sequence)."
-    string_enum [ "integer", Int_kind ;
+    @@ string_enum
-                  "string", String_kind ;
+         [ ("integer", Int_kind);
-                  "bytes", Bytes_kind ;
+           ("string", String_kind);
-                  "primitiveApplication", Prim_kind ;
+           ("bytes", Bytes_kind);
-                  "sequence", Seq_kind ] in
+           ("primitiveApplication", Prim_kind);
+           ("sequence", Seq_kind) ]
+  in
   (* -- Structure errors ---------------------- *)
   (* Invalid arity *)
   register_error_kind
@@ -83,25 +84,25 @@ let () =
     ~id:"michelson_v1.invalid_arity"
     ~title:"Invalid arity"
     ~description:
-      "In a script or data expression, a primitive was applied \
+      "In a script or data expression, a primitive was applied to an \
-       to an unsupported number of arguments."
+       unsupported number of arguments."
-    (located (obj3
+    (located
+       (obj3
           (req "primitive_name" Script.prim_encoding)
           (req "expected_arity" arity_enc)
           (req "wrong_arity" arity_enc)))
     (function
       | Invalid_arity (loc, name, exp, got) ->
           Some (loc, (name, exp, got))
-      | _ -> None)
+      | _ ->
-    (fun (loc, (name, exp, got)) ->
+          None)
-       Invalid_arity (loc, name, exp, got)) ;
+    (fun (loc, (name, exp, got)) -> Invalid_arity (loc, name, exp, got)) ;
   (* Missing field *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.missing_script_field"
     ~title:"Script is missing a field (parse error)"
-    ~description:
+    ~description:"When parsing script, a field was expected, but not provided"
-      "When parsing script, a field was expected, but not provided"
     (obj1 (req "prim" prim_encoding))
     (function Missing_field prim -> Some prim | _ -> None)
     (fun prim -> Missing_field prim) ;
@@ -110,16 +111,14 @@ let () =
     `Permanent
     ~id:"michelson_v1.invalid_primitive"
     ~title:"Invalid primitive"
-    ~description:
+    ~description:"In a script or data expression, a primitive was unknown."
-      "In a script or data expression, a primitive was unknown."
+    (located
-    (located (obj2
+       (obj2
           (dft "expected_primitive_names" (list prim_encoding) [])
           (req "wrong_primitive_name" prim_encoding)))
     (function
-      | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got))
+      | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)
-      | _ -> None)
+    (fun (loc, (exp, got)) -> Invalid_primitive (loc, exp, got)) ;
-    (fun (loc, (exp, got)) ->
-       Invalid_primitive (loc, exp, got)) ;
   (* Invalid kind *)
   register_error_kind
     `Permanent
@@ -128,14 +127,11 @@ let () =
     ~description:
       "In a script or data expression, an expression was of the wrong kind \
        (for instance a string where only a primitive applications can appear)."
-    (located (obj2
+    (located
-                (req "expected_kinds" (list kind_enc))
+       (obj2 (req "expected_kinds" (list kind_enc)) (req "wrong_kind" kind_enc)))
-                (req "wrong_kind" kind_enc)))
     (function
-      | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got))
+      | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)
-      | _ -> None)
+    (fun (loc, (exp, got)) -> Invalid_kind (loc, exp, got)) ;
-    (fun (loc, (exp, got)) ->
-       Invalid_kind (loc, exp, got)) ;
   (* Invalid namespace *)
   register_error_kind
     `Permanent
@@ -143,25 +139,24 @@ let () =
     ~title:"Invalid primitive namespace"
     ~description:
       "In a script or data expression, a primitive was of the wrong namespace."
-    (located (obj3
+    (located
+       (obj3
           (req "primitive_name" prim_encoding)
           (req "expected_namespace" namespace_enc)
           (req "wrong_namespace" namespace_enc)))
     (function
-      | Invalid_namespace (loc, name, exp, got) -> Some (loc, (name, exp, got))
+      | Invalid_namespace (loc, name, exp, got) ->
-      | _ -> None)
+          Some (loc, (name, exp, got))
-    (fun (loc, (name, exp, got)) ->
+      | _ ->
-       Invalid_namespace (loc, name, exp, got)) ;
+          None)
+    (fun (loc, (name, exp, got)) -> Invalid_namespace (loc, name, exp, got)) ;
   (* Duplicate field *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.duplicate_script_field"
     ~title:"Script has a duplicated field (parse error)"
-    ~description:
+    ~description:"When parsing script, a field was found more than once"
-      "When parsing script, a field was found more than once"
+    (obj2 (req "loc" location_encoding) (req "prim" prim_encoding))
-    (obj2
-       (req "loc" location_encoding)
-       (req "prim" prim_encoding))
     (function Duplicate_field (loc, prim) -> Some (loc, prim) | _ -> None)
     (fun (loc, prim) -> Duplicate_field (loc, prim)) ;
   (* Unexpected big_map *)
@@ -170,11 +165,9 @@ let () =
     ~id:"michelson_v1.unexpected_bigmap"
     ~title:"Big map in unauthorized position (type error)"
     ~description:
-      "When parsing script, a big_map type was found in a position \
+      "When parsing script, a big_map type was found in a position where it \
-       where it could end up stored inside a big_map, which is \
+       could end up stored inside a big_map, which is forbidden for now."
-       forbidden for now."
+    (obj1 (req "loc" location_encoding))
-    (obj1
-       (req "loc" location_encoding))
     (function Unexpected_big_map loc -> Some loc | _ -> None)
     (fun loc -> Unexpected_big_map loc) ;
   (* Unexpected operation *)
@@ -183,10 +176,9 @@ let () =
     ~id:"michelson_v1.unexpected_operation"
     ~title:"Operation in unauthorized position (type error)"
     ~description:
-      "When parsing script, an operation type was found \
+      "When parsing script, an operation type was found in the storage or \
-       in the storage or parameter field."
+       parameter field."
-    (obj1
+    (obj1 (req "loc" location_encoding))
-       (req "loc" location_encoding))
     (function Unexpected_operation loc -> Some loc | _ -> None)
     (fun loc -> Unexpected_operation loc) ;
   (* No such entrypoint *)
@@ -194,10 +186,8 @@ let () =
     `Permanent
     ~id:"michelson_v1.no_such_entrypoint"
     ~title:"No such entrypoint (type error)"
-    ~description:
+    ~description:"An entrypoint was not found when calling a contract."
-      "An entrypoint was not found when calling a contract."
+    (obj1 (req "entrypoint" string))
-    (obj1
-       (req "entrypoint" string))
     (function No_such_entrypoint entrypoint -> Some entrypoint | _ -> None)
     (fun entrypoint -> No_such_entrypoint entrypoint) ;
   (* Unreachable entrypoint *)
@@ -205,10 +195,8 @@ let () =
     `Permanent
     ~id:"michelson_v1.unreachable_entrypoint"
     ~title:"Unreachable entrypoint (type error)"
-    ~description:
+    ~description:"An entrypoint in the contract is not reachable."
-      "An entrypoint in the contract is not reachable."
+    (obj1 (req "path" (list prim_encoding)))
-    (obj1
-       (req "path" (list prim_encoding)))
     (function Unreachable_entrypoint path -> Some path | _ -> None)
     (fun path -> Unreachable_entrypoint path) ;
   (* Duplicate entrypoint *)
@@ -216,10 +204,8 @@ let () =
     `Permanent
     ~id:"michelson_v1.duplicate_entrypoint"
     ~title:"Duplicate entrypoint (type error)"
-    ~description:
+    ~description:"Two entrypoints have the same name."
-      "Two entrypoints have the same name."
+    (obj1 (req "path" string))
-    (obj1
-       (req "path" string))
     (function Duplicate_entrypoint entrypoint -> Some entrypoint | _ -> None)
     (fun entrypoint -> Duplicate_entrypoint entrypoint) ;
   (* Entrypoint name too long *)
@@ -229,9 +215,9 @@ let () =
     ~title:"Entrypoint name too long (type error)"
     ~description:
       "An entrypoint name exceeds the maximum length of 31 characters."
-    (obj1
+    (obj1 (req "name" string))
-       (req "name" string))
+    (function
-    (function Entrypoint_name_too_long entrypoint -> Some entrypoint | _ -> None)
+      | Entrypoint_name_too_long entrypoint -> Some entrypoint | _ -> None)
     (fun entrypoint -> Entrypoint_name_too_long entrypoint) ;
   (* Unexpected contract *)
   register_error_kind
@@ -239,10 +225,9 @@ let () =
     ~id:"michelson_v1.unexpected_contract"
     ~title:"Contract in unauthorized position (type error)"
     ~description:
-      "When parsing script, a contract type was found \
+      "When parsing script, a contract type was found in the storage or \
-       in the storage or parameter field."
+       parameter field."
-    (obj1
+    (obj1 (req "loc" location_encoding))
-       (req "loc" location_encoding))
     (function Unexpected_contract loc -> Some loc | _ -> None)
     (fun loc -> Unexpected_contract loc) ;
   (* -- Value typing errors ---------------------- *)
@@ -255,9 +240,7 @@ let () =
     (obj2
        (req "location" Script.location_encoding)
        (req "item" Script.expr_encoding))
-    (function
+    (function Unordered_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)
-      | Unordered_map_keys (loc, expr) -> Some (loc, expr)
-      | _ -> None)
     (fun (loc, expr) -> Unordered_map_keys (loc, expr)) ;
   (* Duplicate map keys *)
   register_error_kind
@@ -268,9 +251,7 @@ let () =
     (obj2
        (req "location" Script.location_encoding)
        (req "item" Script.expr_encoding))
-    (function
+    (function Duplicate_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)
-      | Duplicate_map_keys (loc, expr) -> Some (loc, expr)
-      | _ -> None)
     (fun (loc, expr) -> Duplicate_map_keys (loc, expr)) ;
   (* Unordered set values *)
   register_error_kind
@@ -282,22 +263,21 @@ let () =
        (req "location" Script.location_encoding)
        (req "value" Script.expr_encoding))
     (function
-      | Unordered_set_values (loc, expr) -> Some (loc, expr)
+      | Unordered_set_values (loc, expr) -> Some (loc, expr) | _ -> None)
-      | _ -> None)
     (fun (loc, expr) -> Unordered_set_values (loc, expr)) ;
   (* Duplicate set values *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.duplicate_set_values_in_literal"
     ~title:"Sets literals cannot contain duplicate elements"
-    ~description:"Set literals cannot contain duplicate elements, \
+    ~description:
-                  but a duplicae was found while parsing."
+      "Set literals cannot contain duplicate elements, but a duplicae was \
+       found while parsing."
     (obj2
        (req "location" Script.location_encoding)
        (req "value" Script.expr_encoding))
     (function
-      | Duplicate_set_values (loc, expr) -> Some (loc, expr)
+      | Duplicate_set_values (loc, expr) -> Some (loc, expr) | _ -> None)
-      | _ -> None)
     (fun (loc, expr) -> Duplicate_set_values (loc, expr)) ;
   (* -- Instruction typing errors ------------- *)
   (* Fail not in tail position *)
@@ -305,103 +285,95 @@ let () =
     `Permanent
     ~id:"michelson_v1.fail_not_in_tail_position"
     ~title:"FAIL not in tail position"
-    ~description:
+    ~description:"There is non trivial garbage code after a FAIL instruction."
-      "There is non trivial garbage code after a FAIL instruction."
     (located empty)
-    (function
+    (function Fail_not_in_tail_position loc -> Some (loc, ()) | _ -> None)
-      | Fail_not_in_tail_position loc -> Some (loc, ())
+    (fun (loc, ()) -> Fail_not_in_tail_position loc) ;
-      | _ -> None)
-    (fun (loc, ()) ->
-       Fail_not_in_tail_position loc) ;
   (* Undefined binary operation *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.undefined_binop"
     ~title:"Undefined binop"
     ~description:
-      "A binary operation is called on operands of types \
+      "A binary operation is called on operands of types over which it is not \
-       over which it is not defined."
+       defined."
-    (located (obj3
+    (located
+       (obj3
           (req "operator_name" prim_encoding)
           (req "wrong_left_operand_type" Script.expr_encoding)
           (req "wrong_right_operand_type" Script.expr_encoding)))
     (function
       | Undefined_binop (loc, n, tyl, tyr) ->
           Some (loc, (n, tyl, tyr))
-      | _ -> None)
+      | _ ->
-    (fun (loc, (n, tyl, tyr)) ->
+          None)
-       Undefined_binop (loc, n, tyl, tyr)) ;
+    (fun (loc, (n, tyl, tyr)) -> Undefined_binop (loc, n, tyl, tyr)) ;
   (* Undefined unary operation *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.undefined_unop"
     ~title:"Undefined unop"
     ~description:
-      "A unary operation is called on an operand of type \
+      "A unary operation is called on an operand of type over which it is not \
-       over which it is not defined."
+       defined."
-    (located (obj2
+    (located
+       (obj2
           (req "operator_name" prim_encoding)
           (req "wrong_operand_type" Script.expr_encoding)))
-    (function
+    (function Undefined_unop (loc, n, ty) -> Some (loc, (n, ty)) | _ -> None)
-      | Undefined_unop (loc, n, ty) ->
+    (fun (loc, (n, ty)) -> Undefined_unop (loc, n, ty)) ;
-          Some (loc, (n, ty))
-      | _ -> None)
-    (fun (loc, (n, ty)) ->
-       Undefined_unop (loc, n, ty)) ;
   (* Bad return *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.bad_return"
     ~title:"Bad return"
-    ~description:
+    ~description:"Unexpected stack at the end of a lambda or script."
-      "Unexpected stack at the end of a lambda or script."
+    (located
-    (located (obj2
+       (obj2
           (req "expected_return_type" Script.expr_encoding)
           (req "wrong_stack_type" stack_ty_enc)))
-    (function
+    (function Bad_return (loc, sty, ty) -> Some (loc, (ty, sty)) | _ -> None)
-      | Bad_return (loc, sty, ty) -> Some (loc, (ty, sty))
+    (fun (loc, (ty, sty)) -> Bad_return (loc, sty, ty)) ;
-      | _ -> None)
-    (fun (loc, (ty, sty)) ->
-       Bad_return (loc, sty, ty)) ;
   (* Bad stack *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.bad_stack"
     ~title:"Bad stack"
-    ~description:
+    ~description:"The stack has an unexpected length or contents."
-      "The stack has an unexpected length or contents."
+    (located
-    (located (obj3
+       (obj3
           (req "primitive_name" prim_encoding)
           (req "relevant_stack_portion" int16)
           (req "wrong_stack_type" stack_ty_enc)))
     (function
-      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty))
+      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty)) | _ -> None)
-      | _ -> None)
+    (fun (loc, (name, s, sty)) -> Bad_stack (loc, name, s, sty)) ;
-    (fun (loc, (name, s, sty)) ->
-       Bad_stack (loc, name, s, sty)) ;
   (* Inconsistent annotations *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.inconsistent_annotations"
     ~title:"Annotations inconsistent between branches"
     ~description:"The annotations on two types could not be merged"
-    (obj2
+    (obj2 (req "annot1" string) (req "annot2" string))
-       (req "annot1" string)
+    (function
-       (req "annot2" string))
+      | Inconsistent_annotations (annot1, annot2) ->
-    (function Inconsistent_annotations (annot1, annot2) -> Some (annot1, annot2)
+          Some (annot1, annot2)
-            | _ -> None)
+      | _ ->
+          None)
     (fun (annot1, annot2) -> Inconsistent_annotations (annot1, annot2)) ;
   (* Inconsistent field annotations *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.inconsistent_field_annotations"
     ~title:"Annotations for field accesses is inconsistent"
-    ~description:"The specified field does not match the field annotation in the type"
+    ~description:
-    (obj2
+      "The specified field does not match the field annotation in the type"
-       (req "annot1" string)
+    (obj2 (req "annot1" string) (req "annot2" string))
-       (req "annot2" string))
+    (function
-    (function Inconsistent_field_annotations (annot1, annot2) -> Some (annot1, annot2)
+      | Inconsistent_field_annotations (annot1, annot2) ->
-            | _ -> None)
+          Some (annot1, annot2)
+      | _ ->
+          None)
     (fun (annot1, annot2) -> Inconsistent_field_annotations (annot1, annot2)) ;
   (* Inconsistent type annotations *)
   register_error_kind
@@ -409,12 +381,15 @@ let () =
     ~id:"michelson_v1.inconsistent_type_annotations"
     ~title:"Types contain inconsistent annotations"
     ~description:"The two types contain annotations that do not match"
-    (located (obj2
+    (located
+       (obj2
           (req "type1" Script.expr_encoding)
           (req "type2" Script.expr_encoding)))
     (function
-      | Inconsistent_type_annotations (loc, ty1, ty2) -> Some (loc, (ty1, ty2))
+      | Inconsistent_type_annotations (loc, ty1, ty2) ->
-      | _ -> None)
+          Some (loc, (ty1, ty2))
+      | _ ->
+          None)
     (fun (loc, (ty1, ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ;
   (* Unexpected annotation *)
   register_error_kind
@@ -423,8 +398,7 @@ let () =
     ~title:"An annotation was encountered where no annotation is expected"
     ~description:"A node in the syntax tree was impropperly annotated"
     (located empty)
-    (function Unexpected_annotation loc -> Some (loc, ())
+    (function Unexpected_annotation loc -> Some (loc, ()) | _ -> None)
-            | _ -> None)
     (fun (loc, ()) -> Unexpected_annotation loc) ;
   (* Ungrouped annotations *)
   register_error_kind
@@ -433,8 +407,7 @@ let () =
     ~title:"Annotations of the same kind were found spread apart"
     ~description:"Annotations of the same kind must be grouped"
     (located empty)
-    (function Ungrouped_annotations loc -> Some (loc, ())
+    (function Ungrouped_annotations loc -> Some (loc, ()) | _ -> None)
-            | _ -> None)
     (fun (loc, ()) -> Ungrouped_annotations loc) ;
   (* Unmatched branches *)
   register_error_kind
@@ -442,151 +415,123 @@ let () =
     ~id:"michelson_v1.unmatched_branches"
     ~title:"Unmatched branches"
     ~description:
-      "At the join point at the end of two code branches \
+      "At the join point at the end of two code branches the stacks have \
-       the stacks have inconsistent lengths or contents."
+       inconsistent lengths or contents."
-    (located (obj2
+    (located
+       (obj2
           (req "first_stack_type" stack_ty_enc)
           (req "other_stack_type" stack_ty_enc)))
     (function
       | Unmatched_branches (loc, stya, styb) ->
           Some (loc, (stya, styb))
-      | _ -> None)
+      | _ ->
-    (fun (loc, (stya, styb)) ->
+          None)
-       Unmatched_branches (loc, stya, styb)) ;
+    (fun (loc, (stya, styb)) -> Unmatched_branches (loc, stya, styb)) ;
   (* Bad stack item *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.bad_stack_item"
     ~title:"Bad stack item"
     ~description:
-      "The type of a stack item is unexpected \
+      "The type of a stack item is unexpected (this error is always \
-       (this error is always accompanied by a more precise one)."
+       accompanied by a more precise one)."
     (obj1 (req "item_level" int16))
-    (function
+    (function Bad_stack_item n -> Some n | _ -> None)
-      | Bad_stack_item n -> Some n
+    (fun n -> Bad_stack_item n) ;
-      | _ -> None)
-    (fun n ->
-       Bad_stack_item n) ;
   (* SELF in lambda *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.self_in_lambda"
     ~title:"SELF instruction in lambda"
-    ~description:
+    ~description:"A SELF instruction was encountered in a lambda expression."
-      "A SELF instruction was encountered in a lambda expression."
     (located empty)
-    (function
+    (function Self_in_lambda loc -> Some (loc, ()) | _ -> None)
-      | Self_in_lambda loc -> Some (loc, ())
+    (fun (loc, ()) -> Self_in_lambda loc) ;
-      | _ -> None)
-    (fun (loc, ()) ->
-       Self_in_lambda loc) ;
   (* Bad stack length *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.inconsistent_stack_lengths"
     ~title:"Inconsistent stack lengths"
     ~description:
-      "A stack was of an unexpected length \
+      "A stack was of an unexpected length (this error is always in the \
-       (this error is always in the context of a located error)."
+       context of a located error)."
     empty
-    (function
+    (function Bad_stack_length -> Some () | _ -> None)
-      | Bad_stack_length -> Some ()
+    (fun () -> Bad_stack_length) ;
-      | _ -> None)
-    (fun () ->
-       Bad_stack_length) ;
   (* -- Value typing errors ------------------- *)
   (* Invalid constant *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.invalid_constant"
     ~title:"Invalid constant"
-    ~description:
+    ~description:"A data expression was invalid for its expected type."
-      "A data expression was invalid for its expected type."
+    (located
-    (located (obj2
+       (obj2
           (req "expected_type" Script.expr_encoding)
           (req "wrong_expression" Script.expr_encoding)))
     (function
-      | Invalid_constant (loc, expr, ty) ->
+      | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None)
-          Some (loc, (ty, expr))
+    (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ;
-      | _ -> None)
-    (fun (loc, (ty, expr)) ->
-       Invalid_constant (loc, expr, ty)) ;
   (* Invalid syntactic constant *)
   register_error_kind
     `Permanent
     ~id:"invalidSyntacticConstantError"
     ~title:"Invalid constant (parse error)"
-    ~description:
+    ~description:"A compile-time constant was invalid for its expected form."
-      "A compile-time constant was invalid for its expected form."
+    (located
-    (located (obj2
+       (obj2
           (req "expectedForm" Script.expr_encoding)
           (req "wrongExpression" Script.expr_encoding)))
     (function
-      | Invalid_constant (loc, expr, ty) ->
+      | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None)
-          Some (loc, (ty, expr))
+    (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ;
-      | _ -> None)
-    (fun (loc, (ty, expr)) ->
-       Invalid_constant (loc, expr, ty)) ;
   (* Invalid contract *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.invalid_contract"
     ~title:"Invalid contract"
     ~description:
-      "A script or data expression references a contract that does not \
+      "A script or data expression references a contract that does not exist \
-       exist or assumes a wrong type for an existing contract."
+       or assumes a wrong type for an existing contract."
     (located (obj1 (req "contract" Contract.encoding)))
-    (function
+    (function Invalid_contract (loc, c) -> Some (loc, c) | _ -> None)
-      | Invalid_contract (loc, c) ->
+    (fun (loc, c) -> Invalid_contract (loc, c)) ;
-          Some (loc, c)
-      | _ -> None)
-    (fun (loc, c) ->
-       Invalid_contract (loc, c)) ;
   (* Invalid big_map *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.invalid_big_map"
     ~title:"Invalid big_map"
     ~description:
-      "A script or data expression references a big_map that does not \
+      "A script or data expression references a big_map that does not exist \
-       exist or assumes a wrong type for an existing big_map."
+       or assumes a wrong type for an existing big_map."
     (located (obj1 (req "big_map" z)))
-    (function
+    (function Invalid_big_map (loc, c) -> Some (loc, c) | _ -> None)
-      | Invalid_big_map (loc, c) ->
+    (fun (loc, c) -> Invalid_big_map (loc, c)) ;
-          Some (loc, c)
-      | _ -> None)
-    (fun (loc, c) ->
-       Invalid_big_map (loc, c)) ;
   (* Comparable type expected *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.comparable_type_expected"
     ~title:"Comparable type expected"
     ~description:
-      "A non comparable type was used in a place where \
+      "A non comparable type was used in a place where only comparable types \
-       only comparable types are accepted."
+       are accepted."
     (located (obj1 (req "wrong_type" Script.expr_encoding)))
     (function
-      | Comparable_type_expected (loc, ty) -> Some (loc, ty)
+      | Comparable_type_expected (loc, ty) -> Some (loc, ty) | _ -> None)
-      | _ -> None)
+    (fun (loc, ty) -> Comparable_type_expected (loc, ty)) ;
-    (fun (loc, ty) ->
-       Comparable_type_expected (loc, ty)) ;
   (* Inconsistent types *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.inconsistent_types"
     ~title:"Inconsistent types"
     ~description:
-      "This is the basic type clash error, \
+      "This is the basic type clash error, that appears in several places \
-       that appears in several places where the equality of \
+       where the equality of two types have to be proven, it is always \
-       two types have to be proven, it is always accompanied \
+       accompanied with another error that provides more context."
-       with another error that provides more context."
     (obj2
        (req "first_type" Script.expr_encoding)
        (req "other_type" Script.expr_encoding))
-    (function
+    (function Inconsistent_types (tya, tyb) -> Some (tya, tyb) | _ -> None)
-      | Inconsistent_types (tya, tyb) -> Some (tya, tyb)
-      | _ -> None)
     (fun (tya, tyb) -> Inconsistent_types (tya, tyb)) ;
   (* -- Instruction typing errors ------------------- *)
   (* Invalid map body *)
@@ -594,42 +539,35 @@ let () =
     `Permanent
     ~id:"michelson_v1.invalid_map_body"
     ~title:"Invalid map body"
-    ~description:
+    ~description:"The body of a map block did not match the expected type"
-      "The body of a map block did not match the expected type"
+    (obj2 (req "loc" Script.location_encoding) (req "body_type" stack_ty_enc))
-    (obj2
+    (function Invalid_map_body (loc, stack) -> Some (loc, stack) | _ -> None)
-       (req "loc" Script.location_encoding)
-       (req "body_type" stack_ty_enc))
-    (function
-      | Invalid_map_body (loc, stack) -> Some (loc, stack)
-      | _ -> None)
     (fun (loc, stack) -> Invalid_map_body (loc, stack)) ;
   (* Invalid map block FAIL *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.invalid_map_block_fail"
     ~title:"FAIL instruction occurred as body of map block"
-    ~description:"FAIL cannot be the only instruction in the body. \
+    ~description:
-                  The propper type of the return list cannot be inferred."
+      "FAIL cannot be the only instruction in the body. The propper type of \
+       the return list cannot be inferred."
     (obj1 (req "loc" Script.location_encoding))
-    (function
+    (function Invalid_map_block_fail loc -> Some loc | _ -> None)
-      | Invalid_map_block_fail loc -> Some loc
-      | _ -> None)
     (fun loc -> Invalid_map_block_fail loc) ;
   (* Invalid ITER body *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.invalid_iter_body"
     ~title:"ITER body returned wrong stack type"
-    ~description:"The body of an ITER instruction \
+    ~description:
-                  must result in the same stack type as before \
+      "The body of an ITER instruction must result in the same stack type as \
-                  the ITER."
+       before the ITER."
     (obj3
        (req "loc" Script.location_encoding)
        (req "bef_stack" stack_ty_enc)
        (req "aft_stack" stack_ty_enc))
     (function
-      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft)
+      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft) | _ -> None)
-      | _ -> None)
     (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ;
   (* Type too large *)
   register_error_kind
@@ -642,8 +580,7 @@ let () =
        (req "type_size" uint16)
        (req "maximum_type_size" uint16))
     (function
-      | Type_too_large (loc, ts, maxts) -> Some (loc, ts, maxts)
+      | Type_too_large (loc, ts, maxts) -> Some (loc, ts, maxts) | _ -> None)
-      | _ -> None)
     (fun (loc, ts, maxts) -> Type_too_large (loc, ts, maxts)) ;
   (* -- Toplevel errors ------------------- *)
   (* Ill typed data *)
@@ -652,16 +589,14 @@ let () =
     ~id:"michelson_v1.ill_typed_data"
     ~title:"Ill typed data"
     ~description:
-      "The toplevel error thrown when trying to typecheck \
+      "The toplevel error thrown when trying to typecheck a data expression \
-       a data expression against a given type \
+       against a given type (always followed by more precise errors)."
-       (always followed by more precise errors)."
     (obj3
        (opt "identifier" string)
        (req "expected_type" Script.expr_encoding)
        (req "ill_typed_expression" Script.expr_encoding))
     (function
-      | Ill_typed_data (name, expr, ty) -> Some (name, ty,  expr)
+      | Ill_typed_data (name, expr, ty) -> Some (name, ty, expr) | _ -> None)
-      | _ -> None)
     (fun (name, ty, expr) -> Ill_typed_data (name, expr, ty)) ;
   (* Ill formed type *)
   register_error_kind
@@ -676,35 +611,32 @@ let () =
        (req "ill_formed_expression" Script.expr_encoding)
        (req "location" Script.location_encoding))
     (function
-      | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc)
+      | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc) | _ -> None)
-      | _ -> None)
+    (fun (name, expr, loc) -> Ill_formed_type (name, expr, loc)) ;
-    (fun (name, expr, loc) ->
-       Ill_formed_type (name, expr, loc)) ;
   (* Ill typed contract *)
   register_error_kind
     `Permanent
     ~id:"michelson_v1.ill_typed_contract"
     ~title:"Ill typed contract"
     ~description:
-      "The toplevel error thrown when trying to typecheck \
+      "The toplevel error thrown when trying to typecheck a contract code \
-       a contract code against given input, output and storage types \
+       against given input, output and storage types (always followed by more \
-       (always followed by more precise errors)."
+       precise errors)."
     (obj2
        (req "ill_typed_code" Script.expr_encoding)
        (req "type_map" type_map_enc))
     (function
       | Ill_typed_contract (expr, type_map) ->
           Some (expr, type_map)
-      | _ -> None)
+      | _ ->
-    (fun (expr, type_map) ->
+          None)
-       Ill_typed_contract (expr, type_map)) ;
+    (fun (expr, type_map) -> Ill_typed_contract (expr, type_map)) ;
   (* Cannot serialize error *)
   register_error_kind
     `Temporary
     ~id:"michelson_v1.cannot_serialize_error"
     ~title:"Not enough gas to serialize error"
-    ~description:"The error was too big to be serialized with \
+    ~description:"The error was too big to be serialized with the provided gas"
-                  the provided gas"
     Data_encoding.empty
     (function Cannot_serialize_error -> Some () | _ -> None)
     (fun () -> Cannot_serialize_error) ;
@@ -717,4 +649,4 @@ let () =
       "A deprecated instruction usage is disallowed in newly created contracts"
     (obj1 (req "prim" prim_encoding))
     (function Deprecated_instruction prim -> Some prim | _ -> None)
-    (fun prim -> Deprecated_instruction prim) ;
+    (fun prim -> Deprecated_instruction prim)

vendors/ligo-utils/tezos-protocol-alpha/script_timestamp_repr.ml

@@ -31,34 +31,27 @@ let of_int64 = Z.of_int64
 
 let of_string x =
   match Time_repr.of_notation x with
-  | None ->
+  | None -> (
-      begin try Some (Z.of_string x)
+    try Some (Z.of_string x) with _ -> None )
-        with _ -> None
-      end
   | Some time ->
       Some (of_int64 (Time_repr.to_seconds time))
 
 let to_notation x =
   try
     let notation = Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in
-    if String.equal notation "out_of_range"
+    if String.equal notation "out_of_range" then None else Some notation
-    then None
-    else Some notation
   with _ -> None
 
 let to_num_str = Z.to_string
 
-let to_string x =
+let to_string x = match to_notation x with None -> to_num_str x | Some s -> s
-  match to_notation x with
-  | None -> to_num_str x
-  | Some s -> s
 
 let diff x y = Script_int_repr.of_zint @@ Z.sub x y
 
 let sub_delta t delta = Z.sub t (Script_int_repr.to_zint delta)
 
-let add_delta t delta =
+let add_delta t delta = Z.add t (Script_int_repr.to_zint delta)
-  Z.add t (Script_int_repr.to_zint delta)
 
 let to_zint x = x
+
 let of_zint x = x

vendors/ligo-utils/tezos-protocol-alpha/script_timestamp_repr.mli

@@ -33,10 +33,13 @@ val compare : t -> t -> int
 
 (* Convert a timestamp to a notation if possible *)
 val to_notation : t -> string option
+
 (* Convert a timestamp to a string representation of the seconds *)
 val to_num_str : t -> string
+
 (* Convert to a notation if possible, or num if not *)
 val to_string : t -> string
+
 val of_string : string -> t option
 
 val diff : t -> t -> z num
@@ -46,4 +49,5 @@ val add_delta : t -> z num -> t
 val sub_delta : t -> z num -> t
 
 val to_zint : t -> Z.t
+
 val of_zint : Z.t -> t

vendors/ligo-utils/tezos-protocol-alpha/script_typed_ir.ml

@@ -29,7 +29,9 @@ open Script_int
 (* ---- Auxiliary types -----------------------------------------------------*)
 
 type var_annot = [`Var_annot of string]
+
 type type_annot = [`Type_annot of string]
+
 type field_annot = [`Field_annot of string]
 
 type annot = [var_annot | type_annot | field_annot]
@@ -41,6 +43,7 @@ type ('a, 'b) pair = 'a * 'b
 type ('a, 'b) union = L of 'a | R of 'b
 
 type comb = Comb
+
 type leaf = Leaf
 
 type (_, _) comparable_struct =
@@ -51,20 +54,27 @@ type (_, _) comparable_struct =
   | Mutez_key : type_annot option -> (Tez.t, _) comparable_struct
   | Bool_key : type_annot option -> (bool, _) comparable_struct
   | Key_hash_key : type_annot option -> (public_key_hash, _) comparable_struct
-  | Timestamp_key : type_annot option -> (Script_timestamp.t, _) comparable_struct
+  | Timestamp_key :
+      type_annot option
+      -> (Script_timestamp.t, _) comparable_struct
   | Address_key : type_annot option -> (address, _) comparable_struct
   | Pair_key :
-      (('a, leaf) comparable_struct * field_annot option) *
+      (('a, leaf) comparable_struct * field_annot option)
-      (('b, _) comparable_struct * field_annot option) *
+      * (('b, comb) comparable_struct * field_annot option)
-      type_annot option -> (('a, 'b) pair, comb) comparable_struct
+      * type_annot option
+      -> (('a, 'b) pair, comb) comparable_struct
 
 type 'a comparable_ty = ('a, comb) comparable_struct
 
 module type Boxed_set = sig
   type elt
+
   val elt_ty : elt comparable_ty
+
   module OPS : S.SET with type elt = elt
+
   val boxed : OPS.t
+
   val size : int
 end
 
@@ -72,27 +82,35 @@ type 'elt set = (module Boxed_set with type elt = 'elt)
 
 module type Boxed_map = sig
   type key
+
   type value
+
   val key_ty : key comparable_ty
+
   module OPS : S.MAP with type key = key
+
   val boxed : value OPS.t * int
 end
 
-type ('key, 'value) map = (module Boxed_map with type key = 'key and type value = 'value)
+type ('key, 'value) map =
+  (module Boxed_map with type key = 'key and type value = 'value)
 
 type operation = packed_internal_operation * Contract.big_map_diff option
 
-type ('arg, 'storage) script =
+type ('arg, 'storage) script = {
-  { code : (('arg, 'storage) pair, (operation list, 'storage) pair) lambda ;
+  code : (('arg, 'storage) pair, (operation list, 'storage) pair) lambda;
   arg_type : 'arg ty;
   storage : 'storage;
   storage_type : 'storage ty;
-    root_name : string option }
+  root_name : string option;
+}
 
 and end_of_stack = unit
 
 and ('arg, 'ret) lambda =
-    Lam : ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.node -> ('arg, 'ret) lambda
+  | Lam :
+      ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.node
+      -> ('arg, 'ret) lambda
 
 and 'arg typed_contract = 'arg ty * address
 
@@ -110,33 +128,43 @@ and 'ty ty =
   | Address_t : type_annot option -> address ty
   | Bool_t : type_annot option -> bool ty
   | Pair_t :
-      ('a ty * field_annot option * var_annot option) *
+      ('a ty * field_annot option * var_annot option)
-      ('b ty * field_annot option * var_annot option) *
+      * ('b ty * field_annot option * var_annot option)
-      type_annot option *
+      * type_annot option
-      bool -> ('a, 'b) pair ty
+      * bool
+      -> ('a, 'b) pair ty
   | Union_t :
-      ('a ty * field_annot option) *
+      ('a ty * field_annot option)
-      ('b ty * field_annot option) *
+      * ('b ty * field_annot option)
-      type_annot option *
+      * type_annot option
-      bool -> ('a, 'b) union ty
+      * bool
+      -> ('a, 'b) union ty
   | Lambda_t : 'arg ty * 'ret ty * type_annot option -> ('arg, 'ret) lambda ty
   | Option_t : 'v ty * type_annot option * bool -> 'v option ty
   | List_t : 'v ty * type_annot option * bool -> 'v list ty
   | Set_t : 'v comparable_ty * type_annot option -> 'v set ty
-  | Map_t : 'k comparable_ty * 'v ty * type_annot option * bool -> ('k, 'v) map ty
+  | Map_t :
-  | Big_map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) big_map ty
+      'k comparable_ty * 'v ty * type_annot option * bool
+      -> ('k, 'v) map ty
+  | Big_map_t :
+      'k comparable_ty * 'v ty * type_annot option
+      -> ('k, 'v) big_map ty
   | Contract_t : 'arg ty * type_annot option -> 'arg typed_contract ty
   | Operation_t : type_annot option -> operation ty
   | Chain_id_t : type_annot option -> Chain_id.t ty
 
 and 'ty stack_ty =
-  | Item_t : 'ty ty * 'rest stack_ty * var_annot option -> ('ty * 'rest) stack_ty
+  | Item_t :
+      'ty ty * 'rest stack_ty * var_annot option
+      -> ('ty * 'rest) stack_ty
   | Empty_t : end_of_stack stack_ty
 
-and ('key, 'value) big_map = { id : Z.t option ;
+and ('key, 'value) big_map = {
+  id : Z.t option;
   diff : ('key, 'value option) map;
   key_type : 'key ty;
-                               value_type : 'value ty }
+  value_type : 'value ty;
+}
 
 (* ---- Instructions --------------------------------------------------------*)
 
@@ -151,280 +179,225 @@ and ('key, 'value) big_map = { id : Z.t option ;
    constructors or type witness parameters. *)
 and ('bef, 'aft) instr =
   (* stack ops *)
-  | Drop :
+  | Drop : (_ * 'rest, 'rest) instr
-      (_ * 'rest, 'rest) instr
+  | Dup : ('top * 'rest, 'top * ('top * 'rest)) instr
-  | Dup :
+  | Swap : ('tip * ('top * 'rest), 'top * ('tip * 'rest)) instr
-      ('top * 'rest, 'top * ('top * 'rest)) instr
+  | Const : 'ty -> ('rest, 'ty * 'rest) instr
-  | Swap :
-      ('tip * ('top * 'rest), 'top * ('tip * 'rest)) instr
-  | Const : 'ty ->
-    ('rest, ('ty * 'rest)) instr
   (* pairs *)
-  | Cons_pair :
+  | Cons_pair : ('car * ('cdr * 'rest), ('car, 'cdr) pair * 'rest) instr
-      (('car * ('cdr * 'rest)), (('car, 'cdr) pair * 'rest)) instr
+  | Car : (('car, _) pair * 'rest, 'car * 'rest) instr
-  | Car :
+  | Cdr : ((_, 'cdr) pair * 'rest, 'cdr * 'rest) instr
-      (('car, _) pair * 'rest, 'car * 'rest) instr
-  | Cdr :
-      ((_, 'cdr) pair * 'rest, 'cdr * 'rest) instr
   (* options *)
-  | Cons_some :
+  | Cons_some : ('v * 'rest, 'v option * 'rest) instr
-      ('v * 'rest, 'v option * 'rest) instr
+  | Cons_none : 'a ty -> ('rest, 'a option * 'rest) instr
-  | Cons_none : 'a ty ->
+  | If_none :
-    ('rest, 'a option * 'rest) instr
+      ('bef, 'aft) descr * ('a * 'bef, 'aft) descr
-  | If_none : ('bef, 'aft) descr * ('a * 'bef, 'aft) descr ->
+      -> ('a option * 'bef, 'aft) instr
-    ('a option * 'bef, 'aft) instr
   (* unions *)
-  | Left :
+  | Left : ('l * 'rest, ('l, 'r) union * 'rest) instr
-      ('l * 'rest, (('l, 'r) union * 'rest)) instr
+  | Right : ('r * 'rest, ('l, 'r) union * 'rest) instr
-  | Right :
+  | If_left :
-      ('r * 'rest, (('l, 'r) union * 'rest)) instr
+      ('l * 'bef, 'aft) descr * ('r * 'bef, 'aft) descr
-  | If_left : ('l * 'bef, 'aft) descr * ('r * 'bef, 'aft) descr ->
+      -> (('l, 'r) union * 'bef, 'aft) instr
-    (('l, 'r) union * 'bef, 'aft) instr
   (* lists *)
-  | Cons_list :
+  | Cons_list : ('a * ('a list * 'rest), 'a list * 'rest) instr
-      ('a * ('a list * 'rest), ('a list * 'rest)) instr
+  | Nil : ('rest, 'a list * 'rest) instr
-  | Nil :
+  | If_cons :
-      ('rest, ('a list * 'rest)) instr
+      ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr
-  | If_cons : ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr ->
+      -> ('a list * 'bef, 'aft) instr
-    ('a list * 'bef, 'aft) instr
+  | List_map :
-  | List_map : ('a * 'rest, 'b * 'rest) descr ->
+      ('a * 'rest, 'b * 'rest) descr
-    ('a list * 'rest, 'b list * 'rest) instr
+      -> ('a list * 'rest, 'b list * 'rest) instr
-  | List_iter : ('a * 'rest, 'rest) descr ->
+  | List_iter : ('a * 'rest, 'rest) descr -> ('a list * 'rest, 'rest) instr
-    ('a list * 'rest, 'rest) instr
   | List_size : ('a list * 'rest, n num * 'rest) instr
   (* sets *)
-  | Empty_set : 'a comparable_ty ->
+  | Empty_set : 'a comparable_ty -> ('rest, 'a set * 'rest) instr
-    ('rest, 'a set * 'rest) instr
+  | Set_iter : ('a * 'rest, 'rest) descr -> ('a set * 'rest, 'rest) instr
-  | Set_iter : ('a * 'rest, 'rest) descr ->
+  | Set_mem : ('elt * ('elt set * 'rest), bool * 'rest) instr
-    ('a set * 'rest, 'rest) instr
+  | Set_update : ('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr
-  | Set_mem :
-      ('elt * ('elt set * 'rest), bool * 'rest) instr
-  | Set_update :
-      ('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr
   | Set_size : ('a set * 'rest, n num * 'rest) instr
   (* maps *)
-  | Empty_map : 'a comparable_ty * 'v ty ->
+  | Empty_map : 'a comparable_ty * 'v ty -> ('rest, ('a, 'v) map * 'rest) instr
-    ('rest, ('a, 'v) map * 'rest) instr
+  | Map_map :
-  | Map_map : (('a * 'v) * 'rest, 'r * 'rest) descr ->
+      (('a * 'v) * 'rest, 'r * 'rest) descr
-    (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr
+      -> (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr
-  | Map_iter : (('a * 'v) * 'rest, 'rest) descr ->
+  | Map_iter :
-    (('a, 'v) map * 'rest, 'rest) instr
+      (('a * 'v) * 'rest, 'rest) descr
-  | Map_mem :
+      -> (('a, 'v) map * 'rest, 'rest) instr
-      ('a * (('a, 'v) map * 'rest), bool * 'rest) instr
+  | Map_mem : ('a * (('a, 'v) map * 'rest), bool * 'rest) instr
-  | Map_get :
+  | Map_get : ('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr
-      ('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr
+  | Map_update
-  | Map_update :
+      : ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
-      ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
   | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr
   (* big maps *)
-  | Empty_big_map : 'a comparable_ty * 'v ty ->
+  | Empty_big_map :
-    ('rest, ('a, 'v) big_map * 'rest) instr
+      'a comparable_ty * 'v ty
-  | Big_map_mem :
+      -> ('rest, ('a, 'v) big_map * 'rest) instr
-      ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr
+  | Big_map_mem : ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr
-  | Big_map_get :
+  | Big_map_get : ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr
-      ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr
+  | Big_map_update
-  | Big_map_update :
+      : ( 'key * ('value option * (('key, 'value) big_map * 'rest)),
-      ('key * ('value option * (('key, 'value) big_map * 'rest)), ('key, 'value) big_map * 'rest) instr
+          ('key, 'value) big_map * 'rest )
+        instr
   (* string operations *)
-  | Concat_string :
+  | Concat_string : (string list * 'rest, string * 'rest) instr
-      (string list * 'rest, string * 'rest) instr
+  | Concat_string_pair : (string * (string * 'rest), string * 'rest) instr
-  | Concat_string_pair :
+  | Slice_string
-      (string * (string * 'rest), string * 'rest) instr
+      : (n num * (n num * (string * 'rest)), string option * 'rest) instr
-  | Slice_string :
+  | String_size : (string * 'rest, n num * 'rest) instr
-      (n num * (n num * (string * 'rest)), string option * 'rest) instr
-  | String_size :
-      (string * 'rest, n num * 'rest) instr
   (* bytes operations *)
-  | Concat_bytes :
+  | Concat_bytes : (MBytes.t list * 'rest, MBytes.t * 'rest) instr
-      (MBytes.t list * 'rest, MBytes.t * 'rest) instr
+  | Concat_bytes_pair : (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) instr
-  | Concat_bytes_pair :
+  | Slice_bytes
-      (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) instr
+      : (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr
-  | Slice_bytes :
+  | Bytes_size : (MBytes.t * 'rest, n num * 'rest) instr
-      (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr
-  | Bytes_size :
-      (MBytes.t * 'rest, n num * 'rest) instr
   (* timestamp operations *)
-  | Add_seconds_to_timestamp :
+  | Add_seconds_to_timestamp
-      (z num * (Script_timestamp.t * 'rest),
+      : ( z num * (Script_timestamp.t * 'rest),
-       Script_timestamp.t * 'rest) instr
+          Script_timestamp.t * 'rest )
-  | Add_timestamp_to_seconds :
+        instr
-      (Script_timestamp.t * (z num * 'rest),
+  | Add_timestamp_to_seconds
-       Script_timestamp.t * 'rest) instr
+      : ( Script_timestamp.t * (z num * 'rest),
-  | Sub_timestamp_seconds :
+          Script_timestamp.t * 'rest )
-      (Script_timestamp.t * (z num * 'rest),
+        instr
-       Script_timestamp.t * 'rest) instr
+  | Sub_timestamp_seconds
-  | Diff_timestamps :
+      : ( Script_timestamp.t * (z num * 'rest),
-      (Script_timestamp.t * (Script_timestamp.t * 'rest),
+          Script_timestamp.t * 'rest )
-       z num * 'rest) instr
+        instr
+  | Diff_timestamps
+      : ( Script_timestamp.t * (Script_timestamp.t * 'rest),
+          z num * 'rest )
+        instr
   (* tez operations *)
-  | Add_tez :
+  | Add_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
-      (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
+  | Sub_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
-  | Sub_tez :
+  | Mul_teznat : (Tez.t * (n num * 'rest), Tez.t * 'rest) instr
-      (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
+  | Mul_nattez : (n num * (Tez.t * 'rest), Tez.t * 'rest) instr
-  | Mul_teznat :
+  | Ediv_teznat
-      (Tez.t * (n num * 'rest), Tez.t * 'rest) instr
+      : (Tez.t * (n num * 'rest), (Tez.t, Tez.t) pair option * 'rest) instr
-  | Mul_nattez :
+  | Ediv_tez
-      (n num * (Tez.t * 'rest), Tez.t * 'rest) instr
+      : (Tez.t * (Tez.t * 'rest), (n num, Tez.t) pair option * 'rest) instr
-  | Ediv_teznat :
-      (Tez.t * (n num * 'rest), ((Tez.t, Tez.t) pair) option * 'rest) instr
-  | Ediv_tez :
-      (Tez.t * (Tez.t * 'rest), ((n num, Tez.t) pair) option * 'rest) instr
   (* boolean operations *)
-  | Or :
+  | Or : (bool * (bool * 'rest), bool * 'rest) instr
-      (bool * (bool * 'rest), bool * 'rest) instr
+  | And : (bool * (bool * 'rest), bool * 'rest) instr
-  | And :
+  | Xor : (bool * (bool * 'rest), bool * 'rest) instr
-      (bool * (bool * 'rest), bool * 'rest) instr
+  | Not : (bool * 'rest, bool * 'rest) instr
-  | Xor :
-      (bool * (bool * 'rest), bool * 'rest) instr
-  | Not :
-      (bool * 'rest, bool * 'rest) instr
   (* integer operations *)
-  | Is_nat :
+  | Is_nat : (z num * 'rest, n num option * 'rest) instr
-      (z num * 'rest, n num option * 'rest) instr
+  | Neg_nat : (n num * 'rest, z num * 'rest) instr
-  | Neg_nat :
+  | Neg_int : (z num * 'rest, z num * 'rest) instr
-      (n num * 'rest, z num * 'rest) instr
+  | Abs_int : (z num * 'rest, n num * 'rest) instr
-  | Neg_int :
+  | Int_nat : (n num * 'rest, z num * 'rest) instr
-      (z num * 'rest, z num * 'rest) instr
+  | Add_intint : (z num * (z num * 'rest), z num * 'rest) instr
-  | Abs_int :
+  | Add_intnat : (z num * (n num * 'rest), z num * 'rest) instr
-      (z num * 'rest, n num * 'rest) instr
+  | Add_natint : (n num * (z num * 'rest), z num * 'rest) instr
-  | Int_nat :
+  | Add_natnat : (n num * (n num * 'rest), n num * 'rest) instr
-      (n num * 'rest, z num * 'rest) instr
+  | Sub_int : ('s num * ('t num * 'rest), z num * 'rest) instr
-  | Add_intint :
+  | Mul_intint : (z num * (z num * 'rest), z num * 'rest) instr
-      (z num * (z num * 'rest), z num * 'rest) instr
+  | Mul_intnat : (z num * (n num * 'rest), z num * 'rest) instr
-  | Add_intnat :
+  | Mul_natint : (n num * (z num * 'rest), z num * 'rest) instr
-      (z num * (n num * 'rest), z num * 'rest) instr
+  | Mul_natnat : (n num * (n num * 'rest), n num * 'rest) instr
-  | Add_natint :
+  | Ediv_intint
-      (n num * (z num * 'rest), z num * 'rest) instr
+      : (z num * (z num * 'rest), (z num, n num) pair option * 'rest) instr
-  | Add_natnat :
+  | Ediv_intnat
-      (n num * (n num * 'rest), n num * 'rest) instr
+      : (z num * (n num * 'rest), (z num, n num) pair option * 'rest) instr
-  | Sub_int :
+  | Ediv_natint
-      ('s num * ('t num * 'rest), z num * 'rest) instr
+      : (n num * (z num * 'rest), (z num, n num) pair option * 'rest) instr
-  | Mul_intint :
+  | Ediv_natnat
-      (z num * (z num * 'rest), z num * 'rest) instr
+      : (n num * (n num * 'rest), (n num, n num) pair option * 'rest) instr
-  | Mul_intnat :
+  | Lsl_nat : (n num * (n num * 'rest), n num * 'rest) instr
-      (z num * (n num * 'rest), z num * 'rest) instr
+  | Lsr_nat : (n num * (n num * 'rest), n num * 'rest) instr
-  | Mul_natint :
+  | Or_nat : (n num * (n num * 'rest), n num * 'rest) instr
-      (n num * (z num * 'rest), z num * 'rest) instr
+  | And_nat : (n num * (n num * 'rest), n num * 'rest) instr
-  | Mul_natnat :
+  | And_int_nat : (z num * (n num * 'rest), n num * 'rest) instr
-      (n num * (n num * 'rest), n num * 'rest) instr
+  | Xor_nat : (n num * (n num * 'rest), n num * 'rest) instr
-  | Ediv_intint :
+  | Not_nat : (n num * 'rest, z num * 'rest) instr
-      (z num * (z num * 'rest), ((z num, n num) pair) option * 'rest) instr
+  | Not_int : (z num * 'rest, z num * 'rest) instr
-  | Ediv_intnat :
-      (z num * (n num * 'rest), ((z num, n num) pair) option * 'rest) instr
-  | Ediv_natint :
-      (n num * (z num * 'rest), ((z num, n num) pair) option * 'rest) instr
-  | Ediv_natnat :
-      (n num * (n num * 'rest), ((n num, n num) pair) option * 'rest) instr
-  | Lsl_nat :
-      (n num * (n num * 'rest), n num * 'rest) instr
-  | Lsr_nat :
-      (n num * (n num * 'rest), n num * 'rest) instr
-  | Or_nat :
-      (n num * (n num * 'rest), n num * 'rest) instr
-  | And_nat :
-      (n num * (n num * 'rest), n num * 'rest) instr
-  | And_int_nat :
-      (z num * (n num * 'rest), n num * 'rest) instr
-  | Xor_nat :
-      (n num * (n num * 'rest), n num * 'rest) instr
-  | Not_nat :
-      (n num * 'rest, z num * 'rest) instr
-  | Not_int :
-      (z num * 'rest, z num * 'rest) instr
   (* control *)
-  | Seq : ('bef, 'trans) descr * ('trans, 'aft) descr ->
+  | Seq : ('bef, 'trans) descr * ('trans, 'aft) descr -> ('bef, 'aft) instr
-    ('bef, 'aft) instr
+  | If : ('bef, 'aft) descr * ('bef, 'aft) descr -> (bool * 'bef, 'aft) instr
-  | If : ('bef, 'aft) descr * ('bef, 'aft) descr ->
+  | Loop : ('rest, bool * 'rest) descr -> (bool * 'rest, 'rest) instr
-    (bool * 'bef, 'aft) instr
+  | Loop_left :
-  | Loop : ('rest, bool * 'rest) descr ->
+      ('a * 'rest, ('a, 'b) union * 'rest) descr
-    (bool * 'rest, 'rest) instr
+      -> (('a, 'b) union * 'rest, 'b * 'rest) instr
-  | Loop_left : ('a * 'rest, ('a, 'b) union * 'rest) descr ->
+  | Dip : ('bef, 'aft) descr -> ('top * 'bef, 'top * 'aft) instr
-    (('a, 'b) union * 'rest, 'b * 'rest) instr
+  | Exec : ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr
-  | Dip : ('bef, 'aft) descr ->
+  | Apply :
-    ('top * 'bef, 'top * 'aft) instr
+      'arg ty
-  | Exec :
+      -> ( 'arg * (('arg * 'remaining, 'ret) lambda * 'rest),
-      ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr
+           ('remaining, 'ret) lambda * 'rest )
-  | Apply : 'arg ty ->
+         instr
-      ('arg * (('arg * 'remaining, 'ret) lambda * 'rest), ('remaining, 'ret) lambda * 'rest) instr
+  | Lambda : ('arg, 'ret) lambda -> ('rest, ('arg, 'ret) lambda * 'rest) instr
-  | Lambda : ('arg, 'ret) lambda ->
+  | Failwith : 'a ty -> ('a * 'rest, 'aft) instr
-    ('rest, ('arg, 'ret) lambda * 'rest) instr
+  | Nop : ('rest, 'rest) instr
-  | Failwith :
-      'a ty -> ('a * 'rest, 'aft) instr
-  | Nop :
-      ('rest, 'rest) instr
   (* comparison *)
-  | Compare : 'a comparable_ty ->
+  | Compare : 'a comparable_ty -> ('a * ('a * 'rest), z num * 'rest) instr
-    ('a * ('a * 'rest), z num * 'rest) instr
   (* comparators *)
-  | Eq :
+  | Eq : (z num * 'rest, bool * 'rest) instr
-      (z num * 'rest, bool * 'rest) instr
+  | Neq : (z num * 'rest, bool * 'rest) instr
-  | Neq :
+  | Lt : (z num * 'rest, bool * 'rest) instr
-      (z num * 'rest, bool * 'rest) instr
+  | Gt : (z num * 'rest, bool * 'rest) instr
-  | Lt :
+  | Le : (z num * 'rest, bool * 'rest) instr
-      (z num * 'rest, bool * 'rest) instr
+  | Ge : (z num * 'rest, bool * 'rest) instr
-  | Gt :
-      (z num * 'rest, bool * 'rest) instr
-  | Le :
-      (z num * 'rest, bool * 'rest) instr
-  | Ge :
-      (z num * 'rest, bool * 'rest) instr
   (* protocol *)
-  | Address :
+  | Address : (_ typed_contract * 'rest, address * 'rest) instr
-      (_ typed_contract * 'rest, address * 'rest) instr
+  | Contract :
-  | Contract : 'p ty * string ->
+      'p ty * string
-    (address * 'rest, 'p typed_contract option * 'rest) instr
+      -> (address * 'rest, 'p typed_contract option * 'rest) instr
-  | Transfer_tokens :
+  | Transfer_tokens
-      ('arg * (Tez.t * ('arg typed_contract * 'rest)), operation * 'rest) instr
+      : ( 'arg * (Tez.t * ('arg typed_contract * 'rest)),
-  | Create_account :
+          operation * 'rest )
-      (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
+        instr
-       operation * (address * 'rest)) instr
+  | Create_account
-  | Implicit_account :
+      : ( public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
-      (public_key_hash * 'rest, unit typed_contract * 'rest) instr
+          operation * (address * 'rest) )
-  | Create_contract : 'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option ->
+        instr
-    (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
+  | Implicit_account
-     operation * (address * 'rest)) instr
+      : (public_key_hash * 'rest, unit typed_contract * 'rest) instr
-  | Create_contract_2 : 'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option  ->
+  | Create_contract :
-    (public_key_hash option * (Tez.t * ('g * 'rest)), operation * (address * 'rest)) instr
+      'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option
-  | Set_delegate :
+      -> ( public_key_hash
-      (public_key_hash option * 'rest, operation * 'rest) instr
+           * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
-  | Now :
+           operation * (address * 'rest) )
-      ('rest, Script_timestamp.t * 'rest) instr
+         instr
-  | Balance :
+  | Create_contract_2 :
-      ('rest, Tez.t * 'rest) instr
+      'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option
-  | Check_signature :
+      -> ( public_key_hash option * (Tez.t * ('g * 'rest)),
-      (public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr
+           operation * (address * 'rest) )
-  | Hash_key :
+         instr
-      (public_key * 'rest, public_key_hash * 'rest) instr
+  | Set_delegate : (public_key_hash option * 'rest, operation * 'rest) instr
-  | Pack : 'a ty ->
+  | Now : ('rest, Script_timestamp.t * 'rest) instr
-    ('a * 'rest, MBytes.t * 'rest) instr
+  | Balance : ('rest, Tez.t * 'rest) instr
-  | Unpack : 'a ty ->
+  | Check_signature
-    (MBytes.t * 'rest, 'a option * 'rest) instr
+      : (public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr
-  | Blake2b :
+  | Hash_key : (public_key * 'rest, public_key_hash * 'rest) instr
-      (MBytes.t * 'rest, MBytes.t * 'rest) instr
+  | Pack : 'a ty -> ('a * 'rest, MBytes.t * 'rest) instr
-  | Sha256 :
+  | Unpack : 'a ty -> (MBytes.t * 'rest, 'a option * 'rest) instr
-      (MBytes.t * 'rest, MBytes.t * 'rest) instr
+  | Blake2b : (MBytes.t * 'rest, MBytes.t * 'rest) instr
-  | Sha512 :
+  | Sha256 : (MBytes.t * 'rest, MBytes.t * 'rest) instr
-      (MBytes.t * 'rest, MBytes.t * 'rest) instr
+  | Sha512 : (MBytes.t * 'rest, MBytes.t * 'rest) instr
-  | Steps_to_quota : (* TODO: check that it always returns a nat *)
+  | Steps_to_quota
+      : (* TODO: check that it always returns a nat *)
       ('rest, n num * 'rest) instr
-  | Source :
+  | Source : ('rest, address * 'rest) instr
-      ('rest, address * 'rest) instr
+  | Sender : ('rest, address * 'rest) instr
-  | Sender :
+  | Self : 'p ty * string -> ('rest, 'p typed_contract * 'rest) instr
-      ('rest, address * 'rest) instr
+  | Amount : ('rest, Tez.t * 'rest) instr
-  | Self : 'p ty * string ->
+  | Dig :
-    ('rest, 'p typed_contract * 'rest) instr
+      int * ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness
-  | Amount :
+      -> ('bef, 'x * 'aft) instr
-      ('rest, Tez.t * 'rest) instr
+  | Dug :
-  | Dig   : int * ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness ->
+      int * ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness
-    ('bef, 'x * 'aft) instr
+      -> ('x * 'bef, 'aft) instr
-  | Dug   : int * ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness ->
+  | Dipn :
-    ('x * 'bef, 'aft) instr
+      int
-  | Dipn  : int * ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness * ('fbef, 'faft) descr ->
+      * ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
-    ('bef, 'aft) instr
+      * ('fbef, 'faft) descr
-  | Dropn : int * ('rest, 'rest, 'bef, _) stack_prefix_preservation_witness ->
+      -> ('bef, 'aft) instr
-    ('bef, 'rest) instr
+  | Dropn :
-  | ChainId :
+      int * ('rest, 'rest, 'bef, _) stack_prefix_preservation_witness
-      ('rest, Chain_id.t * 'rest) instr
+      -> ('bef, 'rest) instr
+  | ChainId : ('rest, Chain_id.t * 'rest) instr
 
 (* Type witness for operations that work deep in the stack ignoring
    (and preserving) a prefix.
@@ -434,14 +407,16 @@ and ('bef, 'aft) instr =
    parameters are the shape of the stack without the prefix before and
    after. The inductive definition makes it so by construction. *)
 and ('bef, 'aft, 'bef_suffix, 'aft_suffix) stack_prefix_preservation_witness =
-  | Prefix : ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
+  | Prefix :
+      ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
       -> ('fbef, 'faft, 'x * 'bef, 'x * 'aft) stack_prefix_preservation_witness
   | Rest : ('bef, 'aft, 'bef, 'aft) stack_prefix_preservation_witness
 
-and ('bef, 'aft) descr =
+and ('bef, 'aft) descr = {
-  { loc : Script.location ;
+  loc : Script.location;
   bef : 'bef stack_ty;
   aft : 'aft stack_ty;
-    instr : ('bef, 'aft)  instr }
+  instr : ('bef, 'aft) instr;
+}
 
 type ex_big_map = Ex_bm : ('key, 'value) big_map -> ex_big_map

vendors/ligo-utils/tezos-protocol-alpha/seed_repr.ml

@@ -26,13 +26,17 @@
 (* Tezos Protocol Implementation - Random number generation *)
 
 type seed = B of State_hash.t
+
 type t = T of State_hash.t
+
 type sequence = S of State_hash.t
+
 type nonce = MBytes.t
 
 let nonce_encoding = Data_encoding.Fixed.bytes Constants_repr.nonce_length
 
 let init = "Laissez-faire les proprietaires."
+
 let zero_bytes = MBytes.of_string (String.make Nonce_hash.size '\000')
 
 let state_hash_encoding =
@@ -44,31 +48,25 @@ let state_hash_encoding =
 
 let seed_encoding =
   let open Data_encoding in
-  conv
+  conv (fun (B b) -> b) (fun b -> B b) state_hash_encoding
-    (fun (B b) -> b)
-    (fun b -> B b)
-    state_hash_encoding
 
 let empty = B (State_hash.hash_bytes [MBytes.of_string init])
 
 let nonce (B state) nonce =
-  B (State_hash.hash_bytes ( [State_hash.to_bytes state; nonce] ))
+  B (State_hash.hash_bytes [State_hash.to_bytes state; nonce])
 
 let initialize_new (B state) append =
-  T (State_hash.hash_bytes
+  T (State_hash.hash_bytes (State_hash.to_bytes state :: zero_bytes :: append))
-       (State_hash.to_bytes state :: zero_bytes :: append ))
 
 let xor_higher_bits i b =
   let higher = MBytes.get_int32 b 0 in
   let r = Int32.logxor higher i in
   let res = MBytes.copy b in
-  MBytes.set_int32 res 0 r;
+  MBytes.set_int32 res 0 r ; res
-  res
 
 let sequence (T state) n =
-  State_hash.to_bytes state
+  State_hash.to_bytes state |> xor_higher_bits n
-  |> xor_higher_bits n
+  |> fun b -> S (State_hash.hash_bytes [b])
-  |> (fun b -> S (State_hash.hash_bytes [b]))
 
 let take (S state) =
   let b = State_hash.to_bytes state in
@@ -76,19 +74,19 @@ let take (S state) =
   (State_hash.to_bytes h, S h)
 
 let take_int32 s bound =
-  if Compare.Int32.(bound <= 0l)
+  if Compare.Int32.(bound <= 0l) then invalid_arg "Seed_repr.take_int32"
-  then invalid_arg "Seed_repr.take_int32" (* FIXME *)
+    (* FIXME *)
   else
     let rec loop s =
-      let bytes, s = take s in
+      let (bytes, s) = take s in
       let r = Int32.abs (MBytes.get_int32 bytes 0) in
       let drop_if_over =
-        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound) in
+        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound)
-      if Compare.Int32.(r >= drop_if_over)
+      in
-      then loop s
+      if Compare.Int32.(r >= drop_if_over) then loop s
       else
         let v = Int32.rem r bound in
-        v, s
+        (v, s)
     in
     loop s
 
@@ -101,15 +99,17 @@ let () =
     ~title:"Unexpected nonce length"
     ~description:"Nonce length is incorrect."
     ~pp:(fun ppf () ->
-        Format.fprintf ppf "Nonce length is not %i bytes long as it should."
+      Format.fprintf
+        ppf
+        "Nonce length is not %i bytes long as it should."
         Constants_repr.nonce_length)
     Data_encoding.empty
     (function Unexpected_nonce_length -> Some () | _ -> None)
     (fun () -> Unexpected_nonce_length)
 
 let make_nonce nonce =
-  if Compare.Int.(MBytes.length nonce <> Constants_repr.nonce_length)
+  if Compare.Int.(MBytes.length nonce <> Constants_repr.nonce_length) then
-  then error Unexpected_nonce_length
+    error Unexpected_nonce_length
   else ok nonce
 
 let hash nonce = Nonce_hash.hash_bytes [nonce]
@@ -122,18 +122,13 @@ let nonce_hash_key_part = Nonce_hash.to_path
 
 let initial_nonce_0 = zero_bytes
 
-let initial_nonce_hash_0 =
+let initial_nonce_hash_0 = hash initial_nonce_0
-  hash initial_nonce_0
 
 let deterministic_seed seed = nonce seed zero_bytes
 
 let initial_seeds n =
   let rec loop acc elt i =
-    if Compare.Int.(i = 1) then
+    if Compare.Int.(i = 1) then List.rev (elt :: acc)
-      List.rev (elt :: acc)
+    else loop (elt :: acc) (deterministic_seed elt) (i - 1)
-    else
+  in
-      loop
-        (elt :: acc)
-        (deterministic_seed elt)
-        (i-1) in
   loop [] (B (State_hash.hash_bytes [])) n

vendors/ligo-utils/tezos-protocol-alpha/seed_repr.mli

@@ -32,7 +32,6 @@
     The only expected property is: It should be difficult to find a
     seed such that the generated sequence is a given one. *)
 
-
 (** {2 Random Generation} *)
 
 (** The state of the random number generator *)
@@ -91,9 +90,11 @@ val nonce_hash_key_part : Nonce_hash.t -> string list -> string list
 (** {2 Predefined nonce} *)
 
 val initial_nonce_0 : nonce
+
 val initial_nonce_hash_0 : Nonce_hash.t
 
 (** {2 Serializers} *)
 
 val nonce_encoding : nonce Data_encoding.t
+
 val seed_encoding : seed Data_encoding.t

vendors/ligo-utils/tezos-protocol-alpha/seed_storage.ml

@@ -26,9 +26,13 @@
 open Misc
 
 type error +=
-  | Unknown of { oldest : Cycle_repr.t ;
+  | Unknown of {
+      oldest : Cycle_repr.t;
       cycle : Cycle_repr.t;
-                 latest : Cycle_repr.t } (* `Permanent *)
+      latest : Cycle_repr.t;
+    }
+
+(* `Permanent *)
 
 let () =
   register_error_kind
@@ -38,45 +42,59 @@ let () =
     ~description:"The requested seed is not available"
     ~pp:(fun ppf (oldest, cycle, latest) ->
       if Cycle_repr.(cycle < oldest) then
-          Format.fprintf ppf
+        Format.fprintf
-            "The seed for cycle %a has been cleared from the context \
+          ppf
-            \ (oldest known seed is for cycle %a)"
+          "The seed for cycle %a has been cleared from the context  (oldest \
-            Cycle_repr.pp cycle
+           known seed is for cycle %a)"
-            Cycle_repr.pp oldest
+          Cycle_repr.pp
+          cycle
+          Cycle_repr.pp
+          oldest
       else
-          Format.fprintf ppf
+        Format.fprintf
-            "The seed for cycle %a has not been computed yet \
+          ppf
-            \ (latest known seed is for cycle %a)"
+          "The seed for cycle %a has not been computed yet  (latest known \
-            Cycle_repr.pp cycle
+           seed is for cycle %a)"
-            Cycle_repr.pp latest)
+          Cycle_repr.pp
-    Data_encoding.(obj3
+          cycle
+          Cycle_repr.pp
+          latest)
+    Data_encoding.(
+      obj3
         (req "oldest" Cycle_repr.encoding)
         (req "requested" Cycle_repr.encoding)
         (req "latest" Cycle_repr.encoding))
     (function
-      | Unknown { oldest ; cycle ; latest } -> Some (oldest, cycle, latest)
+      | Unknown {oldest; cycle; latest} ->
-      | _ -> None)
+          Some (oldest, cycle, latest)
+      | _ ->
+          None)
     (fun (oldest, cycle, latest) -> Unknown {oldest; cycle; latest})
 
 let compute_for_cycle c ~revealed cycle =
   match Cycle_repr.pred cycle with
-  | None -> assert false (* should not happen *)
+  | None ->
+      assert false (* should not happen *)
   | Some previous_cycle ->
       let levels = Level_storage.levels_with_commitments_in_cycle c revealed in
       let combine (c, random_seed, unrevealed) level =
-        Storage.Seed.Nonce.get c level >>=? function
+        Storage.Seed.Nonce.get c level
+        >>=? function
         | Revealed nonce ->
-            Storage.Seed.Nonce.delete c level >>=? fun c ->
+            Storage.Seed.Nonce.delete c level
+            >>=? fun c ->
             return (c, Seed_repr.nonce random_seed nonce, unrevealed)
         | Unrevealed u ->
-            Storage.Seed.Nonce.delete c level >>=? fun c ->
+            Storage.Seed.Nonce.delete c level
-            return (c, random_seed, u :: unrevealed)
+            >>=? fun c -> return (c, random_seed, u :: unrevealed)
       in
-      Storage.Seed.For_cycle.get c previous_cycle >>=? fun prev_seed ->
+      Storage.Seed.For_cycle.get c previous_cycle
+      >>=? fun prev_seed ->
       let seed = Seed_repr.deterministic_seed prev_seed in
-      fold_left_s combine (c, seed, []) levels >>=? fun (c, seed, unrevealed) ->
+      fold_left_s combine (c, seed, []) levels
-      Storage.Seed.For_cycle.init c cycle seed >>=? fun c ->
+      >>=? fun (c, seed, unrevealed) ->
-      return (c, unrevealed)
+      Storage.Seed.For_cycle.init c cycle seed
+      >>=? fun c -> return (c, unrevealed)
 
 let for_cycle ctxt cycle =
   let preserved = Constants_storage.preserved_cycles ctxt in
@@ -85,24 +103,28 @@ let for_cycle ctxt cycle =
   let latest =
     if Cycle_repr.(current_cycle = root) then
       Cycle_repr.add current_cycle (preserved + 1)
-    else
+    else Cycle_repr.add current_cycle preserved
-      Cycle_repr.add current_cycle preserved in
+  in
   let oldest =
     match Cycle_repr.sub current_cycle preserved with
-    | None -> Cycle_repr.root
+    | None ->
-    | Some oldest -> oldest in
+        Cycle_repr.root
-  fail_unless Cycle_repr.(oldest <= cycle && cycle <= latest)
+    | Some oldest ->
-    (Unknown { oldest ; cycle ; latest }) >>=? fun () ->
+        oldest
-  Storage.Seed.For_cycle.get ctxt cycle
+  in
+  fail_unless
+    Cycle_repr.(oldest <= cycle && cycle <= latest)
+    (Unknown {oldest; cycle; latest})
+  >>=? fun () -> Storage.Seed.For_cycle.get ctxt cycle
 
-let clear_cycle c cycle =
+let clear_cycle c cycle = Storage.Seed.For_cycle.delete c cycle
-  Storage.Seed.For_cycle.delete c cycle
 
 let init ctxt =
   let preserved = Constants_storage.preserved_cycles ctxt in
   List.fold_left2
     (fun ctxt c seed ->
-       ctxt >>=? fun ctxt ->
+      ctxt
+      >>=? fun ctxt ->
       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
       Storage.Seed.For_cycle.init ctxt cycle seed)
     (return ctxt)
@@ -111,14 +133,16 @@ let init ctxt =
 
 let cycle_end ctxt last_cycle =
   let preserved = Constants_storage.preserved_cycles ctxt in
-  begin
+  ( match Cycle_repr.sub last_cycle preserved with
-    match Cycle_repr.sub last_cycle preserved with
+  | None ->
-    | None -> return ctxt
+      return ctxt
   | Some cleared_cycle ->
-        clear_cycle ctxt cleared_cycle
+      clear_cycle ctxt cleared_cycle )
-  end >>=? fun ctxt ->
+  >>=? fun ctxt ->
   match Cycle_repr.pred last_cycle with
-  | None -> return (ctxt, [])
+  | None ->
-  | Some revealed -> (* cycle with revelations *)
+      return (ctxt, [])
+  | Some revealed ->
+      (* cycle with revelations *)
       let inited_seed_cycle = Cycle_repr.add last_cycle (preserved + 1) in
       compute_for_cycle ctxt ~revealed inited_seed_cycle