From e1a1e6a90835227e8ad333c06bb32fd8c852af5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Thomas=20P=C3=A9cseli?= Date: Mon, 25 Apr 2022 14:11:27 +0100 Subject: [PATCH] Intro exercise. The exercise is solved by adding two michelson instructions: one to get the value of the global counter, and one instruction to increment the value of the global counter. There is also a simple shell script to do a quick demo. --- intro-exercise.sh | 80 +++++++++++++++++++ .../lib_benchmarks_proto/interpreter_model.ml | 1 + .../interpreter_workload.ml | 11 +++ src/proto_alpha/lib_protocol/TEZOS_PROTOCOL | 2 + src/proto_alpha/lib_protocol/alpha_context.ml | 4 + .../lib_protocol/alpha_context.mli | 10 +++ .../lib_protocol/counter_storage.ml | 14 ++++ .../lib_protocol/counter_storage.mli | 19 +++++ src/proto_alpha/lib_protocol/dune.inc | 5 ++ .../lib_protocol/michelson_v1_gas.ml | 10 +++ .../lib_protocol/michelson_v1_gas.mli | 4 + .../lib_protocol/michelson_v1_primitives.ml | 13 ++- .../lib_protocol/michelson_v1_primitives.mli | 2 + .../lib_protocol/script_interpreter.ml | 11 +++ .../lib_protocol/script_interpreter_defs.ml | 2 + .../lib_protocol/script_ir_translator.ml | 10 +++ .../lib_protocol/script_typed_ir.ml | 15 ++++ .../lib_protocol/script_typed_ir.mli | 9 +++ .../lib_protocol/script_typed_ir_size.ml | 2 + src/proto_alpha/lib_protocol/storage.ml | 8 ++ src/proto_alpha/lib_protocol/storage.mli | 3 + 21 files changed, 233 insertions(+), 2 deletions(-) create mode 100755 intro-exercise.sh create mode 100644 src/proto_alpha/lib_protocol/counter_storage.ml create mode 100644 src/proto_alpha/lib_protocol/counter_storage.mli diff --git a/intro-exercise.sh b/intro-exercise.sh new file mode 100755 index 000000000000..749de156882f --- /dev/null +++ b/intro-exercise.sh @@ -0,0 +1,80 @@ +#!/bin/bash + +# This shell script defines some functions for quickly running a few contracts to +# demo the first results of the introduction exercise. Source it and run +# `intro_exercise_run` to see the action. Besides having a working dev setup for +# tezos, this script requires the `jq` command line app for some JSON queries. + +# Initialize the usual mockup client as explained in the developer docs +function create_mockup() { + ./tezos-client \ + --protocol ProtoALphaALphaALphaALphaALphaALphaALphaALphaDdp3zK \ + --base-dir /tmp/mockup \ + --mode mockup \ + create mockup + } + +# Quick alias for the functions below (also nicked from dev docs). +alias mockup-client='./tezos-client --mode mockup --base-dir /tmp/mockup' + +# 3 contracts. Each with a create_, call_, and inspect_ function. + +# contract_0 was the first contract I wrote to just count _something_. It doesn't use the new michelson instructions +function create_contract_0() { + mockup-client originate contract contract_0 transferring 100 from bootstrap1 running 'parameter unit;storage int;code {CDR ;PUSH int 1 ;ADD ;NIL operation ;PAIR}' --burn-cap 10 --init 0 + export CONTRACT0=$(cat /tmp/mockup/contracts|jq -r '.[]|select(.name=="contract_0")|.value') +} + +function call_contract_0() { + mockup-client transfer 0 from bootstrap1 to contract_0 +} + +function inspect_contract_0() { + mockup-client rpc get /chains/main/blocks/head/context/contracts/$CONTRACT0/storage +} + +# contract_1 uses the COUNTER instruction to get the current value of the global counter. When run, this contract will put the current value in its storage +function create_contract_1() { + mockup-client originate contract contract_1 transferring 100 from bootstrap1 running 'parameter unit;storage nat;code {CDR ;DROP ;COUNTER ;NIL operation ;PAIR}' --burn-cap 10 --init 0 + export CONTRACT1=$(cat /tmp/mockup/contracts|jq -r '.[]|select(.name=="contract_1")|.value') +} + +function call_contract_1() { + mockup-client transfer 0 from bootstrap1 to contract_1 +} + +function inspect_contract_1() { + mockup-client rpc get /chains/main/blocks/head/context/contracts/$CONTRACT1/storage +} + +# contract_2 increments the value of the global counter. It doesn't store anything. Use it together with contract_1 above. +function create_contract_2() { + mockup-client originate contract contract_2 transferring 100 from bootstrap1 running 'parameter unit; storage unit;code {CDR ;INCREMENT ;NIL operation; PAIR}' --burn-cap 10 + export CONTRACT2=$(cat /tmp/mockup/contracts|jq -r '.[]|select(.name=="contract_2")|.value') +} + +function call_contract_2() { + mockup-client transfer 0 from bootstrap1 to contract_2 +} + +function inspect_contract_2() { + mockup-client rpc get /chains/main/blocks/head/context/contracts/$CONTRACT2/storage +} + +# Quickly create and run contract_1 and _2 above - if starting from scratch, the final result should be `3` (in the storage of contract_1). +function intro_exercise_run() { + create_mockup + create_contract_1 + create_contract_2 + + call_contract_1 + + call_contract_2 + call_contract_2 + call_contract_2 + + call_contract_1 + + inspect_contract_1 +} + diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml index 4754e9766a3c..d6a25ffd9b6d 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_model.ml @@ -364,6 +364,7 @@ let ir_model ?specialization instr_or_cont = match instr_or_cont with | Instr_name instr -> ( match instr with + | N_ICounter | N_IIncrement | N_IDrop | N_IDup | N_ISwap | N_IConst | N_ICons_pair | N_ICar | N_ICdr | N_ICons_some | N_ICons_none | N_IIf_none | N_IOpt_map | N_ILeft | N_IRight | N_IIf_left | N_ICons_list | N_INil | N_IIf_cons diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml index 52a91b76e7d9..6fbe85792c33 100644 --- a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml +++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml @@ -39,6 +39,9 @@ let equal_id = String.equal encountered during evaluation. *) type instruction_name = + (* intro exercise *) + | N_ICounter + | N_IIncrement (* stack ops *) | N_IDrop | N_IDup @@ -250,6 +253,8 @@ and instr_or_cont_name = let string_of_instruction_name : instruction_name -> string = fun ir -> match ir with + | N_ICounter -> "N_ICounter" + | N_IIncrement -> "N_IIncrement" | N_IDrop -> "N_IDrop" | N_IDup -> "N_IDup" | N_ISwap -> "N_ISwap" @@ -708,6 +713,10 @@ let encoding = (* ------------------------------------------------------------------------- *) module Instructions = struct + let counter = ir_sized_step N_ICounter nullary + + let increment = ir_sized_step N_IIncrement nullary + let drop = ir_sized_step N_IDrop nullary let dup = ir_sized_step N_IDup nullary @@ -1150,6 +1159,8 @@ let extract_ir_sized_step : fun ctxt instr stack -> let open Script_typed_ir in match (instr, stack) with + | (ICounter (_, _), _) -> Instructions.counter + | (IIncrement (_, _), _) -> Instructions.increment | (IDrop (_, _), _) -> Instructions.drop | (IDup (_, _), _) -> Instructions.dup | (ISwap (_, _), _) -> Instructions.swap diff --git a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL index de2fcb055bad..23fa7633186b 100644 --- a/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL +++ b/src/proto_alpha/lib_protocol/TEZOS_PROTOCOL @@ -130,6 +130,8 @@ "Tx_rollup_storage", "Sc_rollup_storage", + "Counter_storage", + "Alpha_context", "Script_string", "Script_int", diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml index bc04e36c363a..00fbb7d45b69 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.ml +++ b/src/proto_alpha/lib_protocol/alpha_context.ml @@ -521,3 +521,7 @@ module Cache = Cache_repr module Internal_for_tests = struct let to_raw x = x end + +module Global_counter = struct + include Counter_storage +end diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli index 51b05993ce52..f4642f82bbb1 100644 --- a/src/proto_alpha/lib_protocol/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/alpha_context.mli @@ -509,6 +509,7 @@ module Script : sig | I_COMPARE | I_CONCAT | I_CONS + | I_COUNTER | I_CREATE_ACCOUNT | I_CREATE_CONTRACT | I_IMPLICIT_ACCOUNT @@ -533,6 +534,7 @@ module Script : sig | I_IF_CONS | I_IF_LEFT | I_IF_NONE + | I_INCREMENT | I_INT | I_LAMBDA | I_LE @@ -3522,3 +3524,11 @@ module Fees : sig val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult end + +module Global_counter : sig + val get_counter : + context -> (Z.t * context) tzresult Lwt.t + + val increment_counter : + context -> context tzresult Lwt.t +end diff --git a/src/proto_alpha/lib_protocol/counter_storage.ml b/src/proto_alpha/lib_protocol/counter_storage.ml new file mode 100644 index 000000000000..73d8aee0a84a --- /dev/null +++ b/src/proto_alpha/lib_protocol/counter_storage.ml @@ -0,0 +1,14 @@ +(* intro exercise *) + +let get_counter ctxt = + Storage.Global_counter.find ctxt >>=? fun x -> + match x with + | None -> Storage.Global_counter.init ctxt Z.zero >>=? fun t -> return (Z.zero, t) + | Some v -> return (v, ctxt) + +let increment_counter ctxt = + Storage.Global_counter.find ctxt >>=? fun x -> + match x with + | None -> Storage.Global_counter.init ctxt Z.one + | Some v -> Storage.Global_counter.update ctxt (Z.succ v) + diff --git a/src/proto_alpha/lib_protocol/counter_storage.mli b/src/proto_alpha/lib_protocol/counter_storage.mli new file mode 100644 index 000000000000..20e0c0b2316f --- /dev/null +++ b/src/proto_alpha/lib_protocol/counter_storage.mli @@ -0,0 +1,19 @@ +(* intro exercise *) + +(** [get_counter ctxt] get the value of the global counter. + * If counter doesn't exist in context, then we initialize it to zero + *) + +val get_counter : + Raw_context.t -> + (Z.t * Raw_context.t) tzresult Lwt.t + +(** [increment_counter ctxt] increment the value of the global counter. + * If counter doesn't exist, then we initialize it to one (we assume + * that if the counter hasn't been initialized yet, then it is zero). + *) +val increment_counter : + Raw_context.t -> + Raw_context.t tzresult Lwt.t + + diff --git a/src/proto_alpha/lib_protocol/dune.inc b/src/proto_alpha/lib_protocol/dune.inc index cd2d02f73809..d94d2a11ca80 100644 --- a/src/proto_alpha/lib_protocol/dune.inc +++ b/src/proto_alpha/lib_protocol/dune.inc @@ -147,6 +147,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end tx_rollup_commitment_storage.mli tx_rollup_commitment_storage.ml tx_rollup_storage.mli tx_rollup_storage.ml sc_rollup_storage.mli sc_rollup_storage.ml + counter_storage.mli counter_storage.ml alpha_context.mli alpha_context.ml script_string.mli script_string.ml script_int.mli script_int.ml @@ -334,6 +335,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end tx_rollup_commitment_storage.mli tx_rollup_commitment_storage.ml tx_rollup_storage.mli tx_rollup_storage.ml sc_rollup_storage.mli sc_rollup_storage.ml + counter_storage.mli counter_storage.ml alpha_context.mli alpha_context.ml script_string.mli script_string.ml script_int.mli script_int.ml @@ -521,6 +523,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end tx_rollup_commitment_storage.mli tx_rollup_commitment_storage.ml tx_rollup_storage.mli tx_rollup_storage.ml sc_rollup_storage.mli sc_rollup_storage.ml + counter_storage.mli counter_storage.ml alpha_context.mli alpha_context.ml script_string.mli script_string.ml script_int.mli script_int.ml @@ -730,6 +733,7 @@ include Tezos_raw_protocol_alpha.Main Tx_rollup_commitment_storage Tx_rollup_storage Sc_rollup_storage + Counter_storage Alpha_context Script_string Script_int @@ -958,6 +962,7 @@ include Tezos_raw_protocol_alpha.Main tx_rollup_commitment_storage.mli tx_rollup_commitment_storage.ml tx_rollup_storage.mli tx_rollup_storage.ml sc_rollup_storage.mli sc_rollup_storage.ml + counter_storage.mli counter_storage.ml alpha_context.mli alpha_context.ml script_string.mli script_string.ml script_int.mli script_int.ml diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml index 19246cde04bb..53ebc64a013e 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.ml @@ -249,6 +249,12 @@ module Cost_of = struct (* model N_IView *) let cost_N_IView = S.safe_int 1460 + (* model N_ICounter - intro exercise *) + let cost_N_ICounter = S.safe_int 10 + + (* model N_IIncrement - intro exercise *) + let cost_N_IIncrement = S.safe_int 10 + (* model N_IDrop *) let cost_N_IDrop = S.safe_int 10 @@ -965,6 +971,10 @@ module Cost_of = struct module Interpreter = struct open Generated_costs + let counter = atomic_step_cost cost_N_ICounter + + let increment = atomic_step_cost cost_N_IIncrement + let drop = atomic_step_cost cost_N_IDrop let dup = atomic_step_cost cost_N_IDup diff --git a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli index 0b78e30f162d..0976dd06699b 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_gas.mli @@ -30,6 +30,10 @@ module Cost_of : sig val manager_operation : Gas.cost module Interpreter : sig + val counter : Gas.cost + + val increment : Gas.cost + val drop : Gas.cost val dup : Gas.cost diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml index b85b7ea06598..395143635c92 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.ml @@ -65,6 +65,7 @@ type prim = | I_COMPARE | I_CONCAT | I_CONS + | I_COUNTER | I_CREATE_ACCOUNT | I_CREATE_CONTRACT | I_IMPLICIT_ACCOUNT @@ -89,6 +90,7 @@ type prim = | I_IF_CONS | I_IF_LEFT | I_IF_NONE + | I_INCREMENT | I_INT | I_LAMBDA | I_LE @@ -203,11 +205,11 @@ let namespace = function Constant_namespace | I_ABS | I_ADD | I_ADDRESS | I_AMOUNT | I_AND | I_APPLY | I_BALANCE | I_BLAKE2B | I_CAR | I_CAST | I_CDR | I_CHAIN_ID | I_CHECK_SIGNATURE - | I_COMPARE | I_CONCAT | I_CONS | I_CONTRACT | I_CREATE_ACCOUNT + | I_COMPARE | I_CONCAT | I_CONS | I_CONTRACT | I_COUNTER | I_CREATE_ACCOUNT | I_CREATE_CONTRACT | I_DIG | I_DIP | I_DROP | I_DUG | I_DUP | I_VIEW | I_EDIV | I_EMPTY_BIG_MAP | I_EMPTY_MAP | I_EMPTY_SET | I_EQ | I_EXEC | I_FAILWITH | I_GE | I_GET | I_GET_AND_UPDATE | I_GT | I_HASH_KEY | I_IF | I_IF_CONS - | I_IF_LEFT | I_IF_NONE | I_IMPLICIT_ACCOUNT | I_INT | I_ISNAT | I_ITER + | I_IF_LEFT | I_IF_NONE | I_IMPLICIT_ACCOUNT | I_INCREMENT | I_INT | I_ISNAT | I_ITER | I_JOIN_TICKETS | I_KECCAK | I_LAMBDA | I_LE | I_LEFT | I_LEVEL | I_LOOP | I_LOOP_LEFT | I_LSL | I_LSR | I_LT | I_MAP | I_MEM | I_MUL | I_NEG | I_NEQ | I_NEVER | I_NIL | I_NONE | I_NOT | I_NOW | I_MIN_BLOCK_TIME | I_OR | I_PACK @@ -272,6 +274,7 @@ let string_of_prim = function | I_COMPARE -> "COMPARE" | I_CONCAT -> "CONCAT" | I_CONS -> "CONS" + | I_COUNTER -> "COUNTER" | I_CREATE_ACCOUNT -> "CREATE_ACCOUNT" | I_CREATE_CONTRACT -> "CREATE_CONTRACT" | I_IMPLICIT_ACCOUNT -> "IMPLICIT_ACCOUNT" @@ -295,6 +298,7 @@ let string_of_prim = function | I_IF_CONS -> "IF_CONS" | I_IF_LEFT -> "IF_LEFT" | I_IF_NONE -> "IF_NONE" + | I_INCREMENT -> "INCREMENT" | I_INT -> "INT" | I_LAMBDA -> "LAMBDA" | I_LE -> "LE" @@ -425,6 +429,7 @@ let prim_of_string = function | "COMPARE" -> ok I_COMPARE | "CONCAT" -> ok I_CONCAT | "CONS" -> ok I_CONS + | "COUNTER" -> ok I_COUNTER | "CREATE_ACCOUNT" -> ok I_CREATE_ACCOUNT | "CREATE_CONTRACT" -> ok I_CREATE_CONTRACT | "IMPLICIT_ACCOUNT" -> ok I_IMPLICIT_ACCOUNT @@ -449,6 +454,7 @@ let prim_of_string = function | "IF_CONS" -> ok I_IF_CONS | "IF_LEFT" -> ok I_IF_LEFT | "IF_NONE" -> ok I_IF_NONE + | "INCREMENT" -> ok I_INCREMENT | "INT" -> ok I_INT | "KECCAK" -> ok I_KECCAK | "LAMBDA" -> ok I_LAMBDA @@ -761,6 +767,9 @@ let prim_encoding = ("tx_rollup_l2_address", T_tx_rollup_l2_address); ("MIN_BLOCK_TIME", I_MIN_BLOCK_TIME); ("sapling_transaction", T_sapling_transaction); + (* intro exercise instructions *) + ("COUNTER", I_COUNTER); + ("INCREMENT", I_INCREMENT); (* New instructions must be added here, for backward compatibility of the encoding. *) (* Keep the comment above at the end of the list *) ] diff --git a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli index 45f7ae7b0f94..08f19a190dac 100644 --- a/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/michelson_v1_primitives.mli @@ -78,6 +78,7 @@ type prim = | I_COMPARE | I_CONCAT | I_CONS + | I_COUNTER | I_CREATE_ACCOUNT | I_CREATE_CONTRACT | I_IMPLICIT_ACCOUNT @@ -102,6 +103,7 @@ type prim = | I_IF_CONS | I_IF_LEFT | I_IF_NONE + | I_INCREMENT | I_INT | I_LAMBDA | I_LE diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml index dbe35717b19c..7ae0081a8816 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml @@ -480,6 +480,17 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type = | ILog (_, event, logger, k) -> (log [@ocaml.tailcall]) (logger, event) g gas k ks accu stack | IHalt _ -> (next [@ocaml.tailcall]) g gas ks accu stack + (* intro exercise ops *) + | ICounter (_, k) -> + let ctxt = update_context gas ctxt in + Alpha_context.Global_counter.get_counter ctxt >>=? fun (v, ctxt) -> + let (gas, ctxt) = local_gas_counter_and_outdated_context ctxt in + (step [@ocaml.tailcall]) (ctxt, sc) gas k ks (Script_int.(abs (of_int (Z.to_int v)))) (accu, stack) (* possible overflow *) + | IIncrement (_, k) -> + let ctxt = update_context gas ctxt in + Alpha_context.Global_counter.increment_counter ctxt >>=? fun ctxt -> + let (gas, ctxt) = local_gas_counter_and_outdated_context ctxt in + (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack (* stack ops *) | IDrop (_, k) -> let (accu, stack) = stack in diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml index 5f583d671aa8..11603cb887f8 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml @@ -229,6 +229,8 @@ let cost_of_instr : type a s r f. (a, s, r, f) kinstr -> a -> s -> Gas.cost = let (ticket_a, ticket_b) = accu in Interp_costs.join_tickets ty ticket_a ticket_b | IHalt _ -> Interp_costs.halt + | ICounter _ -> Interp_costs.counter + | IIncrement _ -> Interp_costs.increment | IDrop _ -> Interp_costs.drop | IDup _ -> Interp_costs.dup | ISwap _ -> Interp_costs.swap diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml index 6fe18495b508..8aba0882a2c7 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml @@ -3065,6 +3065,16 @@ and[@coq_axiom_with_reason "gadt"] parse_instr : stack_ty in match (script_instr, stack_ty) with + (* intro exercise ops *) + | (Prim (loc, I_COUNTER, [], annot), stack) -> + check_var_annot loc annot >>?= fun () -> + let instr = {apply = (fun kinfo k -> ICounter (kinfo, k))} in + typed ctxt loc instr (Item_t (nat_t, stack)) + | (Prim (loc, I_INCREMENT, [], annot), whole_stack) -> + check_var_annot loc annot >>?= fun () -> + let instr = {apply = (fun kinfo k -> IIncrement (kinfo, k))} in + let stack = whole_stack in + typed ctxt loc instr stack (* stack ops *) | (Prim (loc, I_DROP, [], annot), Item_t (_, rest)) -> (error_unexpected_annot loc annot >>?= fun () -> diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml index e934766c2e32..26884a80dc43 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml @@ -468,6 +468,15 @@ type ('arg, 'storage) script = (* ---- Instructions --------------------------------------------------------*) and ('before_top, 'before, 'result_top, 'result) kinstr = + (* + Intro exercise + *) + | ICounter : + ('a, 's) kinfo * (n num, 'a * 's, 'r, 'f) kinstr + -> ('a, 's, 'r, 'f) kinstr + | IIncrement : + ('a, 's) kinfo * ('a, 's, 'r, 'f) kinstr + -> ('a, 's, 'r, 'f) kinstr (* Stack ----- @@ -1413,6 +1422,8 @@ let manager_kind : type kind. kind manager_operation -> kind Kind.manager = let kinfo_of_kinstr : type a s b f. (a, s, b, f) kinstr -> (a, s) kinfo = fun i -> match i with + | ICounter (kinfo, _) -> kinfo + | IIncrement (kinfo, _) -> kinfo | IDrop (kinfo, _) -> kinfo | IDup (kinfo, _) -> kinfo | ISwap (kinfo, _) -> kinfo @@ -1579,6 +1590,8 @@ let kinstr_rewritek : = fun i f -> match i with + | ICounter (kinfo, k) -> ICounter (kinfo, f.apply k) + | IIncrement (kinfo, k) -> IIncrement (kinfo, f.apply k) | IDrop (kinfo, k) -> IDrop (kinfo, f.apply k) | IDup (kinfo, k) -> IDup (kinfo, f.apply k) | ISwap (kinfo, k) -> ISwap (kinfo, f.apply k) @@ -2044,6 +2057,8 @@ let kinstr_traverse i init f = in let return () = (continue [@ocaml.tailcall]) accu in match t with + | ICounter (_, k) -> (next [@ocaml.tailcall]) k + | IIncrement (_, k) -> (next [@ocaml.tailcall]) k | IDrop (_, k) -> (next [@ocaml.tailcall]) k | IDup (_, k) -> (next [@ocaml.tailcall]) k | ISwap (_, k) -> (next [@ocaml.tailcall]) k diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli index a1ea5b52702a..05b1fe0c7e7d 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir.mli +++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli @@ -425,6 +425,15 @@ type ('arg, 'storage) script = *) and ('before_top, 'before, 'result_top, 'result) kinstr = + (* Introduction exercise + --------------------- + *) + | ICounter : + ('a, 's) kinfo * (n num, 'a * 's, 'r, 'f) kinstr + -> ('a, 's, 'r, 'f) kinstr + | IIncrement : + ('a, 's) kinfo * ('a, 's, 'r, 'f) kinstr + -> ('a, 's, 'r, 'f) kinstr (* Stack ----- diff --git a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml index 85d50f7b2e39..c52c0cd8db48 100644 --- a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml +++ b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml @@ -345,6 +345,8 @@ and kinstr_size : type a s r f. nodes_and_size -> (a, s, r, f) kinstr -> nodes_and_size = fun accu t -> match t with + | ICounter (kinfo, _) -> ret_succ_adding accu (base kinfo) + | IIncrement (kinfo, _) -> ret_succ_adding accu (base kinfo) | IDrop (kinfo, _) -> ret_succ_adding accu (base kinfo) | IDup (kinfo, _) -> ret_succ_adding accu (base kinfo) | ISwap (kinfo, _) -> ret_succ_adding accu (base kinfo) diff --git a/src/proto_alpha/lib_protocol/storage.ml b/src/proto_alpha/lib_protocol/storage.ml index eaadc897f2ff..79c9b9711438 100644 --- a/src/proto_alpha/lib_protocol/storage.ml +++ b/src/proto_alpha/lib_protocol/storage.ml @@ -1618,3 +1618,11 @@ module Sc_rollup = struct let encoding = Raw_level_repr.encoding end) end + +(* intro exercise - not to confuse with the Global_counter in contract *) +module Global_counter : Single_data_storage with type value = Z.t and type t := Raw_context.t = + Make_single_data_storage (Registered) (Raw_context) + (struct + let name = ["global_counter"] + end) + (Encoding.Z) diff --git a/src/proto_alpha/lib_protocol/storage.mli b/src/proto_alpha/lib_protocol/storage.mli index cbe4e8a3f6ce..77355176ee31 100644 --- a/src/proto_alpha/lib_protocol/storage.mli +++ b/src/proto_alpha/lib_protocol/storage.mli @@ -775,3 +775,6 @@ module Sc_rollup : sig and type value = Raw_level_repr.t and type t = Raw_context.t * Sc_rollup_repr.t end + +module Global_counter : Single_data_storage with type value = Z.t and type t := Raw_context.t + -- GitLab