diff --git a/intro-exercise.sh b/intro-exercise.sh new file mode 100755 index 0000000000000000000000000000000000000000..749de156882f074d298ed7b97d689d795eb39080 --- /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 4754e9766a3cdb166181ed6a38a3a838b413d3f5..d6a25ffd9b6dfe285e42b7c99f8dea97af01c06f 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 52a91b76e7d9a4e38cfd947ca232c578c0e89590..6fbe85792c339bac7b0f9231ec8c3968f6d9703e 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 de2fcb055bad03e1f0c51cdd2a2d9aa72d18877b..23fa7633186bf1eed1a681572a5a9990189a32bf 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 bc04e36c363adcc97104fabfa858dc901a47afb6..00fbb7d45b69331bc010d2f03f77951e2dab9acd 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 51b05993ce52365bb2c6b5d4cd42ebcc4a5c2f30..f4642f82bbb128ddea6308768d536fcdaf7bffec 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 0000000000000000000000000000000000000000..73d8aee0a84a4d51af5101f156b00c85a8d076a6 --- /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 0000000000000000000000000000000000000000..20e0c0b2316fde0443ce05f3bcae0a1f78f4fbf5 --- /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 cd2d02f738092ea2c0ce706c3df42531dcd8e9e8..d94d2a11ca80c4f4458288edf3172c00038bcbde 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 19246cde04bb62c7f4c270a8639d52f5636b8aba..53ebc64a013ed836fe0c0e2d7db6a4514cb8a34c 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 0b78e30f162d641d18f51225026f42eea0f8fba2..0976dd06699bc01e1f552a2159a78020c8ca5abc 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 b85b7ea0659862586bbb449fe8ab59c2294bb02c..395143635c92259a96f820de4857f58f2d4e4b42 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 45f7ae7b0f94400061f5845fa4941236f77b1361..08f19a190dac25baa324c0bdb1341423f45ba49f 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 dbe35717b19c6d310c1cd9d7bb5497896ffb95b8..7ae0081a8816197fde12f6c26b45cca391d38ce6 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 5f583d671aa8cd1264da030de49f4982abf1c858..11603cb887f88eba02031c7ac1765f7a106acc0e 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 6fe18495b5081e27b2192f6d25b7ffb80e1101f4..8aba0882a2c7b5c7590fcc3fb858efcc10beb5a9 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 e934766c2e328064457c5ad4f94098d1a288b6e8..26884a80dc43432da98bf54f6a4eec6122ae182a 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 a1ea5b52702ae8c9ca422eabd60db18b5f86d21a..05b1fe0c7e7d805ad6892d18e2d55aee9d36b400 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 85d50f7b2e3992ea792ad6da032bc24493f6ae57..c52c0cd8db485d6da3358528f307c327384342e6 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 eaadc897f2ff08939b66ad3935a6cfd3414971d0..79c9b9711438e68f50eb6b58c01952024c9aedeb 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 cbe4e8a3f6cec67a5bca2df02712e1a06df8aa7f..77355176ee3155652e5fe649f0e13a74d209500f 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 +