Commit e1abd0d2 authored by Jakob Botsch Nielsen's avatar Jakob Botsch Nielsen

Clean up some Oak stuff

parent 8aa41abe
Pipeline #12076 failed with stage
in 6 minutes and 50 seconds
......@@ -24,36 +24,17 @@ Class ChainBaseTypes :=
Address : Type;
address_eqb : Address -> Address -> bool;
address_eqb_spec : forall (a b : Address), Bool.reflect (a = b) (address_eqb a b);
address_encode : Address -> positive;
address_decode : positive -> option Address;
address_decode_encode : forall a, address_decode (address_encode a) = Some a;
address_ote : OakTypeEquivalence Address;
address_eqdec :> stdpp.base.EqDecision Address;
address_countable :> countable.Countable Address;
address_ote :> OakTypeEquivalence Address;
compute_block_reward : nat -> Amount;
}.
Global Opaque Address address_eqb address_eqb_spec
address_encode address_decode address_decode_encode
address_eqdec address_countable
address_ote
compute_block_reward.
Module Address.
Global Instance Address_equivalence `{ChainBaseTypes} : OakTypeEquivalence Address :=
address_ote.
(* Allow stdpp to pick up instances to allow use of Address in maps *)
Import countable.
Global Instance Address_eq_dec `{ChainBaseTypes} : EqDecision Address.
Proof.
intros a b.
apply (reflect_dec (a = b) (address_eqb a b) (address_eqb_spec a b)).
Qed.
Global Instance Address_countable `{ChainBaseTypes} : Countable Address :=
{ encode := address_encode;
decode := address_decode;
decode_encode := address_decode_encode; }.
End Address.
Delimit Scope address_scope with address.
Bind Scope address_scope with Address.
Infix "=?" := address_eqb (at level 70) : address_scope.
......@@ -358,7 +339,6 @@ Record ContractInterface {setup_ty msg_ty state_ty : Type} :=
}.
Arguments ContractInterface _ _ _ : clear implicits.
Arguments build_contract_interface {_ _ _}.
Definition get_contract_interface
(chain : Chain)
......@@ -757,3 +737,4 @@ Arguments init {_ _ _ _ _ _ _}.
Arguments receive {_ _ _ _ _ _ _}.
Arguments build_contract {_ _ _ _ _ _ _}.
Arguments ContractInterface {_} _ _ _.
Arguments build_contract_interface {_ _ _ _}.
......@@ -6,13 +6,14 @@ From SmartContracts Require Import Automation.
From Coq Require Import Eqdep_dec.
From Coq Require Import List.
From Coq Require Import Psatz.
From Coq Require Import JMeq.
From stdpp Require countable.
Import ListNotations.
Local Open Scope N.
Inductive BoundedN (bound : N) :=
| bounded (n : N) (_ : n < bound) : BoundedN bound.
| bounded (n : N) (_ : (bound ?= n) = Gt).
Arguments bounded {_}.
......@@ -23,32 +24,17 @@ Module BoundedN.
Definition eqb {bound : N} (a b : BoundedN bound) : bool :=
N.eqb (to_N a) (to_N b).
Definition eq_dec {bound : N} (a b : BoundedN bound) :
{a = b} + {a <> b}.
Proof.
destruct a as [a alt], b as [b blt].
destruct (N.eq_dec a b).
- left. subst. f_equal.
apply UIP_dec.
decide equality.
- right.
intros H.
inversion H.
contradiction.
Defined.
Local Lemma N_lt_dec (a b : N) : {a < b} + {~(a < b)}.
Proof. unfold "<". decide equality. Defined.
Local Lemma Z_lt_dec (a b : Z) : ({a < b} + {~(a < b)})%Z.
Proof. unfold "<"%Z. decide equality. Defined.
Definition of_N {bound : N} (n : N) : option (BoundedN bound).
Proof.
destruct (N_lt_dec n bound).
- exact (Some (bounded n l)).
- exact None.
Defined.
Definition of_N_compare {bound : N} (n : N) : option ((bound ?= n) = Gt) :=
match bound ?= n as comp return (option (comp = Gt)) with
| Gt => Some eq_refl
| _ => None
end.
Definition of_N {bound : N} (n : N) : option (BoundedN bound) :=
match of_N_compare n with
| Some prf => Some (bounded n prf)
| None => None
end.
Definition to_nat {bound : N} (n : BoundedN bound) : nat :=
N.to_nat (to_N n).
......@@ -122,12 +108,11 @@ Module BoundedN.
Lemma of_to_N {bound : N} (n : BoundedN bound) :
of_N (to_N n) = Some n.
Proof.
destruct n as [n lt]; simpl.
destruct n as [n prf]; simpl.
unfold of_N.
destruct (N_lt_dec n bound).
- f_equal.
now apply to_N_inj.
- tauto.
replace (of_N_compare n) with (Some prf); auto.
unfold of_N_compare.
now rewrite prf.
Qed.
Lemma of_to_nat {bound : N} (n : BoundedN bound) :
......@@ -161,17 +146,18 @@ Module BoundedN.
Proof.
intros H.
unfold of_N in H.
destruct (N_lt_dec m bound); prove.
destruct (of_N_compare m); try congruence.
now inversion H.
Qed.
Lemma of_N_none {bound : N} {m : N} :
@of_N bound m = None -> m >= bound.
@of_N bound m = None -> bound <= m.
Proof.
intros H.
unfold of_N in H.
destruct (N_lt_dec m bound).
- inversion H.
- assumption.
destruct (of_N_compare m) eqn:comp; try congruence.
unfold of_N_compare in comp.
destruct (bound ?= m) eqn:comp'; congruence.
Qed.
Lemma of_nat_some {bound : N} {m : nat} {n : BoundedN bound} :
......@@ -184,7 +170,7 @@ Module BoundedN.
Qed.
Lemma of_nat_none {bound : N} {m : nat} :
@of_nat bound m = None -> N.of_nat m >= bound.
@of_nat bound m = None -> bound <= N.of_nat m.
Proof. apply of_N_none. Qed.
Lemma in_map_of_nat (bound : N) (n : BoundedN bound) (xs : list nat) :
......@@ -213,22 +199,34 @@ Module BoundedN.
Module Stdpp.
Import countable.
Lemma eq_dec {bound : N} : EqDecision (BoundedN bound).
Proof.
intros x y.
destruct (BoundedN.eqb_spec x y); [left|right]; assumption.
Qed.
Global Instance BoundedNEqDec {bound : N} : EqDecision (BoundedN bound) :=
eq_dec.
Global Instance BoundedNCountable {bound : N} : Countable (BoundedN bound).
Definition encode_bounded {bound : N} (n : BoundedN bound) : positive :=
encode (to_N n).
Definition decode_bounded {bound : N} (n : positive) : option (BoundedN bound) :=
decode n >>= of_N.
Lemma decode_encode_bounded {bound : N} (n : BoundedN bound) :
decode_bounded (encode_bounded n) = Some n.
Proof.
refine {| encode n := encode (to_N n);
decode n := of_N =<< decode n; |}.
intros [x lt].
unfold decode_bounded, encode_bounded.
rewrite decode_encode.
simpl.
unfold of_N.
destruct (BoundedN.N_lt_dec x bound).
- assert (lt = l) by (apply UIP_dec; decide equality).
congruence.
- tauto.
Defined.
apply of_to_N.
Qed.
Global Instance BoundedNCountable {bound : N} : Countable (BoundedN bound) :=
{| encode := encode_bounded;
decode := decode_bounded;
decode_encode := decode_encode_bounded; |}.
End Stdpp.
Global Instance BoundedN_finite {bound : N} : Finite (BoundedN bound) :=
......@@ -261,7 +259,8 @@ Module BoundedN.
unfold to_nat.
destruct t as [t lt].
simpl.
split; auto with *.
change ((bound ?= t) = Gt) with (bound > t) in lt.
lia.
Qed.
End BoundedN.
......
From Coq Require Import ProofIrrelevance.
From Coq Require Import List.
From Coq Require Import ZArith.
From stdpp Require gmap.
From Coq Require Import List.
From SmartContracts Require Import Monads.
From SmartContracts Require Import BoundedN.
Import ListNotations.
Notation FMap := gmap.gmap.
......
......@@ -23,12 +23,11 @@ Global Instance LocalChainBaseTypes : ChainBaseTypes :=
{| Address := BoundedN AddrSize;
address_eqb := BoundedN.eqb;
address_eqb_spec := BoundedN.eqb_spec;
address_encode := countable.encode;
address_decode := countable.decode;
address_decode_encode := countable.decode_encode;
compute_block_reward n := 50%Z;
|}.
Compute LocalChainBaseTypes.
Record LocalChain :=
build_local_chain {
lc_header : BlockHeader;
......
......@@ -85,13 +85,33 @@ Section LocalBlockchainTests.
Compute (account_balance chain4 baker).
Compute (account_balance chain4 congress_1).
(*
Definition congress_ifc : ContractInterface Congress.Setup Congress.Msg Congress.State :=
unpack_option
(get_contract_interface chain4 congress_1 Congress.Setup Congress.Msg Congress.State).
Definition congress_ifc
: ContractInterface Congress.Setup Congress.Msg Congress.State :=
match get_contract_interface
chain4 congress_1
Congress.Setup Congress.Msg Congress.State with
| Some x => x
(* Using unpack_option here is extremely slow *)
| None =>
build_contract_interface
baker
0
setup
(fun c => None)
(fun a => deploy_congress)
(fun a m => deploy_congress)
end.
Definition congress_state chain :=
unpack_option (congress_ifc.(get_state) chain).
Definition congress_state chain : Congress.State :=
match congress_ifc.(get_state) chain with
| Some s => s
(* And also here *)
| None => {| owner := baker;
state_rules := setup_rules;
proposals := FMap.empty;
next_proposal_id := 0;
members := FMap.empty |}
end.
Compute (congress_ifc.(get_state) chain4).
Compute (FMap.elements (congress_state chain4).(members)).
......@@ -107,7 +127,7 @@ Section LocalBlockchainTests.
[build_act person_1 (add_person person_1); build_act person_1 (add_person person_2)]
5 0).
Eval cbn in (FMap.elements (congress_state chain5).(members)).
Compute (FMap.elements (congress_state chain5).(members)).
Compute (account_balance chain5 congress_1).
(* person_1 creates a proposal to send 3 coins to person_3 using funds
......@@ -129,8 +149,11 @@ Section LocalBlockchainTests.
congress_ifc.(call) 0 (vote_for_proposal 1).
Definition chain7 : ChainBuilder :=
unpack_option
(chain6.(add_block) baker [(person_1, vote_proposal); (person_2, vote_proposal)]).
unpack_option (
chain6.(builder_add_block)
baker
[build_act person_1 vote_proposal; build_act person_2 vote_proposal]
7 0).
Compute (FMap.elements (congress_state chain7).(proposals)).
......@@ -139,7 +162,11 @@ Section LocalBlockchainTests.
congress_ifc.(call) 0 (finish_proposal 1).
Definition chain8 : ChainBuilder :=
unpack_option (chain7.(add_block) baker [(person_3, finish_proposal)]).
unpack_option (
chain7.(builder_add_block)
baker
[build_act person_3 finish_proposal]
8 0).
Compute (FMap.elements (congress_state chain8).(proposals)).
(* Balances before: *)
......@@ -149,5 +176,4 @@ Section LocalBlockchainTests.
Compute (account_balance chain8 congress_1).
Compute (account_balance chain8 person_3).
Print Assumptions chain8.
*)
End LocalBlockchainTests.
......@@ -4,6 +4,7 @@ From SmartContracts Require Import Containers.
From SmartContracts Require Import Automation.
From SmartContracts Require Import BoundedN.
From Coq Require Import List.
From Coq Require Import String.
Import ListNotations.
......@@ -18,15 +19,20 @@ Inductive OakType :=
| oak_set : OakType -> OakType
| oak_map : OakType -> OakType -> OakType.
Definition eq_oak_type_dec (t1 t2 : OakType) : {t1 = t2} + {t1 <> t2}.
Proof. decide equality. Defined.
Module OakType.
Scheme Equality for OakType.
Definition eqb := OakType_beq.
Definition eq_dec := OakType_eq_dec.
Proposition eq_oak_type_dec_refl (x : OakType) :
eq_oak_type_dec x x = left eq_refl.
Proof.
induction x;
try simpl; try rewrite IHx; try rewrite IHx1; try rewrite IHx2; reflexivity.
Qed.
Fixpoint eqb_spec (a b : OakType) :
Bool.reflect (a = b) (eqb a b).
Proof.
destruct a, b; simpl in *; try (left; congruence); try (right; congruence).
1, 2, 5: destruct (eqb_spec a1 b1), (eqb_spec a2 b2);
try (left; congruence); try (right; congruence).
1, 2: destruct (eqb_spec a b); try (left; congruence); try (right; congruence).
Qed.
End OakType.
Set Primitive Projections.
Record OakInterpretation :=
......@@ -76,11 +82,13 @@ Record OakValue :=
Definition extract_oak_value (t : OakType) (value : OakValue) : option (interp_type t).
Proof.
destruct value as [ty val].
destruct (eq_oak_type_dec t ty).
destruct (OakType.eq_dec t ty).
- subst. exact (Some val).
- exact None.
Defined.
Compute OakType.eq_dec.
(* Defines that a type can be serialized into OakValue and deserialized from it,
and that these are inverses *)
Class OakTypeEquivalence (ty : Type) :=
......@@ -90,8 +98,6 @@ Class OakTypeEquivalence (ty : Type) :=
deserialize_serialize : forall (x : ty), deserialize (serialize x) = Some x;
}.
Global Opaque serialize deserialize deserialize_serialize.
Program Instance oak_empty_equivalence : OakTypeEquivalence Empty_set :=
......@@ -150,7 +156,6 @@ Next Obligation.
now rewrite countable.decode_encode.
Qed.
(* Program Instance generates an insane amount of obligations for sums,
so we define it by ourselves. *)
Section Sum.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment